Mercurial > emacs
annotate lisp/thingatpt.el @ 18208:5b68d05ff026 gnumach-release-1-1-2 gnumach-release-1-1-3 hurd-release-0-2 libc-970610 libc-970611 libc-970612 libc-970613 libc-970614 libc-970615 libc-970616 libc-970617 libc-970618 libc-970619 libc-970620 libc-970621 libc-970622
Fix previous change.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 10 Jun 1997 04:18:36 +0000 |
parents | 3ae7560f0959 |
children | b2bc7438b6b0 |
rev | line source |
---|---|
4934 | 1 ;;; thingatpt.el --- Get the `thing' at point |
2 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
3 ;; Copyright (C) 1991,92,93,94,95,1996 Free Software Foundation, Inc. |
4934 | 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 |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
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) | |
14 ;; any later version. | |
15 | |
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. | |
20 | |
7938 | 21 ;;; Commentary: |
14169 | 22 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
23 ;; This file provides routines for getting the "thing" at the location of |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
24 ;; point, whatever that "thing" happens to be. The "thing" is defined by |
16427 | 25 ;; its beginning and end positions in the buffer. |
4934 | 26 ;; |
27 ;; The function bounds-of-thing-at-point finds the beginning and end | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
28 ;; positions by moving first forward to the end of the "thing", and then |
4934 | 29 ;; backwards to the beginning. By default, it uses the corresponding |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
30 ;; forward-"thing" operator (eg. forward-word, forward-line). |
4934 | 31 ;; |
32 ;; Special cases are allowed for using properties associated with the named | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
33 ;; "thing": |
4934 | 34 ;; |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
35 ;; forward-op Function to call to skip forward over a "thing" (or |
4934 | 36 ;; with a negative argument, backward). |
37 ;; | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
38 ;; beginning-op Function to call to skip to the beginning of a "thing". |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
39 ;; end-op Function to call to skip to the end of a "thing". |
4934 | 40 ;; |
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) | |
45 | |
14169 | 46 ;;; Code: |
4934 | 47 |
48 (provide 'thingatpt) | |
49 | |
14169 | 50 ;; Basic movement |
4934 | 51 |
52 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
53 (defun forward-thing (thing &optional n) |
4934 | 54 "Move forward to the end of the next THING." |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
55 (let ((forward-op (or (get thing 'forward-op) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
56 (intern-soft (format "forward-%s" thing))))) |
4934 | 57 (if (fboundp forward-op) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
58 (funcall forward-op (or n 1)) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
59 (error "Can't determine how to move over a %s" thing)))) |
4934 | 60 |
14169 | 61 ;; General routines |
4934 | 62 |
63 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
64 (defun bounds-of-thing-at-point (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
65 "Determine the start and end buffer locations for the THING at point. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
66 THING is a symbol which specifies the kind of syntactic entity you want. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
67 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
68 `word', `sentence', `whitespace', `line', `page' and others. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
69 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
70 See the file `thingatpt.el' for documentation on how to define |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
71 a symbol as a valid THING. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
72 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
73 The value is a cons cell (START . END) giving the start and end positions |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
74 of the textual entity that was found." |
4934 | 75 (let ((orig (point))) |
76 (condition-case nil | |
77 (save-excursion | |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
78 ;; Try moving forward, then back. |
4934 | 79 (let ((end (progn |
80 (funcall | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
81 (or (get thing 'end-op) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
82 (function (lambda () (forward-thing thing 1))))) |
4934 | 83 (point))) |
84 (beg (progn | |
85 (funcall | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
86 (or (get thing 'beginning-op) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
87 (function (lambda () (forward-thing thing -1))))) |
4934 | 88 (point)))) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
89 (if (not (and beg (> beg orig))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
90 ;; If that brings us all the way back to ORIG, |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
91 ;; it worked. But END may not be the real end. |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
92 ;; So find the real end that corresponds to BEG. |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
93 (let ((real-end |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
94 (progn |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
95 (funcall |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
96 (or (get thing 'end-op) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
97 (function (lambda () (forward-thing thing 1))))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
98 (point)))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
99 (if (and beg real-end (<= beg orig) (<= orig real-end)) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
100 (cons beg real-end))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
101 (goto-char orig) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
102 ;; Try a second time, moving backward first and then forward, |
16668
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
103 ;; so that we can find a thing that ends at ORIG. |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
104 (let ((beg (progn |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
105 (funcall |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
106 (or (get thing 'beginning-op) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
107 (function (lambda () (forward-thing thing -1))))) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
108 (point))) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
109 (end (progn |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
110 (funcall |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
111 (or (get thing 'end-op) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
112 (function (lambda () (forward-thing thing 1))))) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
113 (point))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
114 (real-beg |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
115 (progn |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
116 (funcall |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
117 (or (get thing 'end-op) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
118 (function (lambda () (forward-thing thing -1))))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
119 (point)))) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
120 (if (and real-beg end (<= real-beg orig) (<= orig end)) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
121 (cons real-beg end)))))) |
4934 | 122 (error nil)))) |
123 | |
124 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
125 (defun thing-at-point (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
126 "Return the THING at point. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
127 THING is a symbol which specifies the kind of syntactic entity you want. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
128 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
129 `word', `sentence', `whitespace', `line', `page' and others. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
130 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
131 See the file `thingatpt.el' for documentation on how to define |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
132 a symbol as a valid THING." |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
133 (let ((bounds (bounds-of-thing-at-point thing))) |
4934 | 134 (if bounds |
135 (buffer-substring (car bounds) (cdr bounds))))) | |
136 | |
14169 | 137 ;; Go to beginning/end |
4934 | 138 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
139 (defun beginning-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
140 (let ((bounds (bounds-of-thing-at-point thing))) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
141 (or bounds (error "No %s here" thing)) |
4934 | 142 (goto-char (car bounds)))) |
143 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
144 (defun end-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
145 (let ((bounds (bounds-of-thing-at-point thing))) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
146 (or bounds (error "No %s here" thing)) |
4934 | 147 (goto-char (cdr bounds)))) |
148 | |
14169 | 149 ;; Special cases |
4934 | 150 |
14169 | 151 ;; Lines |
9931
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
152 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
153 ;; bolp will be false when you click on the last line in the buffer |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
154 ;; and it has no final newline. |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
155 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
156 (put 'line 'beginning-op |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
157 (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line))))) |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
158 |
14169 | 159 ;; Sexps |
4934 | 160 |
161 (defun in-string-p () | |
162 (let ((orig (point))) | |
163 (save-excursion | |
164 (beginning-of-defun) | |
165 (nth 3 (parse-partial-sexp (point) orig))))) | |
166 | |
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))) | |
171 (forward-char 1) | |
172 (forward-sexp 1)))) | |
173 | |
174 (put 'sexp 'end-op 'end-of-sexp) | |
175 | |
14169 | 176 ;; Lists |
4934 | 177 |
178 (put 'list 'end-op (function (lambda () (up-list 1)))) | |
179 (put 'list 'beginning-op 'backward-sexp) | |
180 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
181 ;; Filenames and URLs |
4934 | 182 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
183 (defvar thing-at-point-file-name-chars "~/A-Za-z0-9---_.${}#%,:" |
4934 | 184 "Characters allowable in filenames.") |
185 | |
186 (put 'filename 'end-op | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
187 '(lambda () (skip-chars-forward thing-at-point-file-name-chars))) |
4934 | 188 (put 'filename 'beginning-op |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
189 '(lambda () (skip-chars-backward thing-at-point-file-name-chars))) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
190 |
16668
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
191 (defvar thing-at-point-url-chars "~/A-Za-z0-9---_@$%&=.," |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
192 "Characters allowable in a URL.") |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
193 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
194 (put 'url 'end-op |
16668
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
195 '(lambda () (skip-chars-forward (concat ":" thing-at-point-url-chars)) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
196 (skip-chars-backward ".,:"))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
197 (put 'url 'beginning-op |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
198 '(lambda () |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
199 (skip-chars-backward thing-at-point-url-chars) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
200 (or (= (preceding-char) ?:) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
201 (error "No URL here")) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
202 (forward-char -1) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
203 (skip-chars-backward "a-zA-Z"))) |
4934 | 204 |
14169 | 205 ;; Whitespace |
4934 | 206 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
207 (defun forward-whitespace (arg) |
4934 | 208 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
209 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
210 (re-search-forward "[ \t]+\\|\n" nil 'move arg) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
211 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
212 (if (re-search-backward "[ \t]+\\|\n" nil 'move) |
4934 | 213 (or (eq (char-after (match-beginning 0)) 10) |
214 (skip-chars-backward " \t"))) | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
215 (setq arg (1+ arg))))) |
4934 | 216 |
14169 | 217 ;; Buffer |
4934 | 218 |
219 (put 'buffer 'end-op 'end-of-buffer) | |
220 (put 'buffer 'beginning-op 'beginning-of-buffer) | |
221 | |
14169 | 222 ;; Symbols |
4934 | 223 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
224 (defun forward-symbol (arg) |
4934 | 225 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
226 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
227 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
228 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
229 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) |
4934 | 230 (skip-syntax-backward "w_")) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
231 (setq arg (1+ arg))))) |
4934 | 232 |
14169 | 233 ;; Syntax blocks |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
234 |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
235 (defun forward-same-syntax (&optional arg) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
236 (interactive "p") |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
237 (while (< arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
238 (skip-syntax-backward |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
239 (char-to-string (char-syntax (char-after (1- (point)))))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
240 (setq arg (1+ arg))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
241 (while (> arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
242 (skip-syntax-forward (char-to-string (char-syntax (char-after (point))))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
243 (setq arg (1- arg)))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
244 |
14169 | 245 ;; Aliases |
4934 | 246 |
247 (defun word-at-point () (thing-at-point 'word)) | |
248 (defun sentence-at-point () (thing-at-point 'sentence)) | |
249 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
250 (defun read-from-whole-string (str) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
251 "Read a lisp expression from STR. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
252 Signal an error if the entire string was not used." |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
253 (let* ((read-data (read-from-string str)) |
4934 | 254 (more-left |
255 (condition-case nil | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
256 (progn (read-from-string (substring str (cdr read-data))) |
4934 | 257 t) |
258 (end-of-file nil)))) | |
259 (if more-left | |
260 (error "Can't read whole string") | |
261 (car read-data)))) | |
262 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
263 (defun form-at-point (&optional thing pred) |
4934 | 264 (let ((sexp (condition-case nil |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
265 (read-from-whole-string (thing-at-point (or thing 'sexp))) |
4934 | 266 (error nil)))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
267 (if (or (not pred) (funcall pred sexp)) sexp))) |
4934 | 268 |
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)) | |
273 | |
274 ;; thingatpt.el ends here. |