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."
80 (or (get thing
'end-op
)
81 (function (lambda () (forward-thing thing
1)))))
85 (or (get thing
'beginning-op
)
86 (function (lambda () (forward-thing thing -
1)))))
88 (if (and beg end
(<= beg orig
) (<= orig end
))
90 ;; Try a second time, moving backward first and forward after,
91 ;; so that we can find a thing that ends at ORIG.
94 (or (get thing
'beginning-op
)
95 (function (lambda () (forward-thing thing -
1)))))
99 (or (get thing
'end-op
)
100 (function (lambda () (forward-thing thing
1)))))
102 (if (and beg end
(<= beg orig
) (<= orig end
))
107 (defun thing-at-point (thing)
108 "Return the THING at point.
109 THING is a symbol which specifies the kind of syntactic entity you want.
110 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
111 `word', `sentence', `whitespace', `line', `page' and others.
113 See the file `thingatpt.el' for documentation on how to define
114 a symbol as a valid THING."
115 (let ((bounds (bounds-of-thing-at-point thing
)))
117 (buffer-substring (car bounds
) (cdr bounds
)))))
119 ;; Go to beginning/end
121 (defun beginning-of-thing (thing)
122 (let ((bounds (bounds-of-thing-at-point thing
)))
123 (or bounds
(error "No %s here" thing
))
124 (goto-char (car bounds
))))
126 (defun end-of-thing (thing)
127 (let ((bounds (bounds-of-thing-at-point thing
)))
128 (or bounds
(error "No %s here" thing
))
129 (goto-char (cdr bounds
))))
135 ;; bolp will be false when you click on the last line in the buffer
136 ;; and it has no final newline.
138 (put 'line
'beginning-op
139 (function (lambda () (if (bolp) (forward-line -
1) (beginning-of-line)))))
143 (defun in-string-p ()
144 (let ((orig (point)))
147 (nth 3 (parse-partial-sexp (point) orig
)))))
149 (defun end-of-sexp ()
150 (let ((char-syntax (char-syntax (char-after (point)))))
151 (if (or (eq char-syntax ?\
))
152 (and (eq char-syntax ?
\") (in-string-p)))
156 (put 'sexp
'end-op
'end-of-sexp
)
160 (put 'list
'end-op
(function (lambda () (up-list 1))))
161 (put 'list
'beginning-op
'backward-sexp
)
163 ;; Filenames and URLs
165 (defvar thing-at-point-file-name-chars
"~/A-Za-z0-9---_.${}#%,:"
166 "Characters allowable in filenames.")
168 (put 'filename
'end-op
169 '(lambda () (skip-chars-forward thing-at-point-file-name-chars
)))
170 (put 'filename
'beginning-op
171 '(lambda () (skip-chars-backward thing-at-point-file-name-chars
)))
173 (defvar thing-at-point-url-chars
"~/A-Za-z0-9---_@$%&=.,"
174 "Characters allowable in a URL.")
177 '(lambda () (skip-chars-forward (concat ":" thing-at-point-url-chars
))
178 (skip-chars-backward ".,:")))
179 (put 'url
'beginning-op
181 (skip-chars-backward thing-at-point-url-chars
)
182 (or (= (preceding-char) ?
:)
183 (error "No URL here"))
185 (skip-chars-backward "a-zA-Z")))
189 (defun forward-whitespace (arg)
192 (re-search-forward "[ \t]+\\|\n" nil nil arg
)
194 (if (re-search-backward "[ \t]+\\|\n" nil nil
)
195 (or (eq (char-after (match-beginning 0)) 10)
196 (skip-chars-backward " \t")))
197 (setq arg
(1+ arg
)))))
201 (put 'buffer
'end-op
'end-of-buffer
)
202 (put 'buffer
'beginning-op
'beginning-of-buffer
)
206 (defun forward-symbol (arg)
209 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil arg
)
211 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil
)
212 (skip-syntax-backward "w_"))
213 (setq arg
(1+ arg
)))))
217 (defun forward-same-syntax (&optional arg
)
220 (skip-syntax-backward
221 (char-to-string (char-syntax (char-after (1- (point))))))
224 (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
225 (setq arg
(1- arg
))))
229 (defun word-at-point () (thing-at-point 'word
))
230 (defun sentence-at-point () (thing-at-point 'sentence
))
232 (defun read-from-whole-string (str)
233 "Read a lisp expression from STR.
234 Signal an error if the entire string was not used."
235 (let* ((read-data (read-from-string str
))
238 (progn (read-from-string (substring str
(cdr read-data
)))
242 (error "Can't read whole string")
245 (defun form-at-point (&optional thing pred
)
246 (let ((sexp (condition-case nil
247 (read-from-whole-string (thing-at-point (or thing
'sexp
)))
249 (if (or (not pred
) (funcall pred sexp
)) sexp
)))
251 (defun sexp-at-point () (form-at-point 'sexp
))
252 (defun symbol-at-point () (form-at-point 'sexp
'symbolp
))
253 (defun number-at-point () (form-at-point 'sexp
'numberp
))
254 (defun list-at-point () (form-at-point 'list
'listp
))
256 ;; thingatpt.el ends here.