1 ;;; thingatpt.el --- Get the `thing' at point
3 ;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc.
5 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
6 ;; Keywords: extensions, matching, mouse
7 ;; Created: Thu Mar 28 13:48:23 1991
8 ;; Version: $Revision: 1.1 $
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
24 ;; This file provides routines for getting the `thing' at the location of
25 ;; point, whatever that `thing' happens to be. The `thing' is defined by
26 ;; it's beginning and end positions in the buffer.
28 ;; The function bounds-of-thing-at-point finds the beginning and end
29 ;; positions by moving first forward to the end of the `thing', and then
30 ;; backwards to the beginning. By default, it uses the corresponding
31 ;; forward-`thing' operator (eg. forward-word, forward-line).
33 ;; Special cases are allowed for using properties associated with the named
36 ;; forward-op Function to call to skip forward over a `thing' (or
37 ;; with a negative argument, backward).
39 ;; beginning-op Function to call to skip to the beginning of a `thing'.
40 ;; end-op Function to call to skip to the end of a `thing'.
42 ;; Reliance on existing operators means that many `things' can be accessed
43 ;; without further code: eg.
44 ;; (thing-at-point 'line)
45 ;; (thing-at-point 'page)
51 ;;=== Version =============================================================
53 (defconst thing
@pt-version
(substring "$Revision: 1.1 $" 11 -
2)
54 "The revision number of thing@pt (as string). The complete RCS id is:
56 $Id: thingatpt.el,v 1.1 1993/11/08 14:27:42 rms Exp rms $")
58 ;;=== Basic movement ======================================================
61 (defun forward-thing (THING &optional N
)
62 "Move forward to the end of the next THING."
63 (let ((forward-op (or (get THING
'forward-op
)
64 (intern-soft (format "forward-%s" THING
)))))
65 (if (fboundp forward-op
)
66 (funcall forward-op
(or N
1))
67 (error "Can't determine how to move over %ss" THING
))))
69 ;;=== General routines ====================================================
72 (defun bounds-of-thing-at-point (THING)
73 "Determine the start and end buffer locations for the THING at point,
74 where THING is an entity for which there is a either a corresponding
75 forward-THING operation, or corresponding beginning-of-THING and
76 end-of-THING operations, eg. 'word, 'sentence, 'defun.
77 Return a cons cell '(start . end) giving the start and end positions."
83 (or (get THING
'end-op
)
84 (function (lambda () (forward-thing THING
1)))))
88 (or (get THING
'beginning-op
)
89 (function (lambda () (forward-thing THING -
1)))))
91 (if (and beg end
(<= beg orig
) (< orig end
))
96 (defun thing-at-point (THING)
97 "Return the THING at point, where THING is an entity defined by
98 bounds-of-thing-at-point."
99 (let ((bounds (bounds-of-thing-at-point THING
)))
101 (buffer-substring (car bounds
) (cdr bounds
)))))
103 ;;=== Go to beginning/end =================================================
105 (defun beginning-of-thing (THING)
106 (let ((bounds (bounds-of-thing-at-point THING
)))
107 (or bounds
(error "No %s here" THING
))
108 (goto-char (car bounds
))))
110 (defun end-of-thing (THING)
111 (let ((bounds (bounds-of-thing-at-point THING
)))
112 (or bounds
(error "No %s here" THING
))
113 (goto-char (cdr bounds
))))
115 ;;=== Special cases =======================================================
119 (defun in-string-p ()
120 (let ((orig (point)))
123 (nth 3 (parse-partial-sexp (point) orig
)))))
125 (defun end-of-sexp ()
126 (let ((char-syntax (char-syntax (char-after (point)))))
127 (if (or (eq char-syntax ?\
))
128 (and (eq char-syntax ?
\") (in-string-p)))
132 (put 'sexp
'end-op
'end-of-sexp
)
136 (put 'list
'end-op
(function (lambda () (up-list 1))))
137 (put 'list
'beginning-op
'backward-sexp
)
141 (defvar file-name-chars
"~/A-Za-z0-9---_.${}#%,"
142 "Characters allowable in filenames.")
144 (put 'filename
'end-op
145 (function (lambda () (skip-chars-forward file-name-chars
))))
146 (put 'filename
'beginning-op
147 (function (lambda () (skip-chars-backward file-name-chars
(point-min)))))
151 (defun forward-whitespace (ARG)
154 (re-search-forward "[ \t]+\\|\n" nil nil ARG
)
156 (if (re-search-backward "[ \t]+\\|\n" nil nil
)
157 (or (eq (char-after (match-beginning 0)) 10)
158 (skip-chars-backward " \t")))
159 (setq ARG
(1+ ARG
)))))
163 (put 'buffer
'end-op
'end-of-buffer
)
164 (put 'buffer
'beginning-op
'beginning-of-buffer
)
168 (defun forward-symbol (ARG)
171 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG
)
173 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil
)
174 (skip-syntax-backward "w_"))
175 (setq ARG
(1+ ARG
)))))
177 ;;=== Aliases =============================================================
179 (defun word-at-point () (thing-at-point 'word
))
180 (defun sentence-at-point () (thing-at-point 'sentence
))
182 (defun read-from-whole-string (STR)
183 "Read a lisp expression from STR, signalling an error if the entire string
185 (let* ((read-data (read-from-string STR
))
188 (progn (read-from-string (substring STR
(cdr read-data
)))
192 (error "Can't read whole string")
195 (defun form-at-point (&optional THING PRED
)
196 (let ((sexp (condition-case nil
197 (read-from-whole-string (thing-at-point (or THING
'sexp
)))
199 (if (or (not PRED
) (funcall PRED sexp
)) sexp
)))
201 (defun sexp-at-point () (form-at-point 'sexp
))
202 (defun symbol-at-point () (form-at-point 'sexp
'symbolp
))
203 (defun number-at-point () (form-at-point 'sexp
'numberp
))
204 (defun list-at-point () (form-at-point 'list
'listp
))
206 ;; thingatpt.el ends here.