Mercurial > emacs
annotate lisp/thingatpt.el @ 75428:d19b2a81fa12
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Sat, 27 Jan 2007 13:52:16 +0000 |
parents | e3694f1cb928 |
children | 9355f9b7bbff 697178a8197c 95d0cdf160ea |
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 |
74442 | 3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, |
75347 | 4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 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 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
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). |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
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) |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
56 "Move forward to the end of the Nth 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. |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
83 (funcall ;; First move to end. |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
84 (or (get thing 'end-op) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
85 (lambda () (forward-thing thing 1)))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
86 (funcall ;; Then move to beg. |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
87 (or (get thing 'beginning-op) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
88 (lambda () (forward-thing thing -1)))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
89 (let ((beg (point))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
90 (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
|
91 ;; 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
|
92 ;; 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
|
93 ;; 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
|
94 (let ((real-end |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
95 (progn |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
96 (funcall |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
97 (or (get thing 'end-op) |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
98 (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
|
99 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
100 (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
|
101 (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
|
102 (goto-char orig) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
103 ;; 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
|
104 ;; so that we can find a thing that ends at ORIG. |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
105 (funcall ;; First, move to beg. |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
106 (or (get thing 'beginning-op) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
107 (lambda () (forward-thing thing -1)))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
108 (funcall ;; Then move to end. |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
109 (or (get thing 'end-op) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
110 (lambda () (forward-thing thing 1)))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
111 (let ((end (point)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
112 (real-beg |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
113 (progn |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
114 (funcall |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
115 (or (get thing 'beginning-op) |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
116 (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
|
117 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
118 (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
|
119 (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
|
120 (error nil))))) |
4934 | 121 |
122 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
123 (defun thing-at-point (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
124 "Return the THING at point. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
125 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
|
126 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
|
127 `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
|
128 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
129 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
|
130 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
|
131 (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
|
132 (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
|
133 (let ((bounds (bounds-of-thing-at-point thing))) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
134 (if bounds |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
135 (buffer-substring (car bounds) (cdr bounds)))))) |
4934 | 136 |
14169 | 137 ;; Go to beginning/end |
4934 | 138 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
139 (defun beginning-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
140 (let ((bounds (bounds-of-thing-at-point thing))) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
141 (or bounds (error "No %s here" thing)) |
4934 | 142 (goto-char (car bounds)))) |
143 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
144 (defun end-of-thing (thing) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
145 (let ((bounds (bounds-of-thing-at-point thing))) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
146 (or bounds (error "No %s here" thing)) |
4934 | 147 (goto-char (cdr bounds)))) |
148 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
149 ;; Special cases |
4934 | 150 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
151 ;; Lines |
9931
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
152 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
153 ;; bolp will be false when you click on the last line in the buffer |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
154 ;; and it has no final newline. |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
155 |
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
156 (put 'line 'beginning-op |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
157 (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))) |
9931
23e429e3fb18
(line): Add a beginning-op function.
Richard M. Stallman <rms@gnu.org>
parents:
7938
diff
changeset
|
158 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
159 ;; Sexps |
4934 | 160 |
161 (defun in-string-p () | |
162 (let ((orig (point))) | |
163 (save-excursion | |
164 (beginning-of-defun) | |
165 (nth 3 (parse-partial-sexp (point) orig))))) | |
166 | |
167 (defun end-of-sexp () | |
168 (let ((char-syntax (char-syntax (char-after (point))))) | |
169 (if (or (eq char-syntax ?\)) | |
170 (and (eq char-syntax ?\") (in-string-p))) | |
171 (forward-char 1) | |
172 (forward-sexp 1)))) | |
173 | |
174 (put 'sexp 'end-op 'end-of-sexp) | |
175 | |
18432
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
176 (defun beginning-of-sexp () |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
177 (let ((char-syntax (char-syntax (char-before (point))))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
178 (if (or (eq char-syntax ?\() |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
179 (and (eq char-syntax ?\") (in-string-p))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
180 (forward-char -1) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
181 (forward-sexp -1)))) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
182 |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
183 (put 'sexp 'beginning-op 'beginning-of-sexp) |
b2bc7438b6b0
(beginning-of-sexp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17790
diff
changeset
|
184 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
185 ;; Lists |
4934 | 186 |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
187 (put 'list 'end-op (lambda () (up-list 1))) |
4934 | 188 (put 'list 'beginning-op 'backward-sexp) |
189 | |
49270
c84445fe778c
(thing-at-point-file-name-chars): Include non-ASCII
Dave Love <fx@gnu.org>
parents:
47862
diff
changeset
|
190 ;; Filenames and URLs www.com/foo%32bar |
4934 | 191 |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
192 (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" |
4934 | 193 "Characters allowable in filenames.") |
194 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
195 (put 'filename 'end-op |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
196 (lambda () |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
197 (re-search-forward (concat "\\=[" thing-at-point-file-name-chars "]*") |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
198 nil t))) |
4934 | 199 (put 'filename 'beginning-op |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
200 (lambda () |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
201 (if (re-search-backward (concat "[^" thing-at-point-file-name-chars "]") |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
202 nil t) |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
203 (forward-char) |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
204 (goto-char (point-min))))) |
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 |
74109
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
217 ;; Officials from http://www.iana.org/assignments/uri-schemes.html |
47769
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:" |
74109
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
224 "crid:" "dict:" "dns:" "dtn:" "h323:" "im:" "info:" "ipp:" |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
225 "iris.beep:" "mtqp:" "mupdate:" "pres:" "sips:" "snmp:" "tag:" |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
226 "tftp:" "xmlrpc.beep:" "xmlrpc.beeps:" "xmpp:" |
47769
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
227 ;; Compatibility |
74109
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
228 "snews:" "irc:" "mms://" "mmsh://") |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
229 "Uniform Resource Identifier (URI) Schemes.") |
47769
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
230 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
231 (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
|
232 (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
|
233 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
|
234 "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
|
235 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
236 (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
|
237 "<URL:[^>]+>" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
238 "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
|
239 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
|
240 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
241 (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
|
242 (defun thing-at-point-bounds-of-url-at-point () |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
243 (let ((strip (thing-at-point-looking-at |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
244 thing-at-point-markedup-url-regexp))) ;; (url "") short |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
245 (if (or strip |
72849
1302db63b66b
(thing-at-point-bounds-of-url-at-point): Delete spurious backquote.
Richard M. Stallman <rms@gnu.org>
parents:
71614
diff
changeset
|
246 (thing-at-point-looking-at thing-at-point-url-regexp) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
247 ;; Access scheme omitted? |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
248 ;; (setq short (thing-at-point-looking-at |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
249 ;; thing-at-point-short-url-regexp)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
250 ) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
251 (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
|
252 (end (match-end 0))) |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
253 (when strip |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
254 (setq beginning (+ beginning 5)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
255 (setq end (- end 1))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
256 (cons beginning end))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
257 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
258 (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
|
259 (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
|
260 "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
|
261 |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
262 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
|
263 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
|
264 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
|
265 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
|
266 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
267 (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
|
268 (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
|
269 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
|
270 (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
|
271 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
272 (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
|
273 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
|
274 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
275 (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
|
276 (match-end 0))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
277 (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
|
278 ;; strip whitespace |
23764
615a6a17e7d6
(thing-at-point-url-at-point): Don't use current
Richard M. Stallman <rms@gnu.org>
parents:
20982
diff
changeset
|
279 (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
|
280 (setq url (replace-match "" t t url))) |
74109
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
281 (and short (setq url (concat (cond ((string-match "^[a-zA-Z]+:" url) |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
282 ;; already has a URL scheme. |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
283 "") |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
284 ((string-match "@" url) |
20982
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
285 "mailto:") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
286 ;; 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
|
287 ((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
|
288 "ftp://") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
289 (t "http://")) |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
290 url))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
291 (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
|
292 nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
293 url))))) |
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 ;; 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
|
296 ;; 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
|
297 ;; 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
|
298 ;; 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
|
299 ;; 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
|
300 ;; 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
|
301 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
302 (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
|
303 "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
|
304 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
|
305 point." |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
306 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
307 (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
|
308 (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
|
309 (>= (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
|
310 (setq match (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
311 ;; 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
|
312 ;; 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
|
313 (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
|
314 (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
|
315 (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
|
316 (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
|
317 (>= (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
|
318 (setq match (point)))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
319 (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
|
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 ;; 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
|
322 ;; 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
|
323 (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
|
324 (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
|
325 (>= (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
|
326 (setq match (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
327 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
328 (looking-at regexp))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
329 |
18682
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
330 (put 'url 'end-op |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
331 (lambda () |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
332 (let ((bounds (thing-at-point-bounds-of-url-at-point))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
333 (if bounds |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
334 (goto-char (cdr bounds)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
335 (error "No URL here"))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
336 (put 'url 'beginning-op |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
337 (lambda () |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
338 (let ((bounds (thing-at-point-bounds-of-url-at-point))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
339 (if bounds |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
340 (goto-char (car bounds)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
341 (error "No URL here"))))) |
4934 | 342 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
343 ;; Whitespace |
4934 | 344 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
345 (defun forward-whitespace (arg) |
4934 | 346 (interactive "p") |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
347 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
348 (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
|
349 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
350 (if (re-search-backward "[ \t]+\\|\n" nil 'move) |
4934 | 351 (or (eq (char-after (match-beginning 0)) 10) |
352 (skip-chars-backward " \t"))) | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
353 (setq arg (1+ arg))))) |
4934 | 354 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
355 ;; Buffer |
4934 | 356 |
29592
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
357 (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
|
358 (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) |
4934 | 359 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
360 ;; Symbols |
4934 | 361 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
362 (defun forward-symbol (arg) |
4934 | 363 (interactive "p") |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
364 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
365 (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
|
366 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
367 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) |
4934 | 368 (skip-syntax-backward "w_")) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
369 (setq arg (1+ arg))))) |
4934 | 370 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
371 ;; Syntax blocks |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
372 |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
373 (defun forward-same-syntax (&optional arg) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
374 (interactive "p") |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
375 (while (< arg 0) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
376 (skip-syntax-backward |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
377 (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
|
378 (setq arg (1+ arg))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
379 (while (> arg 0) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
380 (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
|
381 (setq arg (1- arg)))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
382 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
383 ;; Aliases |
4934 | 384 |
385 (defun word-at-point () (thing-at-point 'word)) | |
386 (defun sentence-at-point () (thing-at-point 'sentence)) | |
387 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
388 (defun read-from-whole-string (str) |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
389 "Read a Lisp expression from STR. |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
390 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
|
391 (let* ((read-data (read-from-string str)) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
392 (more-left |
4934 | 393 (condition-case nil |
47862 | 394 ;; 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
|
395 (progn (ignore (read-from-string (substring str (cdr read-data)))) |
4934 | 396 t) |
397 (end-of-file nil)))) | |
398 (if more-left | |
399 (error "Can't read whole string") | |
400 (car read-data)))) | |
401 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
402 (defun form-at-point (&optional thing pred) |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
403 (let ((sexp (condition-case nil |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
404 (read-from-whole-string (thing-at-point (or thing 'sexp))) |
4934 | 405 (error nil)))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
406 (if (or (not pred) (funcall pred sexp)) sexp))) |
4934 | 407 |
27581 | 408 ;;;###autoload |
4934 | 409 (defun sexp-at-point () (form-at-point 'sexp)) |
27581 | 410 ;;;###autoload |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
411 (defun symbol-at-point () |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
412 (let ((thing (thing-at-point 'symbol))) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
413 (if thing (intern thing)))) |
27581 | 414 ;;;###autoload |
4934 | 415 (defun number-at-point () (form-at-point 'sexp 'numberp)) |
27581 | 416 ;;;###autoload |
4934 | 417 (defun list-at-point () (form-at-point 'list 'listp)) |
418 | |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
419 ;; arch-tag: bb65a163-dae2-4055-aedc-fe11f497f698 |
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
30818
diff
changeset
|
420 ;;; thingatpt.el ends here |