Mercurial > emacs
annotate lisp/thingatpt.el @ 19630:95743e18a01c
(defgroup, defcustom): Add Emacs 19 compatibility definitions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 30 Aug 1997 19:48:14 +0000 |
parents | 28f77aef27b2 |
children | 3a01b0f0338f |
rev | line source |
---|---|
4934 | 1 ;;; thingatpt.el --- Get the `thing' at point |
2 | |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
3 ;; Copyright (C) 1991,92,93,94,95,96,1997 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." |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
75 (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
|
76 (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
|
77 (let ((orig (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
78 (condition-case nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
79 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
80 ;; 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
|
81 (let ((end (progn |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
82 (funcall |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
83 (or (get thing 'end-op) |
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
84 (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
|
85 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
86 (beg (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
87 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
88 (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
|
89 (function (lambda () (forward-thing thing -1))))) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
90 (point)))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
91 (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
|
92 ;; 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
|
93 ;; 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
|
94 ;; 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
|
95 (let ((real-end |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
96 (progn |
16668
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
97 (funcall |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
98 (or (get thing 'end-op) |
bf249c4b4beb
(bounds-of-thing-at-point): Allow the end
Richard M. Stallman <rms@gnu.org>
parents:
16653
diff
changeset
|
99 (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
|
100 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
101 (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
|
102 (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
|
103 (goto-char orig) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
104 ;; 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
|
105 ;; 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
|
106 (let ((beg (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
107 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
108 (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
|
109 (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
|
110 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
111 (end (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
112 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
113 (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
|
114 (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
|
115 (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
116 (real-beg |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
117 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
118 (funcall |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
119 (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
|
120 (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
|
121 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
122 (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
|
123 (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
|
124 (error nil))))) |
4934 | 125 |
126 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
127 (defun thing-at-point (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
128 "Return the THING at point. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
129 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
|
130 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
|
131 `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
|
132 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
133 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
|
134 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
|
135 (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
|
136 (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
|
137 (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
|
138 (if bounds |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
139 (buffer-substring (car bounds) (cdr bounds)))))) |
4934 | 140 |
14169 | 141 ;; Go to beginning/end |
4934 | 142 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
143 (defun beginning-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
144 (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
|
145 (or bounds (error "No %s here" thing)) |
4934 | 146 (goto-char (car bounds)))) |
147 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
148 (defun end-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
149 (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
|
150 (or bounds (error "No %s here" thing)) |
4934 | 151 (goto-char (cdr bounds)))) |
152 | |
14169 | 153 ;; Special cases |
4934 | 154 |
14169 | 155 ;; Lines |
9931
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
156 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
157 ;; 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
|
158 ;; and it has no final newline. |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
159 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
160 (put 'line 'beginning-op |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
161 (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
|
162 |
14169 | 163 ;; Sexps |
4934 | 164 |
165 (defun in-string-p () | |
166 (let ((orig (point))) | |
167 (save-excursion | |
168 (beginning-of-defun) | |
169 (nth 3 (parse-partial-sexp (point) orig))))) | |
170 | |
171 (defun end-of-sexp () | |
172 (let ((char-syntax (char-syntax (char-after (point))))) | |
173 (if (or (eq char-syntax ?\)) | |
174 (and (eq char-syntax ?\") (in-string-p))) | |
175 (forward-char 1) | |
176 (forward-sexp 1)))) | |
177 | |
178 (put 'sexp 'end-op 'end-of-sexp) | |
179 | |
18432
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
180 (defun beginning-of-sexp () |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
181 (let ((char-syntax (char-syntax (char-before (point))))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
182 (if (or (eq char-syntax ?\() |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
183 (and (eq char-syntax ?\") (in-string-p))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
184 (forward-char -1) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
185 (forward-sexp -1)))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
186 |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
187 (put 'sexp 'beginning-op 'beginning-of-sexp) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
188 |
14169 | 189 ;; Lists |
4934 | 190 |
191 (put 'list 'end-op (function (lambda () (up-list 1)))) | |
192 (put 'list 'beginning-op 'backward-sexp) | |
193 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
194 ;; Filenames and URLs |
4934 | 195 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
196 (defvar thing-at-point-file-name-chars "~/A-Za-z0-9---_.${}#%,:" |
4934 | 197 "Characters allowable in filenames.") |
198 | |
199 (put 'filename 'end-op | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
200 '(lambda () (skip-chars-forward thing-at-point-file-name-chars))) |
4934 | 201 (put 'filename 'beginning-op |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
202 '(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
|
203 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
204 (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
|
205 "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
206 "A regular expression probably matching the host, path or e-mail part of a URL.") |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
207 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
208 (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
|
209 (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
|
210 "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
|
211 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
|
212 ``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
|
213 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
214 (defvar 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 (concat |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
216 "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
217 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
|
218 "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
|
219 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
220 (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
|
221 "<URL:[^>]+>" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
222 "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
|
223 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
|
224 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
225 (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
|
226 (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
|
227 (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
|
228 (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
|
229 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
|
230 (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
|
231 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
232 (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
|
233 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
|
234 (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
|
235 (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
|
236 (cond (strip |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
237 (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
|
238 (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
|
239 (cons beginning end))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
240 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
241 (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
|
242 (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
|
243 "Return the URL around or before point. |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
244 Search backwards for the start of a URL 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
|
245 point. If no URL found, return nil. The access scheme, `http://' |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
246 will be prepended if absent." |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
247 (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
|
248 (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
|
249 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
|
250 (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
|
251 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
252 (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
|
253 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
|
254 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
255 (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
|
256 (match-end 0))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
257 (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
|
258 ;; strip whitespace |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
259 (while (string-match "\\s +\\|\n+" url) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
260 (setq url (replace-match "" t t url))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
261 (and short (setq url (concat (if (string-match "@" url) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
262 "mailto:" "http://") url))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
263 (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
|
264 nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
265 url))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
266 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
267 ;; 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
|
268 ;; 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
|
269 ;; 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
|
270 ;; 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
|
271 ;; 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
|
272 ;; 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
|
273 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
274 (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
|
275 "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
|
276 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
|
277 point." |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
278 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
279 (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
|
280 (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
|
281 (>= (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
|
282 (setq match (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
283 ;; 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
|
284 ;; 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
|
285 (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
|
286 (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
|
287 (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
|
288 (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
|
289 (>= (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
|
290 (setq match (point)))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
291 (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
|
292 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
293 ;; 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
|
294 ;; 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
|
295 (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
|
296 (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
|
297 (>= (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
|
298 (setq match (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
299 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
300 (looking-at regexp))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
301 |
18682
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
302 (put 'url 'end-op |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
303 (function (lambda () |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
304 (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
|
305 (if bounds |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
306 (goto-char (cdr bounds)) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
307 (error "No URL here")))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
308 (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
|
309 (function (lambda () |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
310 (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
|
311 (if bounds |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
312 (goto-char (car bounds)) |
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
313 (error "No URL here")))))) |
4934 | 314 |
14169 | 315 ;; Whitespace |
4934 | 316 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
317 (defun forward-whitespace (arg) |
4934 | 318 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
319 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
320 (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
|
321 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
322 (if (re-search-backward "[ \t]+\\|\n" nil 'move) |
4934 | 323 (or (eq (char-after (match-beginning 0)) 10) |
324 (skip-chars-backward " \t"))) | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
325 (setq arg (1+ arg))))) |
4934 | 326 |
14169 | 327 ;; Buffer |
4934 | 328 |
18439
825069bf1e74
(buffer): Don't use beginning-of-buffer, end-of-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
18432
diff
changeset
|
329 (put 'buffer 'end-op '(lambda () (goto-char (point-max)))) |
825069bf1e74
(buffer): Don't use beginning-of-buffer, end-of-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
18432
diff
changeset
|
330 (put 'buffer 'beginning-op '(lambda () (goto-char (point-min)))) |
4934 | 331 |
14169 | 332 ;; Symbols |
4934 | 333 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
334 (defun forward-symbol (arg) |
4934 | 335 (interactive "p") |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
336 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
337 (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
|
338 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
339 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) |
4934 | 340 (skip-syntax-backward "w_")) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
341 (setq arg (1+ arg))))) |
4934 | 342 |
14169 | 343 ;; Syntax blocks |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
344 |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
345 (defun forward-same-syntax (&optional arg) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
346 (interactive "p") |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
347 (while (< arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
348 (skip-syntax-backward |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
349 (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
|
350 (setq arg (1+ arg))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
351 (while (> arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
352 (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
|
353 (setq arg (1- arg)))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
354 |
14169 | 355 ;; Aliases |
4934 | 356 |
357 (defun word-at-point () (thing-at-point 'word)) | |
358 (defun sentence-at-point () (thing-at-point 'sentence)) | |
359 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
360 (defun read-from-whole-string (str) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
361 "Read a lisp expression from STR. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
362 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
|
363 (let* ((read-data (read-from-string str)) |
4934 | 364 (more-left |
365 (condition-case nil | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
366 (progn (read-from-string (substring str (cdr read-data))) |
4934 | 367 t) |
368 (end-of-file nil)))) | |
369 (if more-left | |
370 (error "Can't read whole string") | |
371 (car read-data)))) | |
372 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
373 (defun form-at-point (&optional thing pred) |
4934 | 374 (let ((sexp (condition-case nil |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
375 (read-from-whole-string (thing-at-point (or thing 'sexp))) |
4934 | 376 (error nil)))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
377 (if (or (not pred) (funcall pred sexp)) sexp))) |
4934 | 378 |
379 (defun sexp-at-point () (form-at-point 'sexp)) | |
380 (defun symbol-at-point () (form-at-point 'sexp 'symbolp)) | |
381 (defun number-at-point () (form-at-point 'sexp 'numberp)) | |
382 (defun list-at-point () (form-at-point 'list 'listp)) | |
383 | |
384 ;; thingatpt.el ends here. |