4934
|
1 ;;; thingatpt.el --- Get the `thing' at point
|
|
2
|
|
3 ;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
|
5140
|
6 ;; Keywords: extensions, matching, mouse
|
4934
|
7 ;; Created: Thu Mar 28 13:48:23 1991
|
5140
|
8 ;; Version: $Revision: 1.1 $
|
4934
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
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)
|
|
15 ;; any later version.
|
|
16
|
|
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.
|
|
21
|
|
22 ;;; Commentary:
|
|
23 ;;
|
|
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.
|
|
27 ;;
|
|
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).
|
|
32 ;;
|
|
33 ;; Special cases are allowed for using properties associated with the named
|
|
34 ;; `thing':
|
|
35 ;;
|
|
36 ;; forward-op Function to call to skip forward over a `thing' (or
|
|
37 ;; with a negative argument, backward).
|
|
38 ;;
|
|
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'.
|
|
41 ;;
|
|
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)
|
|
46
|
|
47 ;;; Code:
|
|
48
|
|
49 (provide 'thingatpt)
|
|
50
|
|
51 ;;=== Version =============================================================
|
|
52
|
5140
|
53 (defconst thing@pt-version (substring "$Revision: 1.1 $" 11 -2)
|
4934
|
54 "The revision number of thing@pt (as string). The complete RCS id is:
|
|
55
|
5140
|
56 $Id: thingatpt.el,v 1.1 1993/11/08 14:27:42 rms Exp rms $")
|
4934
|
57
|
|
58 ;;=== Basic movement ======================================================
|
|
59
|
|
60 ;;;###autoload
|
|
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))))
|
|
68
|
|
69 ;;=== General routines ====================================================
|
|
70
|
|
71 ;;;###autoload
|
|
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."
|
|
78 (let ((orig (point)))
|
|
79 (condition-case nil
|
|
80 (save-excursion
|
|
81 (let ((end (progn
|
|
82 (funcall
|
|
83 (or (get THING 'end-op)
|
|
84 (function (lambda () (forward-thing THING 1)))))
|
|
85 (point)))
|
|
86 (beg (progn
|
|
87 (funcall
|
|
88 (or (get THING 'beginning-op)
|
|
89 (function (lambda () (forward-thing THING -1)))))
|
|
90 (point))))
|
|
91 (if (and beg end (<= beg orig) (< orig end))
|
|
92 (cons beg end))))
|
|
93 (error nil))))
|
|
94
|
|
95 ;;;###autoload
|
|
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)))
|
|
100 (if bounds
|
|
101 (buffer-substring (car bounds) (cdr bounds)))))
|
|
102
|
|
103 ;;=== Go to beginning/end =================================================
|
|
104
|
|
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))))
|
|
109
|
|
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))))
|
|
114
|
|
115 ;;=== Special cases =======================================================
|
|
116
|
|
117 ;;--- Sexps ---
|
|
118
|
|
119 (defun in-string-p ()
|
|
120 (let ((orig (point)))
|
|
121 (save-excursion
|
|
122 (beginning-of-defun)
|
|
123 (nth 3 (parse-partial-sexp (point) orig)))))
|
|
124
|
|
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)))
|
|
129 (forward-char 1)
|
|
130 (forward-sexp 1))))
|
|
131
|
|
132 (put 'sexp 'end-op 'end-of-sexp)
|
|
133
|
|
134 ;;--- Lists ---
|
|
135
|
|
136 (put 'list 'end-op (function (lambda () (up-list 1))))
|
|
137 (put 'list 'beginning-op 'backward-sexp)
|
|
138
|
|
139 ;;--- Filenames ---
|
|
140
|
|
141 (defvar file-name-chars "~/A-Za-z0-9---_.${}#%,"
|
|
142 "Characters allowable in filenames.")
|
|
143
|
|
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)))))
|
|
148
|
|
149 ;;--- Whitespace ---
|
|
150
|
|
151 (defun forward-whitespace (ARG)
|
|
152 (interactive "p")
|
|
153 (if (natnump ARG)
|
|
154 (re-search-forward "[ \t]+\\|\n" nil nil ARG)
|
|
155 (while (< ARG 0)
|
|
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)))))
|
|
160
|
|
161 ;;--- Buffer ---
|
|
162
|
|
163 (put 'buffer 'end-op 'end-of-buffer)
|
|
164 (put 'buffer 'beginning-op 'beginning-of-buffer)
|
|
165
|
|
166 ;;--- Symbols ---
|
|
167
|
|
168 (defun forward-symbol (ARG)
|
|
169 (interactive "p")
|
|
170 (if (natnump ARG)
|
|
171 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG)
|
|
172 (while (< ARG 0)
|
|
173 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
|
|
174 (skip-syntax-backward "w_"))
|
|
175 (setq ARG (1+ ARG)))))
|
|
176
|
|
177 ;;=== Aliases =============================================================
|
|
178
|
|
179 (defun word-at-point () (thing-at-point 'word))
|
|
180 (defun sentence-at-point () (thing-at-point 'sentence))
|
|
181
|
|
182 (defun read-from-whole-string (STR)
|
|
183 "Read a lisp expression from STR, signalling an error if the entire string
|
|
184 was not used."
|
|
185 (let* ((read-data (read-from-string STR))
|
|
186 (more-left
|
|
187 (condition-case nil
|
|
188 (progn (read-from-string (substring STR (cdr read-data)))
|
|
189 t)
|
|
190 (end-of-file nil))))
|
|
191 (if more-left
|
|
192 (error "Can't read whole string")
|
|
193 (car read-data))))
|
|
194
|
|
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)))
|
|
198 (error nil))))
|
|
199 (if (or (not PRED) (funcall PRED sexp)) sexp)))
|
|
200
|
|
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))
|
|
205
|
|
206 ;; thingatpt.el ends here.
|