Mercurial > emacs
annotate lisp/thingatpt.el @ 49287:5cb7e7103296
Don't setup the default fontset and
font-encoding-alist at the top level.
(setup-default-fontset): New function.
(create-fontset-from-fontset-spec): Delete autoload cookie.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Fri, 17 Jan 2003 08:13:39 +0000 |
parents | c84445fe778c |
children | f00b6ec56900 |
rev | line source |
---|---|
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
30818
diff
changeset
|
1 ;;; thingatpt.el --- get the `thing' at point |
4934 | 2 |
29516
4e7f28c8e364
(forward-thing): Use functionp instead of fboundp.
Gerd Moellmann <gerd@gnu.org>
parents:
27581
diff
changeset
|
3 ;; Copyright (C) 1991,92,93,94,95,96,97,1998,2000 |
4e7f28c8e364
(forward-thing): Use functionp instead of fboundp.
Gerd Moellmann <gerd@gnu.org>
parents:
27581
diff
changeset
|
4 ;; Free Software Foundation, Inc. |
4934 | 5 |
6 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz> | |
29516
4e7f28c8e364
(forward-thing): Use functionp instead of fboundp.
Gerd Moellmann <gerd@gnu.org>
parents:
27581
diff
changeset
|
7 ;; Maintainer: FSF |
5140 | 8 ;; Keywords: extensions, matching, mouse |
4934 | 9 ;; Created: Thu Mar 28 13:48:23 1991 |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 ;; it under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;; any later version. | |
17 | |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
7938 | 23 ;;; Commentary: |
14169 | 24 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
25 ;; 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
|
26 ;; point, whatever that "thing" happens to be. The "thing" is defined by |
16427 | 27 ;; its beginning and end positions in the buffer. |
4934 | 28 ;; |
29 ;; 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
|
30 ;; positions by moving first forward to the end of the "thing", and then |
4934 | 31 ;; 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
|
32 ;; forward-"thing" operator (eg. forward-word, forward-line). |
4934 | 33 ;; |
34 ;; 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
|
35 ;; "thing": |
4934 | 36 ;; |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
37 ;; forward-op Function to call to skip forward over a "thing" (or |
4934 | 38 ;; with a negative argument, backward). |
39 ;; | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
40 ;; 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
|
41 ;; end-op Function to call to skip to the end of a "thing". |
4934 | 42 ;; |
43 ;; Reliance on existing operators means that many `things' can be accessed | |
44 ;; without further code: eg. | |
45 ;; (thing-at-point 'line) | |
46 ;; (thing-at-point 'page) | |
47 | |
14169 | 48 ;;; Code: |
4934 | 49 |
50 (provide 'thingatpt) | |
51 | |
14169 | 52 ;; Basic movement |
4934 | 53 |
54 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
55 (defun forward-thing (thing &optional n) |
4934 | 56 "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
|
57 (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
|
58 (intern-soft (format "forward-%s" thing))))) |
29516
4e7f28c8e364
(forward-thing): Use functionp instead of fboundp.
Gerd Moellmann <gerd@gnu.org>
parents:
27581
diff
changeset
|
59 (if (functionp forward-op) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
60 (funcall forward-op (or n 1)) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
61 (error "Can't determine how to move over a %s" thing)))) |
4934 | 62 |
14169 | 63 ;; General routines |
4934 | 64 |
65 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
66 (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
|
67 "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
|
68 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
|
69 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
|
70 `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
|
71 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
72 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
|
73 a symbol as a valid THING. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
74 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
75 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
|
76 of the textual entity that was found." |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
77 (if (get thing 'bounds-of-thing-at-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
78 (funcall (get thing 'bounds-of-thing-at-point)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
79 (let ((orig (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
80 (condition-case nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
81 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
82 ;; Try moving forward, then back. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
83 (let ((end (progn |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
84 (funcall |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
85 (or (get thing 'end-op) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
86 (function (lambda () (forward-thing thing 1))))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
87 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
88 (beg (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
89 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
90 (or (get thing 'beginning-op) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
91 (function (lambda () (forward-thing thing -1))))) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
92 (point)))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
93 (if (not (and beg (> beg orig))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
94 ;; If that brings us all the way back to ORIG, |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
95 ;; it worked. But END may not be the real end. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
96 ;; So find the real end that corresponds to BEG. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
97 (let ((real-end |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
98 (progn |
16668
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
99 (funcall |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
100 (or (get thing 'end-op) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
101 (function (lambda () (forward-thing thing 1))))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
102 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
103 (if (and beg real-end (<= beg orig) (<= orig real-end)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
104 (cons beg real-end))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
105 (goto-char orig) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
106 ;; Try a second time, moving backward first and then forward, |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
107 ;; so that we can find a thing that ends at ORIG. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
108 (let ((beg (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
109 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
110 (or (get thing 'beginning-op) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
111 (function (lambda () (forward-thing thing -1))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
112 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
113 (end (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
114 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
115 (or (get thing 'end-op) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
116 (function (lambda () (forward-thing thing 1))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
117 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
118 (real-beg |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
119 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
120 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
121 (or (get thing 'beginning-op) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
122 (function (lambda () (forward-thing thing -1))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
123 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
124 (if (and real-beg end (<= real-beg orig) (<= orig end)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
125 (cons real-beg end)))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
126 (error nil))))) |
4934 | 127 |
128 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
129 (defun thing-at-point (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
130 "Return the THING at point. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
131 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
|
132 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
|
133 `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
|
134 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
135 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
|
136 a symbol as a valid THING." |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
137 (if (get thing 'thing-at-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
138 (funcall (get thing 'thing-at-point)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
139 (let ((bounds (bounds-of-thing-at-point thing))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
140 (if bounds |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
141 (buffer-substring (car bounds) (cdr bounds)))))) |
4934 | 142 |
14169 | 143 ;; Go to beginning/end |
4934 | 144 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
145 (defun beginning-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
146 (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
|
147 (or bounds (error "No %s here" thing)) |
4934 | 148 (goto-char (car bounds)))) |
149 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
150 (defun end-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
151 (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
|
152 (or bounds (error "No %s here" thing)) |
4934 | 153 (goto-char (cdr bounds)))) |
154 | |
14169 | 155 ;; Special cases |
4934 | 156 |
14169 | 157 ;; Lines |
9931
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
158 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
159 ;; 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
|
160 ;; and it has no final newline. |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
161 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
162 (put 'line 'beginning-op |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
163 (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
|
164 |
14169 | 165 ;; Sexps |
4934 | 166 |
167 (defun in-string-p () | |
168 (let ((orig (point))) | |
169 (save-excursion | |
170 (beginning-of-defun) | |
171 (nth 3 (parse-partial-sexp (point) orig))))) | |
172 | |
173 (defun end-of-sexp () | |
174 (let ((char-syntax (char-syntax (char-after (point))))) | |
175 (if (or (eq char-syntax ?\)) | |
176 (and (eq char-syntax ?\") (in-string-p))) | |
177 (forward-char 1) | |
178 (forward-sexp 1)))) | |
179 | |
180 (put 'sexp 'end-op 'end-of-sexp) | |
181 | |
18432
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
182 (defun beginning-of-sexp () |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
183 (let ((char-syntax (char-syntax (char-before (point))))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
184 (if (or (eq char-syntax ?\() |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
185 (and (eq char-syntax ?\") (in-string-p))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
186 (forward-char -1) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
187 (forward-sexp -1)))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
188 |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
189 (put 'sexp 'beginning-op 'beginning-of-sexp) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
190 |
14169 | 191 ;; Lists |
4934 | 192 |
193 (put 'list 'end-op (function (lambda () (up-list 1)))) | |
194 (put 'list 'beginning-op 'backward-sexp) | |
195 | |
49270
c84445fe778c
(thing-at-point-file-name-chars): Include non-ASCII
Dave Love <fx@gnu.org>
parents:
47862
diff
changeset
|
196 ;; Filenames and URLs www.com/foo%32bar |
4934 | 197 |
49270
c84445fe778c
(thing-at-point-file-name-chars): Include non-ASCII
Dave Love <fx@gnu.org>
parents:
47862
diff
changeset
|
198 (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" |
4934 | 199 "Characters allowable in filenames.") |
200 | |
201 (put 'filename 'end-op | |
29592
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
202 (lambda () (skip-chars-forward thing-at-point-file-name-chars))) |
4934 | 203 (put 'filename 'beginning-op |
29592
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
204 (lambda () (skip-chars-backward thing-at-point-file-name-chars))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
205 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
206 (defvar thing-at-point-url-path-regexp |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
207 "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" |
47786
a9de3e936eef
(thing-at-point-url-path-regexp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
47769
diff
changeset
|
208 "A regular expression probably matching the host and filename or e-mail part of a URL.") |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
209 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
210 (defvar thing-at-point-short-url-regexp |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
211 (concat "[-A-Za-z0-9.]+" thing-at-point-url-path-regexp) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
212 "A regular expression probably matching a URL without an access scheme. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
213 Hostname matching is stricter in this case than for |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
214 ``thing-at-point-url-regexp''.") |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
215 |
47769
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
216 (defvar thing-at-point-uri-schemes |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
217 ;; Officials from http://www.iana.org/assignments/uri-schemes |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
218 '("ftp://" "http://" "gopher://" "mailto:" "news:" "nntp:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
219 "telnet://" "wais://" "file:/" "prospero:" "z39.50s:" "z39.50r:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
220 "cid:" "mid:" "vemmi:" "service:" "imap:" "nfs:" "acap:" "rtsp:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
221 "tip:" "pop:" "data:" "dav:" "opaquelocktoken:" "sip:" "tel:" "fax:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
222 "modem:" "ldap:" "https://" "soap.beep:" "soap.beeps:" "urn:" "go:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
223 "afs:" "tn3270:" "mailserver:" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
224 ;; Compatibility |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
225 "snews:") |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
226 "Uniform Resource Identifier (URI) Schemes") |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
227 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
228 (defvar thing-at-point-url-regexp |
47769
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
229 (concat "\\<\\(" (mapconcat 'identity thing-at-point-uri-schemes "\\|") "\\)" |
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
230 thing-at-point-url-path-regexp) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
231 "A regular expression probably matching a complete URL.") |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
232 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
233 (defvar thing-at-point-markedup-url-regexp |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
234 "<URL:[^>]+>" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
235 "A regular expression matching a URL marked up per RFC1738. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
236 This may contain whitespace (including newlines) .") |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
237 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
238 (put 'url 'bounds-of-thing-at-point 'thing-at-point-bounds-of-url-at-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
239 (defun thing-at-point-bounds-of-url-at-point () |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
240 (let ((url "") short strip) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
241 (if (or (setq strip (thing-at-point-looking-at |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
242 thing-at-point-markedup-url-regexp)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
243 (thing-at-point-looking-at thing-at-point-url-regexp) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
244 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
245 (setq short (thing-at-point-looking-at |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
246 thing-at-point-short-url-regexp))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
247 (let ((beginning (match-beginning 0)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
248 (end (match-end 0))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
249 (cond (strip |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
250 (setq beginning (+ beginning 5)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
251 (setq end (- end 1)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
252 (cons beginning end))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
253 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
254 (put 'url 'thing-at-point 'thing-at-point-url-at-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
255 (defun thing-at-point-url-at-point () |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
256 "Return the URL around or before point. |
20982
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
257 |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
258 Search backwards for the start of a URL ending at or after point. If |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
259 no URL found, return nil. The access scheme will be prepended if |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
260 absent: \"mailto:\" if the string contains \"@\", \"ftp://\" if it |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
261 starts with \"ftp\" and not \"ftp:/\", or \"http://\" by default." |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
262 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
263 (let ((url "") short strip) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
264 (if (or (setq strip (thing-at-point-looking-at |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
265 thing-at-point-markedup-url-regexp)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
266 (thing-at-point-looking-at thing-at-point-url-regexp) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
267 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
268 (setq short (thing-at-point-looking-at |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
269 thing-at-point-short-url-regexp))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
270 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
271 (setq url (buffer-substring-no-properties (match-beginning 0) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
272 (match-end 0))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
273 (and strip (setq url (substring url 5 -1))) ; Drop "<URL:" & ">" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
274 ;; strip whitespace |
23764
615a6a17e7d6
(thing-at-point-url-at-point): Don't use current
Richard M. Stallman <rms@gnu.org>
parents:
20982
diff
changeset
|
275 (while (string-match "[ \t\n\r]+" url) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
276 (setq url (replace-match "" t t url))) |
20982
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
277 (and short (setq url (concat (cond ((string-match "@" url) |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
278 "mailto:") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
279 ;; e.g. ftp.swiss... or ftp-swiss... |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
280 ((string-match "^ftp" url) |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
281 "ftp://") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
282 (t "http://")) |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
283 url))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
284 (if (string-equal "" url) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
285 nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
286 url))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
287 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
288 ;; The normal thingatpt mechanism doesn't work for complex regexps. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
289 ;; This should work for almost any regexp wherever we are in the |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
290 ;; match. To do a perfect job for any arbitrary regexp would mean |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
291 ;; testing every position before point. Regexp searches won't find |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
292 ;; matches that straddle the start position so we search forwards once |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
293 ;; and then back repeatedly and then back up a char at a time. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
294 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
295 (defun thing-at-point-looking-at (regexp) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
296 "Return non-nil if point is in or just after a match for REGEXP. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
297 Set the match data from the earliest such match ending at or after |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
298 point." |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
299 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
300 (let ((old-point (point)) match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
301 (and (looking-at regexp) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
302 (>= (match-end 0) old-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
303 (setq match (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
304 ;; Search back repeatedly from end of next match. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
305 ;; This may fail if next match ends before this match does. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
306 (re-search-forward regexp nil 'limit) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
307 (while (and (re-search-backward regexp nil t) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
308 (or (> (match-beginning 0) old-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
309 (and (looking-at regexp) ; Extend match-end past search start |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
310 (>= (match-end 0) old-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
311 (setq match (point)))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
312 (if (not match) nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
313 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
314 ;; Back up a char at a time in case search skipped |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
315 ;; intermediate match straddling search start pos. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
316 (while (and (not (bobp)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
317 (progn (backward-char 1) (looking-at regexp)) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
318 (>= (match-end 0) old-point) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
319 (setq match (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
320 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
321 (looking-at regexp))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
322 |
18682
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
323 (put 'url 'end-op |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
324 (function (lambda () |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
325 (let ((bounds (thing-at-point-bounds-of-url-at-point))) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
326 (if bounds |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
327 (goto-char (cdr bounds)) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
328 (error "No URL here")))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
329 (put 'url 'beginning-op |
18682
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
330 (function (lambda () |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
331 (let ((bounds (thing-at-point-bounds-of-url-at-point))) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
332 (if bounds |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
333 (goto-char (car bounds)) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
334 (error "No URL here")))))) |
4934 | 335 |
14169 | 336 ;; Whitespace |
4934 | 337 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
338 (defun forward-whitespace (arg) |
4934 | 339 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
340 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
341 (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
|
342 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
343 (if (re-search-backward "[ \t]+\\|\n" nil 'move) |
4934 | 344 (or (eq (char-after (match-beginning 0)) 10) |
345 (skip-chars-backward " \t"))) | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
346 (setq arg (1+ arg))))) |
4934 | 347 |
14169 | 348 ;; Buffer |
4934 | 349 |
29592
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
350 (put 'buffer 'end-op (lambda () (goto-char (point-max)))) |
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
351 (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) |
4934 | 352 |
14169 | 353 ;; Symbols |
4934 | 354 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
355 (defun forward-symbol (arg) |
4934 | 356 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
357 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
358 (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
|
359 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
360 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) |
4934 | 361 (skip-syntax-backward "w_")) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
362 (setq arg (1+ arg))))) |
4934 | 363 |
14169 | 364 ;; Syntax blocks |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
365 |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
366 (defun forward-same-syntax (&optional arg) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
367 (interactive "p") |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
368 (while (< arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
369 (skip-syntax-backward |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
370 (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
|
371 (setq arg (1+ arg))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
372 (while (> arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
373 (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
|
374 (setq arg (1- arg)))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
375 |
14169 | 376 ;; Aliases |
4934 | 377 |
378 (defun word-at-point () (thing-at-point 'word)) | |
379 (defun sentence-at-point () (thing-at-point 'sentence)) | |
380 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
381 (defun read-from-whole-string (str) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
382 "Read a lisp expression from STR. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
383 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
|
384 (let* ((read-data (read-from-string str)) |
4934 | 385 (more-left |
386 (condition-case nil | |
47862 | 387 ;; The call to `ignore' suppresses a compiler warning. |
47861
1a9d2889f455
(read-from-whole-string): Add call to `ignore'.
Richard M. Stallman <rms@gnu.org>
parents:
47786
diff
changeset
|
388 (progn (ignore (read-from-string (substring str (cdr read-data)))) |
4934 | 389 t) |
390 (end-of-file nil)))) | |
391 (if more-left | |
392 (error "Can't read whole string") | |
393 (car read-data)))) | |
394 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
395 (defun form-at-point (&optional thing pred) |
4934 | 396 (let ((sexp (condition-case nil |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
397 (read-from-whole-string (thing-at-point (or thing 'sexp))) |
4934 | 398 (error nil)))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
399 (if (or (not pred) (funcall pred sexp)) sexp))) |
4934 | 400 |
27581 | 401 ;;;###autoload |
4934 | 402 (defun sexp-at-point () (form-at-point 'sexp)) |
27581 | 403 ;;;###autoload |
4934 | 404 (defun symbol-at-point () (form-at-point 'sexp 'symbolp)) |
27581 | 405 ;;;###autoload |
4934 | 406 (defun number-at-point () (form-at-point 'sexp 'numberp)) |
27581 | 407 ;;;###autoload |
4934 | 408 (defun list-at-point () (form-at-point 'list 'listp)) |
409 | |
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
30818
diff
changeset
|
410 ;;; thingatpt.el ends here |