Mercurial > emacs
annotate lisp/thingatpt.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
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 |