thingatpt-util.el 1.0

[Andreas Roehler]

;;; thingatpt-util.el --- thing-at-point edit functions

;; Version: 1.0

;; Copyright (C) 2006  Andreas Roehler

;; Author: Andreas Roehler <address@hidden>
;; Keywords: convenience, lisp

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary: thing-at-point basic functions provided
;;; with interactive specs. The list-handling part is
;;; rewritten more thoroughly. Please have a look at
;;; two re-definitions following this comment.

;;  Any ideas and comments welcome.

;;; Code:

(require 'thingatpt)

;;  Lists
;; (put 'list 'end-op (lambda () (up-list 1)))
(put 'list 'end-op (lambda () (forward-list 1)))
(setq thatpt-listconstruktor '\()
;; (put 'list 'beginning-op 'backward-sexp)
(put 'list 'beginning-op (lambda () (unless (looking-at  (format "%s" 
thatpt-listconstruktor ))) (backward-up-list)))

;;Redefined to come to terms with lists 
(defun bounds-of-thing-at-point-ar (thing)
  "
Determine the start and end buffer locations for the THING at point.
THING is a symbol which specifies the kind of syntactic entity you want.
Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
`word', `sentence', `whitespace', `line', `page' and others."
  (let ((beg (progn 
               
               (funcall ;; First, move to beg.
                (or (get thing 'beginning-op)
                    (lambda () (forward-thing thing -1))))
               (point) ))
        (end
         (progn
           (funcall ;; Then move to end.
            (or (get thing 'end-op)
                (lambda () (forward-thing thing 1))))
           (point) )))
    (cons beg end)))

(defun bounds-of-list-at-point-ar (&optional arg) 
  " "
  (interactive "p")
  (let ((bounds (bounds-of-thing-at-point-ar 'list)))
    (when arg
      (message "%s" bounds))  
    bounds))

(defun list-at-point-ar (&optional arg) 
  " "
  (interactive "p")
  (let* ((bounds (bounds-of-thing-at-point-ar 'list))
         (list (buffer-substring-no-properties (car bounds) (cdr bounds))))
    (when arg
      (message "%s" list)
      list)))

(defun copy-list-at-point-ar (&optional arg) 
  " "
  (interactive "p")
  (let* ((bounds (bounds-of-thing-at-point-ar 'list))
         (list (buffer-substring-no-properties (car bounds) (cdr bounds))))
    (when arg
      (message "%s" list)
      (kill-new list))))

(defun kill-list-at-point-ar (&optional arg) 
  " "
  (interactive "p")
  (let* ((bounds (bounds-of-thing-at-point-ar 'list))
         (start (car bounds))
         (end (cdr bounds)))
    (kill-region start end)))

;;;;

(defun sentence-at-point-ar (&optional arg) 
  (interactive "p")
  (if arg
      (message "%s" (format "%s" (thing-at-point 'sentence)))
    (thing-at-point 'sentence)))

(defun bounds-of-sentence-at-point-ar (&optional arg)
  " "
  (interactive "p")
  (let ((start (car (bounds-of-thing-at-point 'sentence)))
        (end (cdr (bounds-of-thing-at-point 'sentence))))
    (when arg
      (message "%d %d" start end)) 
    (list start end)))

(defun copy-sentence-at-point-ar (&optional arg) 
  (interactive "p")
  (when arg
    (message "%s" (format "%s" (thing-at-point 'sentence))))
  (kill-new (thing-at-point 'sentence)))

(defun kill-sentence-at-point-ar ()
  " "
  (interactive "*")
  (let ((start (car (bounds-of-thing-at-point 'sentence)))
        (end (cdr (bounds-of-thing-at-point 'sentence))))
    (kill-region start end)))

;;;;

(defun word-at-point-ar (&optional arg) 
  (interactive "p")
  (if arg
      (message "%s" (format "%s" (thing-at-point 'word)))
    (thing-at-point 'word)))

(defun bounds-of-word-at-point-ar (&optional arg)
  " "
  (interactive "p")
  (let ((start (car (bounds-of-thing-at-point 'word)))
        (end (cdr (bounds-of-thing-at-point 'word))))
    (when arg
      (message "%d %d" start end)) 
    (list start end)))

(defun copy-word-at-point-ar (&optional arg) 
  (interactive "p")
  (when arg
    (message "%s" (format "%s" (thing-at-point 'word))))
  (kill-new (thing-at-point 'word)))

;; kill-word is already defined in simple.el. As we go
;; to define kill-word-near-point resp., this is kept
;; as a starting point though
(defun kill-word-at-point-ar ()
  " "
  (interactive "*")
  (let ((start (car (bounds-of-thing-at-point 'word)))
        (end (cdr (bounds-of-thing-at-point 'word))))
    (kill-region start end)))

;;;;

(defun sexp-at-point-ar (&optional arg) 
  (interactive "p")
  (if arg
      (message "%s" (format "%s" (thing-at-point 'sexp)))
    (thing-at-point 'sexp)))

(defun bounds-of-sexp-at-point-ar (&optional arg)
  " "
  (interactive "p")
  (let ((start (car (bounds-of-thing-at-point 'sexp)))
        (end (cdr (bounds-of-thing-at-point 'sexp))))
    (when arg
      (message "%d %d" start end)) 
    (list start end)))

(defun copy-sexp-at-point-ar (&optional arg) 
  (interactive "p")
  (when arg
    (message "%s" (format "%s" (thing-at-point 'sexp))))
  (kill-new (thing-at-point 'sexp)))

(defun kill-sexp-at-point-ar ()
  " "
  (interactive "*")
  (let ((start (car (bounds-of-thing-at-point 'sexp)))
        (end (cdr (bounds-of-thing-at-point 'sexp))))
    (kill-region start end)))

;;;;

(defun symbol-at-point-ar (&optional arg) 
  (interactive "p")
  (if arg
      (message "%s" (format "%s" (thing-at-point 'symbol)))
    (thing-at-point 'symbol)))

(defun bounds-of-symbol-at-point-ar (&optional arg)
  " "
  (interactive "p")
  (let ((start (car (bounds-of-thing-at-point 'symbol)))
        (end (cdr (bounds-of-thing-at-point 'symbol))))
    (when arg
      (message "%d %d" start end)) 
    (list start end)))

(defun copy-symbol-at-point-ar (&optional arg) 
  (interactive "p")
  (when arg
    (message "%s" (format "%s" (thing-at-point 'symbol))))
  (kill-new (thing-at-point 'symbol)))

(defun kill-symbol-at-point-ar ()
  " "
  (interactive "*")
  (let ((start (car (bounds-of-thing-at-point 'symbol)))
        (end (cdr (bounds-of-thing-at-point 'symbol))))
    (kill-region start end)))

;;;; 

(defun url-at-point-ar (&optional arg) 
  (interactive "p")
  (if arg
      (message "%s" (thing-at-point-url-at-point))
    (thing-at-point-url-at-point)))

(defun bounds-of-url-at-point-ar (url-at-point)
  " "
  (interactive
   (list (url-at-point)))
  (let ((bounds (bounds-of-thing-at-point 'url)))
    (or bounds (error "No %s here" url))
    (message "%s" bounds)))

(defun copy-url-at-point-ar (&optional arg) 
  (interactive "p")
  (when arg
    (message "%s" (format "%s" (thing-at-point 'url))))
  (kill-new (thing-at-point 'url)))

(defun kill-url-at-point-ar (url-at-point)
  " "
  (interactive
   (list (url-at-point)))
  (let ((start (car (bounds-of-thing-at-point 'url)))
        (end (cdr (bounds-of-thing-at-point 'url))))
    (kill-region start end)))

;;;;

(provide 'thingatpt-util)
;;; thingatpt-util.el ends here