Mercurial > emacs
annotate lisp/thingatpt.el @ 111686:e8049570c647
* lisp/eshell/: Use with-silent-modifications.
* lisp/eshell/esh-cmd.el (eshell-parse-command):
* lisp/eshell/esh-arg.el (eshell-parse-arguments):
* lisp/eshell/em-script.el (eshell-source-file):
Use with-silent-modifications.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 23 Nov 2010 12:36:15 -0500 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
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, |
106815 | 4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
5 ;; Free Software Foundation, Inc. |
4934 | 6 |
7 ;; 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
|
8 ;; Maintainer: FSF |
5140 | 9 ;; Keywords: extensions, matching, mouse |
4934 | 10 ;; Created: Thu Mar 28 13:48:23 1991 |
11 | |
12 ;; This file is part of GNU Emacs. | |
13 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
14 ;; GNU Emacs is free software: you can redistribute it and/or modify |
4934 | 15 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
16 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
17 ;; (at your option) any later version. |
4934 | 18 |
19 ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
24 ;; You should have received a copy of the GNU General Public License |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
26 |
7938 | 27 ;;; Commentary: |
14169 | 28 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
29 ;; 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
|
30 ;; point, whatever that "thing" happens to be. The "thing" is defined by |
16427 | 31 ;; its beginning and end positions in the buffer. |
4934 | 32 ;; |
33 ;; 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
|
34 ;; positions by moving first forward to the end of the "thing", and then |
4934 | 35 ;; 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
|
36 ;; forward-"thing" operator (eg. forward-word, forward-line). |
4934 | 37 ;; |
38 ;; 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
|
39 ;; "thing": |
4934 | 40 ;; |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
41 ;; forward-op Function to call to skip forward over a "thing" (or |
4934 | 42 ;; with a negative argument, backward). |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
43 ;; |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
44 ;; 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
|
45 ;; end-op Function to call to skip to the end of a "thing". |
4934 | 46 ;; |
47 ;; Reliance on existing operators means that many `things' can be accessed | |
48 ;; without further code: eg. | |
49 ;; (thing-at-point 'line) | |
50 ;; (thing-at-point 'page) | |
51 | |
14169 | 52 ;;; Code: |
4934 | 53 |
54 (provide 'thingatpt) | |
55 | |
14169 | 56 ;; Basic movement |
4934 | 57 |
58 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
59 (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
|
60 "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
|
61 (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
|
62 (intern-soft (format "forward-%s" thing))))) |
29516
4e7f28c8e364
(forward-thing): Use functionp instead of fboundp.
Gerd Moellmann <gerd@gnu.org>
parents:
27581
diff
changeset
|
63 (if (functionp forward-op) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
64 (funcall forward-op (or n 1)) |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
65 (error "Can't determine how to move over a %s" thing)))) |
4934 | 66 |
14169 | 67 ;; General routines |
4934 | 68 |
69 ;;;###autoload | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
70 (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
|
71 "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
|
72 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
|
73 Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', |
81447
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
74 `email', `word', `sentence', `whitespace', `line', `page' and others. |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
75 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
76 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
|
77 a symbol as a valid THING. |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
78 |
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
79 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
|
80 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
|
81 (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
|
82 (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
|
83 (let ((orig (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
84 (condition-case nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
85 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
86 ;; 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
|
87 (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
|
88 (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
|
89 (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
|
90 (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
|
91 (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
|
92 (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
|
93 (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
|
94 (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
|
95 ;; 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
|
96 ;; 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
|
97 ;; 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
|
98 (let ((real-end |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
99 (progn |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
100 (funcall |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
101 (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
|
102 (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
|
103 (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
104 (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
|
105 (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
|
106 (goto-char orig) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
107 ;; 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
|
108 ;; 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
|
109 (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
|
110 (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
|
111 (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
|
112 (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
|
113 (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
|
114 (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
|
115 (let ((end (point)) |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
116 (real-beg |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
117 (progn |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
118 (funcall |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
119 (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
|
120 (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
|
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', |
81447
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
131 `email', `word', `sentence', `whitespace', `line', `page' and others. |
16629
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))) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
138 (if bounds |
18610
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 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
153 ;; Special cases |
4934 | 154 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
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 |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
161 (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
|
162 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
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 () | |
99114
e71b3b67d831
(end-of-sexp, beginning-of-sexp, forward-same-syntax): Omit default
Chong Yidong <cyd@stupidchicken.com>
parents:
99053
diff
changeset
|
172 (let ((char-syntax (char-syntax (char-after)))) |
4934 | 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 () |
99114
e71b3b67d831
(end-of-sexp, beginning-of-sexp, forward-same-syntax): Omit default
Chong Yidong <cyd@stupidchicken.com>
parents:
99053
diff
changeset
|
181 (let ((char-syntax (char-syntax (char-before)))) |
18432
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 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
189 ;; Lists |
4934 | 190 |
103014
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
191 (put 'list 'bounds-of-thing-at-point 'thing-at-point-bounds-of-list-at-point) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
192 |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
193 (defun thing-at-point-bounds-of-list-at-point () |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
194 (save-excursion |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
195 (let ((opoint (point)) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
196 (beg (condition-case nil |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
197 (progn (up-list -1) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
198 (point)) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
199 (error nil)))) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
200 (condition-case nil |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
201 (if beg |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
202 (progn (forward-sexp) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
203 (cons beg (point))) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
204 ;; Are we are at the beginning of a top-level sexp? |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
205 (forward-sexp) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
206 (let ((end (point))) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
207 (backward-sexp) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
208 (if (>= opoint (point)) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
209 (cons opoint end)))) |
3df429718fa4
* thingatpt.el (thing-at-point-bounds-of-list-at-point): New
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
210 (error nil))))) |
4934 | 211 |
49270
c84445fe778c
(thing-at-point-file-name-chars): Include non-ASCII
Dave Love <fx@gnu.org>
parents:
47862
diff
changeset
|
212 ;; Filenames and URLs www.com/foo%32bar |
4934 | 213 |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
214 (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" |
4934 | 215 "Characters allowable in filenames.") |
216 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
217 (put 'filename 'end-op |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
218 (lambda () |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
219 (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
|
220 nil t))) |
4934 | 221 (put 'filename 'beginning-op |
49486
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
222 (lambda () |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
223 (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
|
224 nil t) |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
225 (forward-char) |
b8c5db4dbb2b
(thing-at-point-file-name-chars): Include
Dave Love <fx@gnu.org>
parents:
49461
diff
changeset
|
226 (goto-char (point-min))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
227 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
228 (defvar thing-at-point-url-path-regexp |
97342
536c0f16eb08
Fix for bug #572, removed () from url regexp.
Joakim Verona <joakim@verona.se>
parents:
94678
diff
changeset
|
229 "[^]\t\n \"'<>[^`{}]*[^]\t\n \"'<>[^`{}.,;]+" |
47786
a9de3e936eef
(thing-at-point-url-path-regexp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
47769
diff
changeset
|
230 "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
|
231 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
232 (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
|
233 (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
|
234 "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
|
235 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
|
236 ``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
|
237 |
47769
2a1b3fb46c95
(thing-at-point-uri-schemes): New variable.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
38412
diff
changeset
|
238 (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
|
239 ;; 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
|
240 '("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
|
241 "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
|
242 "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
|
243 "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
|
244 "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
|
245 "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
|
246 "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
|
247 "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
|
248 "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
|
249 ;; 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
|
250 "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
|
251 "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
|
252 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
253 (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
|
254 (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
|
255 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
|
256 "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
|
257 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
258 (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
|
259 "<URL:[^>]+>" |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
260 "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
|
261 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
|
262 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
263 (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
|
264 (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
|
265 (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
|
266 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
|
267 (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
|
268 (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
|
269 ;; 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
|
270 ;; (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
|
271 ;; 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
|
272 ) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
273 (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
|
274 (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
|
275 (when strip |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
276 (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
|
277 (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
|
278 (cons beginning end))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
279 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
280 (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
|
281 (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
|
282 "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
|
283 |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
284 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
|
285 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
|
286 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
|
287 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
|
288 |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
289 (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
|
290 (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
|
291 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
|
292 (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
|
293 ;; Access scheme omitted? |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
294 (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
|
295 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
|
296 (progn |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
297 (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
|
298 (match-end 0))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
299 (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
|
300 ;; strip whitespace |
23764
615a6a17e7d6
(thing-at-point-url-at-point): Don't use current
Richard M. Stallman <rms@gnu.org>
parents:
20982
diff
changeset
|
301 (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
|
302 (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
|
303 (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
|
304 ;; 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
|
305 "") |
b67c1da1e80e
(thing-at-point-url-at-point): Don't add a redundant scheme.
Richard M. Stallman <rms@gnu.org>
parents:
72849
diff
changeset
|
306 ((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
|
307 "mailto:") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
308 ;; 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
|
309 ((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
|
310 "ftp://") |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
311 (t "http://")) |
3a01b0f0338f
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Dave Love <fx@gnu.org>
parents:
18682
diff
changeset
|
312 url))) |
18610
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
313 (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
|
314 nil |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
315 url))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
316 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
317 ;; 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
|
318 ;; 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
|
319 ;; 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
|
320 ;; 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
|
321 ;; 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
|
322 ;; 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
|
323 |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
324 (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
|
325 "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
|
326 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
|
327 point." |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
328 (save-excursion |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
329 (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
|
330 (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
|
331 (>= (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
|
332 (setq match (point))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
333 ;; 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
|
334 ;; 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
|
335 (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
|
336 (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
|
337 (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
|
338 (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
|
339 (>= (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
|
340 (setq match (point)))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
341 (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
|
342 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
343 ;; 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
|
344 ;; 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
|
345 (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
|
346 (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
|
347 (>= (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
|
348 (setq match (point)))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
349 (goto-char match) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
350 (looking-at regexp))))) |
4726c7bb05a9
(thing-at-point): Use `thing-at-point' property, if any.
Richard M. Stallman <rms@gnu.org>
parents:
18439
diff
changeset
|
351 |
18682
28f77aef27b2
(url): Define end-op property again. Wrap end-op
Richard M. Stallman <rms@gnu.org>
parents:
18610
diff
changeset
|
352 (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
|
353 (lambda () |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
354 (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
|
355 (if bounds |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
356 (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
|
357 (error "No URL here"))))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
358 (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
|
359 (lambda () |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
360 (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
|
361 (if bounds |
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
362 (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
|
363 (error "No URL here"))))) |
4934 | 364 |
81447
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
365 ;; Email addresses |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
366 (defvar thing-at-point-email-regexp |
81448
3513d3f93273
* thingatpt.el (thing-at-point-email-regexp): Don't require two chars
Karl Fogel <kfogel@red-bean.com>
parents:
81447
diff
changeset
|
367 "<?[-+_.~a-zA-Z][-+_.~:a-zA-Z0-9]*@[-.a-zA-Z0-9]+>?" |
81447
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
368 "A regular expression probably matching an email address. |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
369 This does not match the real name portion, only the address, optionally |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
370 with angle brackets.") |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
371 |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
372 ;; Haven't set 'forward-op on 'email nor defined 'forward-email' because |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
373 ;; not sure they're actually needed, and URL seems to skip them too. |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
374 ;; Note that (end-of-thing 'email) and (beginning-of-thing 'email) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
375 ;; work automagically, though. |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
376 |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
377 (put 'email 'bounds-of-thing-at-point |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
378 (lambda () |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
379 (let ((thing (thing-at-point-looking-at thing-at-point-email-regexp))) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
380 (if thing |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
381 (let ((beginning (match-beginning 0)) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
382 (end (match-end 0))) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
383 (cons beginning end)))))) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
384 |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
385 (put 'email 'thing-at-point |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
386 (lambda () |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
387 (let ((boundary-pair (bounds-of-thing-at-point 'email))) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
388 (if boundary-pair |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
389 (buffer-substring-no-properties |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
390 (car boundary-pair) (cdr boundary-pair)))))) |
697178a8197c
* thingatpt.el: Add support for email addresses (`email').
Karl Fogel <kfogel@red-bean.com>
parents:
75347
diff
changeset
|
391 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
392 ;; Whitespace |
4934 | 393 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
394 (defun forward-whitespace (arg) |
4934 | 395 (interactive "p") |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
396 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
397 (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
|
398 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
399 (if (re-search-backward "[ \t]+\\|\n" nil 'move) |
4934 | 400 (or (eq (char-after (match-beginning 0)) 10) |
401 (skip-chars-backward " \t"))) | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
402 (setq arg (1+ arg))))) |
4934 | 403 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
404 ;; Buffer |
4934 | 405 |
29592
9d10c14d8199
(toplevel symbol-properties): Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29516
diff
changeset
|
406 (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
|
407 (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) |
4934 | 408 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
409 ;; Symbols |
4934 | 410 |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
411 (defun forward-symbol (arg) |
4934 | 412 (interactive "p") |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
413 (if (natnump arg) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
414 (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
|
415 (while (< arg 0) |
17790
3ae7560f0959
(forward-whitespace, forward-symbol):
Richard M. Stallman <rms@gnu.org>
parents:
16668
diff
changeset
|
416 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) |
4934 | 417 (skip-syntax-backward "w_")) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
418 (setq arg (1+ arg))))) |
4934 | 419 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
420 ;; Syntax blocks |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
421 |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
422 (defun forward-same-syntax (&optional arg) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
423 (interactive "p") |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
424 (while (< arg 0) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
425 (skip-syntax-backward |
99114
e71b3b67d831
(end-of-sexp, beginning-of-sexp, forward-same-syntax): Omit default
Chong Yidong <cyd@stupidchicken.com>
parents:
99053
diff
changeset
|
426 (char-to-string (char-syntax (char-before)))) |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
427 (setq arg (1+ arg))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
428 (while (> arg 0) |
99114
e71b3b67d831
(end-of-sexp, beginning-of-sexp, forward-same-syntax): Omit default
Chong Yidong <cyd@stupidchicken.com>
parents:
99053
diff
changeset
|
429 (skip-syntax-forward (char-to-string (char-syntax (char-after)))) |
12593
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
430 (setq arg (1- arg)))) |
e961f9a213a7
(forward-same-syntax): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9931
diff
changeset
|
431 |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
432 ;; Aliases |
4934 | 433 |
434 (defun word-at-point () (thing-at-point 'word)) | |
435 (defun sentence-at-point () (thing-at-point 'sentence)) | |
436 | |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
437 (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
|
438 "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
|
439 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
|
440 (let* ((read-data (read-from-string str)) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
441 (more-left |
4934 | 442 (condition-case nil |
47862 | 443 ;; 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
|
444 (progn (ignore (read-from-string (substring str (cdr read-data)))) |
4934 | 445 t) |
446 (end-of-file nil)))) | |
447 (if more-left | |
448 (error "Can't read whole string") | |
449 (car read-data)))) | |
450 | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
451 (defun form-at-point (&optional thing pred) |
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49486
diff
changeset
|
452 (let ((sexp (condition-case nil |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
453 (read-from-whole-string (thing-at-point (or thing 'sexp))) |
4934 | 454 (error nil)))) |
16629
a3345c8d1779
(thing-at-point-url-chars): Allow period.
Richard M. Stallman <rms@gnu.org>
parents:
16427
diff
changeset
|
455 (if (or (not pred) (funcall pred sexp)) sexp))) |
4934 | 456 |
27581 | 457 ;;;###autoload |
99053
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
458 (defun sexp-at-point () |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
459 "Return the sexp at point, or nil if none is found." |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
460 (form-at-point 'sexp)) |
27581 | 461 ;;;###autoload |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
462 (defun symbol-at-point () |
99053
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
463 "Return the symbol at point, or nil if none is found." |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
464 (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
|
465 (if thing (intern thing)))) |
27581 | 466 ;;;###autoload |
99053
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
467 (defun number-at-point () |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
468 "Return the number at point, or nil if none is found." |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
469 (form-at-point 'sexp 'numberp)) |
27581 | 470 ;;;###autoload |
99053
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
471 (defun list-at-point () |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
472 "Return the Lisp list at point, or nil if none is found." |
926c8689e999
(sexp-at-point, symbol-at-point, number-at-point, list-at-point): Add
Chong Yidong <cyd@stupidchicken.com>
parents:
97342
diff
changeset
|
473 (form-at-point 'list 'listp)) |
4934 | 474 |
71614
07e63b17c925
(symbol-at-point): Don't use `form-at-point' which
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68651
diff
changeset
|
475 ;; 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
|
476 ;;; thingatpt.el ends here |