home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / alt / lucidem / help / 727 < prev    next >
Encoding:
Text File  |  1992-11-22  |  10.8 KB  |  290 lines
  1. x-gateway: rodan.UU.NET from help-lucid-emacs to alt.lucid-emacs.help; Mon, 23 Nov 1992 14:29:37 EST
  2. Date: Mon, 23 Nov 1992 18:48:49 GMT
  3. From: djh@CIS.Prime.COM (David Hughes)
  4. Message-ID: <9211231848.AA26445@CIS.Prime.COM>
  5. Subject: thing.el for mode-motion+
  6. Newsgroups: alt.lucid-emacs.help
  7. Path: sparky!uunet!wendy-fate.uu.net!help-lucid-emacs
  8. Sender: help-lucid-emacs-request@lucid.com
  9. Lines: 279
  10.  
  11. Hi Guido,
  12.  
  13.    I have been looking at the changes you made to thing.el. They are nice, but
  14. unfortunately were based on a rather out of date version of thing.el. As a
  15. result they mess up a mouse package that I wrote for lemacs based on Martin
  16. Boyer's imouse package for epoch. What I have done is merge your changes into
  17. a more uptodate copy of thing.el for inclusion into your mode-motion+ package.
  18. This will allow imouse based systems and mode-motion+ to exist in harmony.
  19. Peace and love, man!
  20.  
  21. Please let me know if you find any problems.
  22.  
  23. --
  24. Regards, David
  25.  
  26. 8< ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CUT HERE for file: thing.el
  27. ;;; -*- Mode: Emacs-Lisp;  -*-
  28. ;;; File: thing.el
  29. ;;; Authors: David Hughes <djh@cis.prime.com>
  30. ;;;              adapted from Martin Boyer's thing.el for imouse
  31. ;;;          Martin Boyer, IREQ <mboyer@ireq-robot.hydro.qc.ca>
  32. ;;;              adapted from Heinz Schmidt's thing.el for sky-mouse
  33. ;;;          Heinz Schmidt, ICSI (hws@ICSI.Berkeley.EDU)
  34. ;;;              adapted from Dan L. Pierson's epoch-thing.el
  35. ;;;          Dan L. Pierson <pierson@encore.com>, 2/5/90
  36. ;;;              adapted from Joshua Guttman's Thing.el
  37. ;;;          Joshua Guttman, MITRE (guttman@mitre.org)
  38. ;;;              adapted from sun-fns.el by Joshua Guttman, MITRE.
  39. ;;;
  40. ;;; Copyright (C) International Computer Science Institute, 1991
  41. ;;;
  42. ;;; COPYRIGHT NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY.
  43. ;;; It is subject to the terms of the GNU EMACS GENERAL PUBLIC LICENSE
  44. ;;; described in a file COPYING in the GNU EMACS distribution or to be obtained
  45. ;;; from Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139
  46. ;;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  47. ;;;* FUNCTION: Things are language objects contiguous pieces of text
  48. ;;;*           whose boundaries can be defined by syntax or context.
  49. ;;;*
  50. ;;;* RELATED PACKAGES: various packages built on this.
  51. ;;;*
  52. ;;;* HISTORY:
  53. ;;;* Last edited: David Hughes 23rd November 1992
  54. ;;;*  Nov 23 18:00 1992 (djh): merged in Guido Bosch's ideas
  55. ;;;*  Sep 10 15:35 1992 (djh): adapted for Lucid emacs19-mouse.el
  56. ;;;*  Nov 28 17:40 1991 (mb): Cleaned up, and added thing-bigger-alist.
  57. ;;;*  May 24 00:33 1991 (hws): overworked and added syntax.
  58. ;;;* Created: 2/5/90 Dan L. Pierson
  59. ;;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  60.  
  61. (provide 'thing)
  62.  
  63. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64. ;;;;;;;;;;;;  Customization and Entry Point  ;;;;;;;;;;;;;;;;;;;;;;;;;
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66.  
  67. (defvar thing-boundary-alist
  68.   '((?w thing-word)
  69.     (?_ thing-symbol)
  70.     (?\( thing-sexp-start)
  71.     (?\$ thing-sexp-start)
  72.     (?' thing-sexp-start)
  73.     (?\" thing-sexp-start)
  74.     (?\) thing-sexp-end)
  75.     (?  thing-whitespace)
  76.     (?< thing-comment)
  77.     (?. thing-next-sexp))
  78.   "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by
  79. the function `thing-boundaries'.")
  80.  
  81. (defvar *last-thing*
  82.   "The last thing found by thing-boundaries.  Used for chaining commands.")
  83.  
  84. ;; The variable and function `thing-region' are to avoid the continual
  85. ;; construction of cons cells as result af the thing scanner functions.
  86. ;; This avoids unnecessary garbage collection. Guido Bosch <bosch@loria.fr>
  87.  
  88. (defvar thing-region (cons 'nil 'nil)
  89.   "Cons cell that contains a region (<beginning> . <end>)
  90. The function `thing-region' updates and returns it.")
  91.  
  92. (defun thing-region (beginning end)
  93.   "Make BEGINNING the car and END the cdr of the cons cell in the
  94. variable `thing-region'. Return the updated cons cell"
  95.   (rplaca thing-region beginning)
  96.   (rplacd thing-region end)
  97.   thing-region)
  98.  
  99. (defvar thing-bigger-alist
  100.   '((word-symbol thing-symbol)
  101.     (symbol thing-sexp)
  102.     (word-sexp thing-sexp)
  103.     (sexp thing-up-sexp)
  104.     (sexp-up thing-up-sexp)
  105.     (line thing-paragraph)
  106.     (paragraph thing-page)
  107.     (char thing-word)
  108.     (word-sentence thing-sentence)
  109.     (sentence thing-paragraph))
  110.   "List of pairs to go from one thing to a bigger thing.
  111. See mouse-select-bigger-thing and mouse-delete-bigger-thing.")
  112.  
  113. (defvar thing-word-next 'word-sentence
  114.   "*The next bigger thing after a word.  A symbol.
  115. Supported values are: word-symbol, word-sexp, and word-sentence.
  116. Default value is word-sentence.
  117. Automatically becomes local when set in any fashion.")
  118. (make-variable-buffer-local 'thing-word-next)
  119.  
  120. (defun thing-boundaries (here)
  121.   "Return start and end of text object at HERE using syntax table and
  122. thing-boundary-alist.  Thing-boundary-alist is a list of pairs of the
  123. form (SYNTAX-CHAR FUNCTION) where FUNCTION takes a single position
  124. argument and returns a cons of places (start end) representing
  125. boundaries of the thing at that position.
  126.  
  127. Typically:
  128.  Left or right Paren syntax indicates an s-expression.
  129.  The end of a line marks the line including a trailing newline.
  130.  Word syntax indicates current word.
  131.  Symbol syntax indicates symbol.
  132.  If it doesn't recognize one of these it selects just the character HERE.
  133.  
  134. If an error occurs  during syntax scanning, the function just prints a
  135. message and returns `nil'."
  136.   (interactive "d")
  137.   (setq *last-thing* nil)
  138.   (if (save-excursion (goto-char here) (eolp))
  139.       (thing-get-line here)
  140.     (let* ((syntax (char-syntax (char-after here)))
  141.            (pair (assq syntax thing-boundary-alist)))
  142.       (if pair
  143.           (funcall (car (cdr pair)) here)
  144.         (setq *last-thing* 'char)
  145.         (thing-region here (1+ here))))))
  146.  
  147.  
  148. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  149. ;;;;;;;;;;;;;;;;;  Code Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  150. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  151.  
  152. (defun thing-symbol (here)
  153.   "Return start and end of symbol at HERE."
  154.   (cond ((memq (char-syntax (char-after here)) '(?_ ?w))
  155.          (setq *last-thing* 'symbol)
  156.          (let ((end (scan-sexps here 1)))
  157.            (thing-region (min here (scan-sexps end -1)) end)))))
  158.  
  159. (defun thing-sexp-start (here)
  160.   "Return start and end of sexp starting HERE."
  161.   (setq *last-thing* 'sexp-start)
  162.   (thing-region here (scan-sexps here 1)))
  163.  
  164. (defun thing-sexp-end (here)
  165.   "Return start and end of sexp ending HERE."
  166.   (setq *last-thing* 'sexp-end)
  167.   (thing-region (scan-sexps (1+ here) -1) (1+ here)))
  168.  
  169. (defun thing-sexp (here)
  170.   "Return start and end of the sexp at HERE."
  171.   (setq *last-thing* 'sexp)
  172.   (save-excursion
  173.     (goto-char here)
  174.     (thing-region (progn (backward-up-list 1) (point))
  175.                   (progn (forward-list 1) (point)))))
  176.  
  177. (defun thing-up-sexp (here)
  178.   "Return start and end of the sexp enclosing the selected area."
  179.   (setq *last-thing* 'sexp-up)
  180.   ;; Keep going up and backward in sexps.  This means that thing-up-sexp
  181.   ;; can only be called after thing-sexp or after itself.
  182.   (setq here (or (extent-start-position drag-extent)
  183.                  here))
  184.   (save-excursion
  185.     (goto-char here)
  186.     (thing-region (progn (backward-up-list 1) (point))
  187.                   (progn (forward-list 1) (point)))))
  188.  
  189. ;;; Allow punctuation marks not followed by white-space to include
  190. ;;; the subsequent sexp. Useful in foo.bar(x).baz and such.
  191. (defun thing-next-sexp (here)
  192.   "Return from HERE to the end of the sexp at HERE,
  193. if the character at HERE is part of a sexp."
  194.   (setq *last-thing* 'sexp-next)
  195.   (if (= (char-syntax (char-after (1+ here))) ? )
  196.       (thing-region here (1+ here))
  197.     (thing-region here
  198.                   (save-excursion (forward-sexp) (point)))))
  199.  
  200. ;;; Allow click to comment-char to extend to end of line
  201. (defun thing-comment (here)
  202.   "Return rest of line from HERE to newline."
  203.   (setq *last-thing* 'comment)
  204.   (save-excursion (goto-char here)
  205.                   (end-of-line)
  206.                   (thing-region here (point))))
  207.  
  208.  
  209. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  210. ;;;;;;;;;;;;;;;;;  Text Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  211. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  212.  
  213. (defun thing-word (here)
  214.   "Return start and end of word at HERE."
  215.   (setq *last-thing* thing-word-next)
  216.   (save-excursion
  217.     (goto-char here)
  218.     (forward-word 1)
  219.     (let ((end (point)))
  220.       (forward-word -1)
  221.       (thing-region (point) end))))
  222.  
  223. (defun thing-sentence (here)
  224.   "Return start and end of the sentence at HERE."
  225.   (setq *last-thing* 'sentence)
  226.   (save-excursion
  227.     (goto-char here)
  228.     (thing-region (progn (backward-sentence) (point))
  229.                   (progn (forward-sentence) (point)))))
  230.  
  231. (defun thing-whitespace (here)
  232.   "Return start to end of all but one char of whitespace HERE, unless
  233. there's only one char of whitespace.  Then return start to end of it."
  234.   (setq *last-thing* 'whitespace)
  235.   (save-excursion
  236.     (let ((start (progn (skip-chars-backward " \t") (1+ (point))))
  237.           (end (progn (skip-chars-forward " \t") (point))))
  238.       (if (= start end)
  239.           (thing-region (1- start) end)
  240.         (thing-region start end)))))
  241.  
  242.  
  243. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  244. ;;;;;;;;;;;;;;;  Physical Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  245. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  246.  
  247. (defun thing-get-line (here)
  248.   "Return whole of line HERE is in, with newline unless at eob."
  249.   (setq *last-thing* 'line)
  250.   (save-excursion
  251.     (goto-char here)
  252.     (let* ((start (progn (beginning-of-line 1) (point)))
  253.            (end (progn (forward-line 1) (point))))
  254.       (thing-region start (point)))))
  255.  
  256. (defun thing-paragraph (here)
  257.   "Return start and end of the paragraph at HERE."
  258.   (setq *last-thing* 'paragraph)
  259.   (save-excursion
  260.     (goto-char here)
  261.     (thing-region (progn (backward-paragraph) (point))
  262.                   (progn (forward-paragraph) (point)))))
  263.  
  264. (defun thing-page (here)
  265.   "Return start and end of the page at HERE."
  266.   (setq *last-thing* 'page)
  267.   (save-excursion
  268.     (goto-char here)
  269.     (thing-region (progn (backward-page) (point))
  270.                   (progn (forward-page) (point)))))
  271.  
  272.  
  273. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  274. ;;;;;;;;;;;;;;;;  Support functions  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  275. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  276.  
  277. (defun kill-thing-at-point (here)
  278.   "Kill text object using syntax table.
  279. See thing-boundaries for definition of text objects"
  280.   (interactive "d")
  281.   (let ((bounds (thing-boundaries here)))
  282.     (kill-region (car bounds) (cdr bounds))))
  283.  
  284. (defun copy-thing-at-point (here)
  285.   "Copy text object using syntax table.
  286. See thing-boundaries for definition of text objects"
  287.   (interactive "d")
  288.   (let ((bounds (thing-boundaries here)))
  289.     (copy-region-as-kill (car bounds) (cdr bounds))))
  290.