guttman@mitre.org (Joshua D. Guttman) (08/08/89)
I'm enclosing some code that simplifies and adapts the "thing commands"
previously offered under emacstool, based on an idea from zmacs. The syntax
tables are used to construct the "thing" at a particular place in a buffer.
For instance, at a left-paren, the thing is the following sexp, while at a
right paren it is the preceding sexp. The association between character syntax
and "things" is fixed by an alist, so that behavior can be easily tailored. I
have also included two functions that connect with X windows. I bind them to
mouse events, and find them very useful. Bindings I use are:
(define-key mouse-map x-button-s-middle 'x-mouse-kill-thing)
(define-key mouse-map x-button-s-right 'x-mouse-copy-thing)
The other main commands are:
(global-set-key "\C-ck" 'kill-thing-at-point)
(global-set-key "\C-cw" 'copy-thing-at-point)
No bindings are made by the code below, so you can do as you please.
Joshua Guttman
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; Thing.el
;; adapted from sun-fns.el by Joshua Guttman, MITRE.
;; Comments appreciated: guttman@mitre.org
(provide 'thing)
(defun thing-boundaries (here)
"Return start and end of text object at HERE using syntax table and thing-boundary-alist.
Thing-boundary-alist is a list of pairs of the form (SYNTAX-CHAR FUNCTION)
where FUNCTION takes a single position argument and returns a cons of places
(start end) representing boundaries of the thing at that position.
Typically:
Left or right Paren syntax indicates an s-expression.
The end of a line marks the line including a trailing newline.
Word syntax indicates current word.
Symbol syntax indicates symbol.
If it doesn't recognize one of these it selects just the character HERE."
(interactive "d")
(if (save-excursion
(goto-char here)
(eolp))
(thing-get-line here)
(let* ((syntax
(char-syntax (char-after here)))
(pair
(assq syntax thing-boundary-alist)))
(if pair
(funcall (car (cdr pair)) here)
(cons here (1+ here))))))
(defvar thing-boundary-alist
'((?w thing-word)
(?_ thing-symbol)
(?\( thing-sexp-start)
(?\$ thing-sexp-start)
(?' thing-sexp-start)
(?\" thing-sexp-start)
(?\) thing-sexp-end)
(? thing-whitespace))
"*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by THING-BOUNDARIES.")
(defun thing-get-line (here)
"Return whole of line HERE is in, with newline unless at eob."
(save-excursion
(goto-char here)
(let* ((start (progn (beginning-of-line 1)
(point)))
(end (progn (forward-line 1)
(point))))
(cons start end))))
(defun thing-word (here)
"Return start and end of word at HERE."
(save-excursion
(goto-char here)
(forward-word 1)
(let ((end (point)))
(forward-word -1)
(cons (point) end))))
(defun thing-symbol (here)
"Return start and end of symbol at HERE."
(let ((end (scan-sexps here 1)))
(cons (min here (scan-sexps end -1))
end)))
(defun thing-sexp-start (here)
"Return start and end of sexp starting HERE."
(cons here (scan-sexps here 1)))
(defun thing-sexp-end (here)
"Return start and end of sexp ending HERE."
(cons (scan-sexps (1+ here) -1)
(1+ here)))
(defun thing-whitespace (here)
"Return start to end of all but one char of whitespace HERE, unless
there's only one char of whitespace. Then return start to end of it."
(save-excursion
(let ((start (progn
(skip-chars-backward " \t") (1+ (point))))
(end (progn
(skip-chars-forward " \t") (point))))
(if (= start end)
(cons (1- start) end)
(cons start end)))))
(defun mark-thing-at-point (here)
"Set point at beginning and mark at end of text object using syntax table.
See thing-boundaries for definition of text objects"
(interactive "d")
(let ((bounds (thing-boundaries here)))
(goto-char (cdr bounds))
(set-mark-command nil)
(goto-char (car bounds))))
(defun kill-thing-at-point (here)
"Kill text object using syntax table.
See thing-boundaries for definition of text objects"
(interactive "d")
(let ((bounds (thing-boundaries here)))
(kill-region (car bounds) (cdr bounds))))
(defun copy-thing-at-point (here)
"Copy text object using syntax table.
See thing-boundaries for definition of text objects"
(interactive "d")
(let ((bounds (thing-boundaries here)))
(copy-region-as-kill (car bounds) (cdr bounds))))
;;; Two X-related fns.
(defun x-mouse-kill-thing (arg)
"Kill text object at point or mouse position and insert into window system cut buffer.
Save in Emacs kill ring also."
(interactive "d")
(setq last-command nil)
(x-mouse-set-point arg)
(let* ((bounds (thing-boundaries (point)))
(start (car bounds))
(end (cdr bounds)))
(x-store-cut-buffer (buffer-substring start end))
(kill-region start end)))
(defun x-mouse-copy-thing (arg)
"Copy text object at point or mouse position into window system cut buffer.
Save in Emacs kill ring also."
(save-excursion
(save-window-excursion
(setq last-command nil)
(x-mouse-set-point arg)
(let* ((bounds (thing-boundaries (point)))
(start (car bounds))
(end (cdr bounds)))
(x-store-cut-buffer (buffer-substring start end))
(copy-region-as-kill start end)))))