home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / hyperbutton.shar / thing-at-point.el < prev   
Encoding:
Text File  |  1991-07-03  |  7.2 KB  |  205 lines
  1. ;; ========================================================================
  2. ;; thing-at-point.el -- Get the thing at point
  3. ;; Author          : Mike Williams <mike-w@cs.aukuni.ac.nz>
  4. ;; Created On      : Thu Mar 28 13:48:23 1991
  5. ;; Last Modified By: Mike Williams
  6. ;; Last Modified On: Mon May 27 09:29:02 1991
  7. ;; RCS Info        : $Revision: 1.1 $ $Locker:  $
  8. ;; ========================================================================
  9. ;; NOTE: this file must be recompiled if changed.
  10. ;;
  11. ;; Copyright (C) Mike Williams <mike-w@cs.aukuni.ac.nz> 1991
  12. ;;
  13. ;; This file is not part of GNU Emacs, but is made available under the
  14. ;; same conditions.
  15. ;;
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  18. ;; accepts responsibility to anyone for the consequences of using it
  19. ;; or for whether it serves any particular purpose or works at all,
  20. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  21. ;; License for full details.
  22. ;;
  23. ;; Everyone is granted permission to copy, modify and redistribute
  24. ;; GNU Emacs, but only under the conditions described in the
  25. ;; GNU Emacs General Public License.   A copy of this license is
  26. ;; supposed to have been given to you along with GNU Emacs so you
  27. ;; can know your rights and responsibilities.  It should be in a
  28. ;; file named COPYING.  Among other things, the copyright notice
  29. ;; and this notice must be preserved on all copies.
  30.  
  31. (provide 'thing-at-point)
  32.  
  33. ;;=== Usage ===============================================================
  34. ;;
  35. ;; (autoload 'thing-at-point "thing-at-point")
  36.  
  37. ;; This file provides routines for getting the `thing' at the location of
  38. ;; point, whatever that `thing' happens to be.  The `thing' is defined by
  39. ;; it's beginning and end positions in the buffer.  There are several ways
  40. ;; to determine these two positions:
  41. ;;
  42. ;;   (1) Using regular expression search.  If regular expressions are given
  43. ;;       on the 'beginning-regexp and 'end-regexp properties of 'thing,
  44. ;;       beginning and end points are located using 
  45. ;;          (re-search-backward beginning-regexp nil t)
  46. ;;       and
  47. ;;          (re-search-forward end-regexp nil t)
  48. ;;       
  49. ;;   (2) Using the corresponding beginning-of-thing and end-of-thing
  50. ;;       operators. If these operators exist, or are explicitly named using
  51. ;;       the 'beginning-op and 'end-op properties of 'thing, beginning and
  52. ;;       end points are located using  
  53. ;;          (beginning-of-thing)
  54. ;;       and
  55. ;;          (end-of-thing)
  56. ;;       
  57. ;;   (3) Using the corresponding forward-thing operator.  If this operator
  58. ;;       exists, or is explicitly named using the 'forward-op property of
  59. ;;       'thing, beginning and end points are located using
  60. ;;          (forward-thing -1)
  61. ;;       and
  62. ;;          (forward-thing 1)
  63. ;;          
  64. ;; Note that these different methods may be mixed: eg. a regular expression
  65. ;; search may be used to find the beginning of the `thing', while and
  66. ;; explicit operator is used to find the end.
  67. ;;
  68. ;; The function bounds-of-thing-at-point returns these beginning and end
  69. ;; points.  The function thing-at-point extracts the corresponding text
  70. ;; from the buffer.
  71. ;;
  72. ;; Reliance on existing operators means that many `things' can be accessed
  73. ;; without further code:  eg.
  74. ;;     (thing-at-point 'line)
  75. ;;     (thing-at-point 'page)
  76.  
  77. ;;=== General routines ====================================================
  78.  
  79. (defun bounds-of-thing-at-point (THING)
  80.   "Determine the start and end buffer locations for the THING at point,
  81. where THING is an entity for which there is a either a corresponding
  82. forward-THING operation, or corresponding beginning-of-THING and
  83. end-of-THING operations, eg. 'word, 'sentence, 'defun.
  84.   Return a cons cell '(start . end) giving the start and end positions."
  85.   (let ((beginning-regexp (eval (get THING 'beginning-regexp)))
  86.     (end-regexp (eval (get THING 'end-regexp)))
  87.     (beginning-op (or (get THING 'beginning-op)
  88.               (intern-soft (format "beginning-of-%s" THING))))
  89.     (end-op (or (get THING 'end-op)
  90.             (intern-soft (format "end-of-%s" THING))))
  91.     (forward-op (or (get THING 'forward-op)
  92.             (intern-soft (format "forward-%s" THING))))
  93.     (orig-point (point)))
  94.     (condition-case ()
  95.     (save-excursion
  96.       (let ((start
  97.          (progn
  98.            (cond
  99.             (beginning-regexp
  100.              (re-search-backward beginning-regexp nil t))
  101.             ((fboundp beginning-op) (funcall beginning-op))
  102.             ((fboundp forward-op) (funcall forward-op -1))
  103.             (t (error "No beginning operation for %s" THING)))
  104.            (point)))
  105.         (end
  106.          (progn
  107.            (cond
  108.             (end-regexp
  109.              (re-search-forward end-regexp nil t))
  110.             ((fboundp end-op) (funcall end-op))
  111.             ((fboundp forward-op) (funcall forward-op 1))
  112.             (t (error "No end operation for %s" THING)))
  113.            (point))))
  114.         (if (and start (<= start orig-point) end (<= orig-point end))
  115.         (cons start end))))
  116.       (error nil))))
  117.  
  118. (defun thing-at-point (THING)
  119.   "Return the THING at point, where THING is an entity defined by
  120. bounds-of-thing-at-point."
  121.   (let ((bounds (bounds-of-thing-at-point THING)))
  122.     (if bounds 
  123.     (buffer-substring (car bounds) (cdr bounds)))))
  124.  
  125. (defun word-at-point () (thing-at-point 'word))
  126. (defun sexp-at-point () (thing-at-point 'sexp))
  127. (defun sentence-at-point () (thing-at-point 'sentence))
  128.  
  129. ;;=== read-from-whole-string ==============================================
  130. ;;
  131. ;; Included 'cos it's useful.
  132.  
  133. (defun read-from-whole-string (STR)
  134.   "Read a lisp expression from STR, signalling an error if the entire string
  135. was not used."
  136.   (let* ((read-data (read-from-string STR))
  137.      (more-left 
  138.       (condition-case oops
  139.           (progn (read-from-string (substring STR (cdr read-data)))
  140.              t)
  141.         (end-of-file nil))))
  142.     (if more-left
  143.     (error "Can't read whole string")
  144.       (car read-data))))
  145.  
  146. ;;=== Special cases =======================================================
  147.  
  148. ;;=== Symbols ===
  149. ;; Beginning: skip expression prefix characters
  150.  
  151. (defun beginning-of-symbol ()
  152.   (forward-sexp -1)
  153.   (while (looking-at "\\s'") (forward-char)))
  154.  
  155. (put 'symbol 'beginning-op 'beginning-of-symbol)
  156. (put 'symbol 'end-op 'forward-sexp)
  157.  
  158. (defun symbol-at-point () (read-from-whole-string (thing-at-point 'symbol)))
  159.  
  160. ;;=== Lists ===
  161. ;; Beginning: Regexp search
  162. ;; End: Use forward-list
  163.  
  164. (put 'list 'beginning-regexp "\\s(")
  165. (put 'list 'end-op 'forward-list)
  166.  
  167. ;;=== Strings ===
  168. ;; Define operators for beginning/end
  169.  
  170. (defun beginning-of-string ()
  171.   (let ((end (point)) 
  172.     parse-data in-string)
  173.     (beginning-of-defun)
  174.     (setq parse-data (parse-partial-sexp (point) end))
  175.     (setq in-string (nth 3 parse-data))
  176.     (if in-string 
  177.     (progn (re-search-backward "\\\"") in-string)
  178.       (error "Not within string"))))
  179.  
  180. (defun end-of-string ()
  181.   (forward-char 1)
  182.   (let ((end-char (beginning-of-string)))
  183.     (forward-char 1)
  184.     (search-forward (char-to-string end-char))))
  185.  
  186. ;;=== Filenames ===
  187. ;; Define operators for beginning/end
  188.  
  189. (defvar file-name-chars "~/A-Za-z0-9---_.$#%,"
  190.   "Characters allowable in filenames.")
  191.  
  192. (defun beginning-of-filename ()
  193.   (interactive)
  194.   (let ((regexp (format "[^%s]+" file-name-chars)))
  195.     (if (re-search-backward regexp)
  196.     (forward-char 1))))
  197.     
  198. (defun end-of-filename ()
  199.   (interactive)
  200.   (let ((regexp (format "[%s]+" file-name-chars)))
  201.     (re-search-forward regexp)))
  202.  
  203. ;;=== END of thing-at-point.el ============================================
  204.  
  205.