1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
;;; thingatpt.el --- Get the `thing' at point
;; Copyright (C) 1991,1992,1993,1994,1995 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Keywords: extensions, matching, mouse
;; Created: Thu Mar 28 13:48:23 1991
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;; Commentary:
;; This file provides routines for getting the `thing' at the location of
;; point, whatever that `thing' happens to be. The `thing' is defined by
;; it's beginning and end positions in the buffer.
;;
;; The function bounds-of-thing-at-point finds the beginning and end
;; positions by moving first forward to the end of the `thing', and then
;; backwards to the beginning. By default, it uses the corresponding
;; forward-`thing' operator (eg. forward-word, forward-line).
;;
;; Special cases are allowed for using properties associated with the named
;; `thing':
;;
;; forward-op Function to call to skip forward over a `thing' (or
;; with a negative argument, backward).
;;
;; beginning-op Function to call to skip to the beginning of a `thing'.
;; end-op Function to call to skip to the end of a `thing'.
;;
;; Reliance on existing operators means that many `things' can be accessed
;; without further code: eg.
;; (thing-at-point 'line)
;; (thing-at-point 'page)
;;; Code:
(provide 'thingatpt)
;; Basic movement
;;;###autoload
(defun forward-thing (THING &optional N)
"Move forward to the end of the next THING."
(let ((forward-op (or (get THING 'forward-op)
(intern-soft (format "forward-%s" THING)))))
(if (fboundp forward-op)
(funcall forward-op (or N 1))
(error "Can't determine how to move over %ss" THING))))
;; General routines
;;;###autoload
(defun bounds-of-thing-at-point (THING)
"Determine the start and end buffer locations for the THING at point,
where THING is an entity for which there is a either a corresponding
forward-THING operation, or corresponding beginning-of-THING and
end-of-THING operations, eg. 'word, 'sentence, 'defun.
Return a cons cell '(start . end) giving the start and end positions."
(let ((orig (point)))
(condition-case nil
(save-excursion
(let ((end (progn
(funcall
(or (get THING 'end-op)
(function (lambda () (forward-thing THING 1)))))
(point)))
(beg (progn
(funcall
(or (get THING 'beginning-op)
(function (lambda () (forward-thing THING -1)))))
(point))))
(if (and beg end (<= beg orig) (< orig end))
(cons beg end))))
(error nil))))
;;;###autoload
(defun thing-at-point (THING)
"Return the THING at point, where THING is an entity defined by
bounds-of-thing-at-point."
(let ((bounds (bounds-of-thing-at-point THING)))
(if bounds
(buffer-substring (car bounds) (cdr bounds)))))
;; Go to beginning/end
(defun beginning-of-thing (THING)
(let ((bounds (bounds-of-thing-at-point THING)))
(or bounds (error "No %s here" THING))
(goto-char (car bounds))))
(defun end-of-thing (THING)
(let ((bounds (bounds-of-thing-at-point THING)))
(or bounds (error "No %s here" THING))
(goto-char (cdr bounds))))
;; Special cases
;; Lines
;; bolp will be false when you click on the last line in the buffer
;; and it has no final newline.
(put 'line 'beginning-op
(function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))
;; Sexps
(defun in-string-p ()
(let ((orig (point)))
(save-excursion
(beginning-of-defun)
(nth 3 (parse-partial-sexp (point) orig)))))
(defun end-of-sexp ()
(let ((char-syntax (char-syntax (char-after (point)))))
(if (or (eq char-syntax ?\))
(and (eq char-syntax ?\") (in-string-p)))
(forward-char 1)
(forward-sexp 1))))
(put 'sexp 'end-op 'end-of-sexp)
;; Lists
(put 'list 'end-op (function (lambda () (up-list 1))))
(put 'list 'beginning-op 'backward-sexp)
;; Filenames
(defvar file-name-chars "~/A-Za-z0-9---_.${}#%,"
"Characters allowable in filenames.")
(put 'filename 'end-op
(function (lambda () (skip-chars-forward file-name-chars))))
(put 'filename 'beginning-op
(function (lambda () (skip-chars-backward file-name-chars (point-min)))))
;; Whitespace
(defun forward-whitespace (ARG)
(interactive "p")
(if (natnump ARG)
(re-search-forward "[ \t]+\\|\n" nil nil ARG)
(while (< ARG 0)
(if (re-search-backward "[ \t]+\\|\n" nil nil)
(or (eq (char-after (match-beginning 0)) 10)
(skip-chars-backward " \t")))
(setq ARG (1+ ARG)))))
;; Buffer
(put 'buffer 'end-op 'end-of-buffer)
(put 'buffer 'beginning-op 'beginning-of-buffer)
;; Symbols
(defun forward-symbol (ARG)
(interactive "p")
(if (natnump ARG)
(re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG)
(while (< ARG 0)
(if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
(skip-syntax-backward "w_"))
(setq ARG (1+ ARG)))))
;; Syntax blocks
(defun forward-same-syntax (&optional arg)
(interactive "p")
(while (< arg 0)
(skip-syntax-backward
(char-to-string (char-syntax (char-after (1- (point))))))
(setq arg (1+ arg)))
(while (> arg 0)
(skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
(setq arg (1- arg))))
;; Aliases
(defun word-at-point () (thing-at-point 'word))
(defun sentence-at-point () (thing-at-point 'sentence))
(defun read-from-whole-string (STR)
"Read a lisp expression from STR, signaling an error if the entire string
was not used."
(let* ((read-data (read-from-string STR))
(more-left
(condition-case nil
(progn (read-from-string (substring STR (cdr read-data)))
t)
(end-of-file nil))))
(if more-left
(error "Can't read whole string")
(car read-data))))
(defun form-at-point (&optional THING PRED)
(let ((sexp (condition-case nil
(read-from-whole-string (thing-at-point (or THING 'sexp)))
(error nil))))
(if (or (not PRED) (funcall PRED sexp)) sexp)))
(defun sexp-at-point () (form-at-point 'sexp))
(defun symbol-at-point () (form-at-point 'sexp 'symbolp))
(defun number-at-point () (form-at-point 'sexp 'numberp))
(defun list-at-point () (form-at-point 'list 'listp))
;; thingatpt.el ends here.
|
