1 ;;; thingatpt.el --- Get the `thing' at point
3 ;; Copyright (C) 1991,92,93,94,95,1996 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
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
23 ;; This file provides routines for getting the "thing" at the location of
24 ;; point, whatever that "thing" happens to be. The "thing" is defined by
25 ;; its beginning and end positions in the buffer.
27 ;; The function bounds-of-thing-at-point finds the beginning and end
28 ;; positions by moving first forward to the end of the "thing", and then
29 ;; backwards to the beginning. By default, it uses the corresponding
30 ;; forward-"thing" operator (eg. forward-word, forward-line).
32 ;; Special cases are allowed for using properties associated with the named
35 ;; forward-op Function to call to skip forward over a "thing" (or
36 ;; with a negative argument, backward).
38 ;; beginning-op Function to call to skip to the beginning of a "thing".
39 ;; end-op Function to call to skip to the end of a "thing".
41 ;; Reliance on existing operators means that many `things' can be accessed
42 ;; without further code: eg.
43 ;; (thing-at-point 'line)
44 ;; (thing-at-point 'page)
53 (defun forward-thing (thing &optional n
)
54 "Move forward to the end of the next THING."
55 (let ((forward-op (or (get thing
'forward-op
)
56 (intern-soft (format "forward-%s" thing
)))))
57 (if (fboundp forward-op
)
58 (funcall forward-op
(or n
1))
59 (error "Can't determine how to move over a %s" thing
))))
64 (defun bounds-of-thing-at-point (thing)
65 "Determine the start and end buffer locations for the THING at point.
66 THING is a symbol which specifies the kind of syntactic entity you want.
67 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
68 `word', `sentence', `whitespace', `line', `page' and others.
70 See the file `thingatpt.el' for documentation on how to define
71 a symbol as a valid THING.
73 The value is a cons cell (START . END) giving the start and end positions
74 of the textual entity that was found."
78 ;; Try moving forward, then back.
81 (or (get thing
'end-op
)
82 (function (lambda () (forward-thing thing
1)))))
86 (or (get thing
'beginning-op
)
87 (function (lambda () (forward-thing thing -
1)))))
89 (if (not (and beg
(> beg orig
)))
90 ;; If that brings us all the way back to ORIG,
91 ;; it worked. But END may not be the real end.
92 ;; So find the real end that corresponds to BEG.
96 (or (get thing
'end-op
)
97 (function (lambda () (forward-thing thing
1)))))
99 (if (and beg real-end
(<= beg orig
) (<= orig real-end
))
100 (cons beg real-end
)))
102 ;; Try a second time, moving backward first and then forward,
103 ;; so that we can find a thing that ends at ORIG.
106 (or (get thing
'beginning-op
)
107 (function (lambda () (forward-thing thing -
1)))))
111 (or (get thing
'end-op
)
112 (function (lambda () (forward-thing thing
1)))))
117 (or (get thing
'end-op
)
118 (function (lambda () (forward-thing thing -
1)))))
120 (if (and real-beg end
(<= real-beg orig
) (<= orig end
))
121 (cons real-beg end
))))))
125 (defun thing-at-point (thing)
126 "Return the THING at point.
127 THING is a symbol which specifies the kind of syntactic entity you want.
128 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
129 `word', `sentence', `whitespace', `line', `page' and others.
131 See the file `thingatpt.el' for documentation on how to define
132 a symbol as a valid THING."
133 (let ((bounds (bounds-of-thing-at-point thing
)))
135 (buffer-substring (car bounds
) (cdr bounds
)))))
137 ;; Go to beginning/end
139 (defun beginning-of-thing (thing)
140 (let ((bounds (bounds-of-thing-at-point thing
)))
141 (or bounds
(error "No %s here" thing
))
142 (goto-char (car bounds
))))
144 (defun end-of-thing (thing)
145 (let ((bounds (bounds-of-thing-at-point thing
)))
146 (or bounds
(error "No %s here" thing
))
147 (goto-char (cdr bounds
))))
153 ;; bolp will be false when you click on the last line in the buffer
154 ;; and it has no final newline.
156 (put 'line
'beginning-op
157 (function (lambda () (if (bolp) (forward-line -
1) (beginning-of-line)))))
161 (defun in-string-p ()
162 (let ((orig (point)))
165 (nth 3 (parse-partial-sexp (point) orig
)))))
167 (defun end-of-sexp ()
168 (let ((char-syntax (char-syntax (char-after (point)))))
169 (if (or (eq char-syntax ?\
))
170 (and (eq char-syntax ?
\") (in-string-p)))
174 (put 'sexp
'end-op
'end-of-sexp
)
178 (put 'list
'end-op
(function (lambda () (up-list 1))))
179 (put 'list
'beginning-op
'backward-sexp
)
181 ;; Filenames and URLs
183 (defvar thing-at-point-file-name-chars
"~/A-Za-z0-9---_.${}#%,:"
184 "Characters allowable in filenames.")
186 (put 'filename
'end-op
187 '(lambda () (skip-chars-forward thing-at-point-file-name-chars
)))
188 (put 'filename
'beginning-op
189 '(lambda () (skip-chars-backward thing-at-point-file-name-chars
)))
191 (defvar thing-at-point-url-chars
"~/A-Za-z0-9---_@$%&=.,"
192 "Characters allowable in a URL.")
195 '(lambda () (skip-chars-forward (concat ":" thing-at-point-url-chars
))
196 (skip-chars-backward ".,:")))
197 (put 'url
'beginning-op
199 (skip-chars-backward thing-at-point-url-chars
)
200 (or (= (preceding-char) ?
:)
201 (error "No URL here"))
203 (skip-chars-backward "a-zA-Z")))
207 (defun forward-whitespace (arg)
210 (re-search-forward "[ \t]+\\|\n" nil
'move arg
)
212 (if (re-search-backward "[ \t]+\\|\n" nil
'move
)
213 (or (eq (char-after (match-beginning 0)) 10)
214 (skip-chars-backward " \t")))
215 (setq arg
(1+ arg
)))))
219 (put 'buffer
'end-op
'end-of-buffer
)
220 (put 'buffer
'beginning-op
'beginning-of-buffer
)
224 (defun forward-symbol (arg)
227 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil
'move arg
)
229 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil
'move
)
230 (skip-syntax-backward "w_"))
231 (setq arg
(1+ arg
)))))
235 (defun forward-same-syntax (&optional arg
)
238 (skip-syntax-backward
239 (char-to-string (char-syntax (char-after (1- (point))))))
242 (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
243 (setq arg
(1- arg
))))
247 (defun word-at-point () (thing-at-point 'word
))
248 (defun sentence-at-point () (thing-at-point 'sentence
))
250 (defun read-from-whole-string (str)
251 "Read a lisp expression from STR.
252 Signal an error if the entire string was not used."
253 (let* ((read-data (read-from-string str
))
256 (progn (read-from-string (substring str
(cdr read-data
)))
260 (error "Can't read whole string")
263 (defun form-at-point (&optional thing pred
)
264 (let ((sexp (condition-case nil
265 (read-from-whole-string (thing-at-point (or thing
'sexp
)))
267 (if (or (not pred
) (funcall pred sexp
)) sexp
)))
269 (defun sexp-at-point () (form-at-point 'sexp
))
270 (defun symbol-at-point () (form-at-point 'sexp
'symbolp
))
271 (defun number-at-point () (form-at-point 'sexp
'numberp
))
272 (defun list-at-point () (form-at-point 'list
'listp
))
274 ;; thingatpt.el ends here.