aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1996-03-24 14:20:05 +0000
committerRichard M. Stallman1996-03-24 14:20:05 +0000
commit87e2d03987eaef12a199a9acd80c0c18442f5088 (patch)
tree1bc091451f7baf1c70bd2c608b2a50ed4e1386ba
parentf201b69e8c8593d0b9f3d31b7b8a1e91dc29c3f3 (diff)
downloademacs-87e2d03987eaef12a199a9acd80c0c18442f5088.tar.gz
emacs-87e2d03987eaef12a199a9acd80c0c18442f5088.zip
Doc fixes. Reorganized. Retired v18 support.
(ffap-bindings): Offers a default installation. (ffap-string-at-point): Modified arguments. (ffap-gnus-hook): Updated for Gnus 5. (ffap-tex-init): Delayed initialization of `ffap-tex-path'. (ffap-dired): New entry in `ffap-alist'. (ffap-menu-rescan): May fontify the choices in buffer. (ffap-read-file-or-url): `PC-completion-as-file-name-predicate' used if available, to work with complete.el.
Diffstat
-rw-r--r--lisp/ffap.el1179
1 files changed, 585 insertions, 594 deletions
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 547f2e7835b..2ce98117774 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,8 +1,11 @@
1;;; ffap.el -- find-file-at-point, 1;;; ffap.el --- find file or url at point
2 2
3;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
4 4
5;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> 5;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
6;; Created: 29 Mar 1993
7;; Keywords: files, hypermedia, matching, mouse
8;; X-Latest: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
6 9
7;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
8 11
@@ -21,189 +24,88 @@
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA. 25;; Boston, MA 02111-1307, USA.
23 26
24;;; Commentary:
25
26;; A replacement for find-file {C-x C-f}: finds file or URL,
27;; guessing default from text at point. Many features!
28;; Send bugs or suggestions with M-x ffap-bug.
29
30;; See ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ for most recent version:
31;; ffap.el.gz -- this file, compressed with gzip
32;; ffap-xe.el -- support code for XEmacs 19.*
33;; COPYING.gz -- GNU General Public License, version 2
34;; README -- description of these and other files
35;;
36;; For the last version sent to elisp-archive@cis.ohio-state.edu, see:
37;; ftp://ftp.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/misc/ffap.el.Z
38;; (mirrored in gatekeeper.dec.com:/pub/GNU/elisp-archive/misc/)
39
40;;; Description:
41;;
42;; Command find-file-at-point (== ffap) replaces find-file. With a
43;; prefix, it behaves exactly like find-file. Without a prefix, it
44;; first tries to guess a default file or URL based on the text around
45;; the point (set `ffap-require-prefix' to swap these behaviors).
46;; This is a quick way to fetch URL and file references in many
47;; situations, such as in mail or news messages, README's, and
48;; MANIFEST's.
49;;
50;; Some related commands are ffap-at-mouse, ffap-next, ffap-menu,
51;; ffap-other-window, ffap-other-frame.
52;;
53;; This package is about user convenience. It adds nothing to the
54;; elisp programmer's repertoire.
55
56 27
57;;; Installation: 28;;; Commentary:
58
59;; Quick Setup:
60;;
61;; For a basic installation, just install ffap.el somewhere in your
62;; `load-path', byte-compile it, and add the following two lines near
63;; the end of your ~/.emacs (or equivalent) file:
64;;
65;; (require 'ffap) ; load this file
66;; (global-set-key "\C-x\C-f" 'find-file-at-point)
67;;
68;; Other Packages: ffap notices the presence of several other packages
69;; when it is loaded. In particular, if you use ange-ftp, efs, w3,
70;; complete, or ff-paths (version < 3.00), it is best to load or
71;; autoload them before loading ffap (ffap does not need any of them).
72;; If you use ff-paths version >= 3.00, load it after ffap.
73
74;; Fancier Setup:
75;;
76;; ffap has many options. The next comment block contains some
77;; fancier code that you might want to adapt for your .emacs. For
78;; even more features, look at the documentation (M-x apropos ffap),
79;; and perhaps check the comments in the "User Variables" and "Peanut
80;; Gallery" sections of this file.
81
82;; ;; Before loading ffap:
83;;
84;; (setq ffap-url-regexp nil) ; to disable all URL features
85;;
86;; ;; Loading ffap:
87;; (require 'ffap) ; as in "Quick Setup" above
88;;
89;; After loading ffap:
90;;
91;; (global-set-key "\C-x\C-f" 'find-file-at-point) ; as in "Quick Setup"
92;; (global-set-key "\C-x4f" 'ffap-other-window) ; or \C-f
93;; (global-set-key "\C-x5f" 'ffap-other-frame) ; or \C-f
94;;
95;; (setq ffap-alist ; remove something in `ffap-alist'
96;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
97;;
98;; (setq ffap-alist ; add something to `ffap-alist'
99;; (cons
100;; (cons "^[Yy][Ss][Nn][0-9]+$"
101;; (defun ffap-ysn (name)
102;; (concat
103;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
104;; (substring name 3) ".html")))
105;; ffap-alist))
106;;
107;;
108;; Before or after loading ffap:
109;;
110;; (setq ffap-alist nil) ; disable all `ffap-alist' actions
111;;
112;; (setq ffap-require-prefix t) ; without prefix, ffap == find-file
113;;
114;; (setq ffap-machine-p-known 'accept) ; to avoid pinging
115;; 29;;
116;; ;; Choose a mouse binding appropriate for your emacs version: 30;; Command find-file-at-point replaces find-file. With a prefix, it
117;; (global-set-key [S-mouse-1] 'ffap-at-mouse) ; Emacs 19 31;; behaves exactly like find-file. Without a prefix, it first tries
118;; (global-set-key [(meta button1)] 'ffap-at-mouse) ; XEmacs 32;; to guess a default file or url from the text around the point
119;; (and window-system ; Emacs 18 (from .emacs) 33;; (`ffap-require-prefix' swaps these behaviors). This is useful for
120;; (setq window-setup-hook 34;; following references in situations such as mail or news buffers,
121;; '(lambda nil (define-key mouse-map x-button-s-left 35;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
122;; 'ffap-at-mouse)))) 36;; M-x ffap-bug.
123;; 37;;
124;; ;; Use Netscape instead of w3 to fetch URL's. Mosaic is very similar. 38;; For the default installation, byte-compile ffap.el somewhere in
125;; (if (eq window-system 'x) 39;; your `load-path' and add these two lines to your .emacs file:
126;; (progn
127;; ;; Get browse-url at http://wombat.doc.ic.ac.uk/emacs/browse-url.el,
128;; ;; or get a (probably out of date) copy from the ftp site above.
129;; (autoload 'browse-url-netscape "browse-url" nil t)
130;; (setq ffap-url-fetcher 'browse-url-netscape)))
131;; ;; Or for a hairier ffap-url-fetcher, get ffap-url.el (same ftp site).
132;; 40;;
133;; ;; Support for gnus, vm, rmail (see hook definitions for bindings): 41;; (require 'ffap) ; load the package
134;; (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) 42;; (ffap-bindings) ; do default key bindings
135;; (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
136;; (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
137;; (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
138
139
140;;; Related packages:
141;; 43;;
142;; If you have hyperbole, you may not need this package, although ffap 44;; ffap-bindings makes the following global key bindings:
143;; is smaller and smarter at this particular task. Also note that w3
144;; (ftp.cs.indiana.edu:/pub/elisp/w3/README) offers a similar command
145;; w3-follow-url-at-point.
146;; 45;;
147;; The browse-url package (above) notices URL's and hands them off to 46;; C-x C-f find-file-at-point (abbreviated as ffap)
148;; w3 or an external WWW browser. Package |~/misc/goto-address.el.gz| 47;; C-x 4 f ffap-other-window
149;; by Eric J. Ding <ericding@mit.edu> notices URL's and mail 48;; C-x 5 f ffap-other-frame
150;; addresses, and can pre-fontify a buffer to highlight them. Gnus5 49;; S-mouse-3 ffap-at-mouse
151;; (ding) and vm also provide similar support in their messages.
152
153
154;;; Examples:
155;; 50;;
156;; Try M-x find-file-at-point (maybe {C-x C-f}) on these examples. 51;; ffap-bindings also adds hooks to make the following local bindings
157;; These local file examples use ordinary find-file: 52;; in vm, gnus, and rmail:
158;; 53;;
159;; ffap.el, /etc/motd, $MAIL -- find local or absolute files 54;; M-l ffap-next, or ffap-gnus-next in gnus
160;; .emacs book.sty info/cl pwd.h -- search paths depending on filename 55;; M-m ffap-menu, or ffap-gnus-menu in gnus
161;; (require 'rmail) -- search paths depending on major-mode
162;; file:/etc/motd -- depends on `ffap-url-unwrap-local'
163;; 56;;
164;; These remote file examples work if you have ange-ftp or efs: 57;; If you do not like these bindings, modify the variable
58;; `ffap-bindings', or write your own.
165;; 59;;
166;; ftp:/pub -- no ping (always works) 60;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
167;; ftp.x.org:README -- no ping, a nice recursive example 61;; to load or autoload them before ffap. If you use ff-paths, load it
168;; anonymous@ftp.x.org:/README -- synonym 62;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
169;; ftp.x.org://README -- synonym 63;; option variables. In particular, if ffap is slow, try these:
170;; ftp://ftp.x.org/README -- depends on `ffap-url-unwrap-remote'
171;; ftp.mathcs.emory.edu -- depends on `ffap-machine-p-known'
172;; mic@ftp:/ -- depends on `ffap-machine-p-local'
173;; ftp.mathcs.emory.edu:/ -- depends on `ffap-ftp-sans-slash-regexp'
174;; 64;;
175;; These URL examples use `ffap-url-fetcher' (default w3-fetch): 65;; (setq ffap-alist nil) ; faster, dumber prompting
66;; (setq ffap-machine-p-known 'accept) ; no pinging
67;; (setq ffap-url-regexp nil) ; disable url features in ffap
176;; 68;;
177;; http://www.cc.emory.edu 69;; ffap uses w3 (if found) or else browse-url to fetch url's. For
178;; http://www.cs.indiana.edu/elisp/w3/docs.html 70;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
179;; http://info.cern.ch/default.html 71;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
180;; news:news.newusers.questions 72;; the file and url references within a buffer.
181;; mailto:mic@mathcs.emory.edu 73
182;; mic@mathcs.emory.edu -- same as previous 74;;; Todo list:
183;; <mic@mathcs.emory.edu> -- same as previous 75;; * recognize paths inside /usr/bin:/bin:/etc, ./ffap.el:80:
184;; <root> -- mailto:root 76;; * let "/path/file#key" jump to key (offset or regexp) in /path/file
185;; <mic.9@mathcs.emory.edu> -- see `ffap-foo@bar-prefix' 77;; * find file of symbol if TAGS is loaded (like above)
186;; file:/etc/motd -- see `ffap-url-unwrap-local' 78;; * break up long menus into multiple panes (like imenu?)
187;; ftp://ftp.x.org/README -- see `ffap-url-unwrap-remote' 79;; * notice node in "(dired)Virtual Dired" (handle the space?)
188;; 80;; * notice "machine.dom blah blah blah path/file" (how?)
189;; Multiline gopher blocks (as in .gopherrc and usenet of yesteryear): 81;; * if w3 becomes standard, could rewrite to use its functions
190;; 82;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
191;; Type=1 83;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
192;; Name=Electronic Texts (ffap ignores this) 84;; * support for custom.el
193;; Path= 85;; + handle "$(HOME)" in Makefiles?
194;; Host=etext.archive.umich.edu 86;; + modify `font-lock-keywords' to do fontification
195;; Port=70
196 87
197 88
198;;; Code: 89;;; Code:
199 90
200(provide 'ffap) 91(provide 'ffap)
201 92
93;; Versions: This file is tested with Emacs 19.30. It mostly works
94;; with XEmacs, but get ffap-xe.el for the popup menu. Emacs 18 is
95;; now abandoned (get ffap-15.el instead).
96
97(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t)
98 "Whether ffap thinks it is running under XEmacs.")
99
100
101
202;;; User Variables: 102;;; User Variables:
203 103
204;; This function is used inside defvars: 104;; This function is used inside defvars:
205(defun ffap-soft-value (name &optional default) 105(defun ffap-soft-value (name &optional default)
206 ;; Avoid interning. Bug: (ffap-soft-value "nil" 5) --> 5 106 "Return value of symbol with NAME, if it is interned.
107Otherwise return nil (or the optional DEFAULT value)."
108 ;; Bug: (ffap-soft-value "nil" 5) --> 5
207 (let ((sym (intern-soft name))) 109 (let ((sym (intern-soft name)))
208 (if (and sym (boundp sym)) (symbol-value sym) default))) 110 (if (and sym (boundp sym)) (symbol-value sym) default)))
209 111
@@ -221,10 +123,10 @@
221Nil also disables the generation of such paths by ffap.") 123Nil also disables the generation of such paths by ffap.")
222 124
223(defvar ffap-url-unwrap-local t 125(defvar ffap-url-unwrap-local t
224 "*If set, convert local \"file:\" URL to path before prompting.") 126 "*If non-nil, convert \"file:\" url to local path before prompting.")
225 127
226(defvar ffap-url-unwrap-remote t 128(defvar ffap-url-unwrap-remote t
227 "*Convert remote \"file:\" or \"ftp:\" URL to path before prompting. 129 "*If non-nil, convert \"ftp:\" url to remote path before prompting.
228This is ignored if `ffap-ftp-regexp' is nil.") 130This is ignored if `ffap-ftp-regexp' is nil.")
229 131
230(defvar ffap-ftp-default-user 132(defvar ffap-ftp-default-user
@@ -232,14 +134,14 @@ This is ignored if `ffap-ftp-regexp' is nil.")
232 (equal (ffap-soft-value "efs-default-user") "anonymous")) 134 (equal (ffap-soft-value "efs-default-user") "anonymous"))
233 nil 135 nil
234 "anonymous") 136 "anonymous")
235 "*User name in ftp paths generated by ffap (see host-to-ftp-path). 137 "*User name in ftp paths generated by `ffap-host-to-path'.
236Nil to fall back on `efs-default-user' or `ange-ftp-default-user'.") 138Nil to rely on `efs-default-user' or `ange-ftp-default-user'.")
237 139
238(defvar ffap-rfs-regexp 140(defvar ffap-rfs-regexp
239 ;; Remote file access built into file system? HP rfa or Andrew afs: 141 ;; Remote file access built into file system? HP rfa or Andrew afs:
240 "\\`/\\(afs\\|net\\)/." 142 "\\`/\\(afs\\|net\\)/."
241 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.") 143 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
242 "*Paths matching this are remote file-system paths. Nil to disable.") 144 "*Matching paths are treated as remote. Nil to disable.")
243 145
244(defvar ffap-url-regexp 146(defvar ffap-url-regexp
245 ;; Could just use `url-nonrelative-link' of w3, if loaded. 147 ;; Could just use `url-nonrelative-link' of w3, if loaded.
@@ -251,80 +153,62 @@ Nil to fall back on `efs-default-user' or `ange-ftp-default-user'.")
251 "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host 153 "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
252 "\\)." ; require one more character 154 "\\)." ; require one more character
253 ) 155 )
254 "Regexp matching URL's, or nil to disable.") 156 "Regexp matching url's. Nil to disable url features in ffap.")
255 157
256(defvar ffap-foo@bar-prefix "mailto" 158(defvar ffap-foo-at-bar-prefix "mailto"
257 "*Presumed url prefix type of strings like \"<foo.9z@bar>\". 159 "*Presumed url prefix type of strings like \"<foo.9z@bar>\".
258Sensible values are nil, \"news\", or \"mailto\".") 160Sensible values are nil, \"news\", or \"mailto\".")
259 161
260 162
261;;; Peanut Gallery: 163;;; Peanut Gallery:
262 164;;
263;; Users of ffap occasionally suggest new features. If I consider 165;; Users of ffap occasionally suggest new features. If I consider
264;; those features interesting but not clear winners (a matter of 166;; those features interesting but not clear winners (a matter of
265;; personal taste) I try to leave options to enable them. Read 167;; personal taste) I try to leave options to enable them. Read
266;; through this section, and for any features you like, put an 168;; through this section for features that you like, put an appropriate
267;; appropriate form in your ~/.emacs file. 169;; enabler in your .emacs file.
268 170
269(defvar ffap-dired-wildcards nil ; "[*?][^/]*$" 171(defvar ffap-dired-wildcards nil ; "[*?][^/]*$"
270 ;; From RHOGEE, 07 Jul 1994. 172 ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still
271 ;; Disabled: dired is still available by "C-x C-d <pattern>", and 173 ;; available by "C-x C-d <pattern>", and valid filenames may
272 ;; valid filenames may contain wildcard characters. 174 ;; sometimes contain wildcard characters.
273 "*A regexp matching filename wildcard characters, or nil. 175 "*A regexp matching filename wildcard characters, or nil.
274If find-file-at-point gets a filename matching this pattern, 176If `find-file-at-point' gets a filename matching this pattern,
275it passes it on to dired instead of find-file.") 177it passes it on to `dired' instead of `find-file'.")
276 178
277(defvar ffap-newfile-prompt nil ; t 179(defvar ffap-newfile-prompt nil ; t
278 ;; From RHOGEE, 11 Jul 1994. 180 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
279 ;; Disabled: this is better handled by `find-file-not-found-hooks'. 181 ;; better handled by `find-file-not-found-hooks'.
280 "*Whether find-file-at-point prompts about a nonexistent file.") 182 "*Whether `find-file-at-point' prompts about a nonexistent file.")
281 183
282(defvar ffap-require-prefix nil 184(defvar ffap-require-prefix nil
283 ;; From RHOGEE, 20 Oct 1994. 185 ;; Suggestion from RHOGEE, 20 Oct 1994.
284 ;; This is nil so that neophytes notice ffap. Experts instead may 186 "*If set, reverses the prefix argument to `find-file-at-point'.
285 ;; prefer to disable ffap most of the time. 187This is nil so neophytes notice ffap. Experts may prefer to disable
286 "*If set, reverses the prefix argument to find-file-at-point.") 188ffap most of the time.")
287
288(defvar ffap-file-finder
289 ;; From RHOGEE, 20 Oct 1994.
290 ;; This allows compatibility with ff-paths version < 3.00.
291 ;; For ff-paths version >= 3.00, just load it after ffap.
292 (if (commandp 'find-file-using-paths)
293 'find-file-using-paths
294 ;; Try to overcome load-order dependency:
295 (eval-after-load
296 "ff-paths"
297 '(and (commandp 'find-file-using-paths)
298 (setq ffap-file-finder find-file-using-paths)))
299 'find-file)
300 "*The command symbol called by find-file-at-point to find a file.
301Probably find-file, or find-file-using-paths if you use ff-paths
302with version < 3.00.")
303(put 'ffap-file-finder 'risky-local-variable t)
304 189
305(defvar ffap-url-fetcher 'w3-fetch 190(defvar ffap-file-finder 'find-file
306 "*A function of one argument, called by ffap to fetch URL's. 191 "*The command called by `find-file-at-point' to find a file.")
307The default is w3-fetch from the w3 package. If you prefer Mosaic or 192(put 'ffap-file-finder 'risky-local-variable t)
308Netscape, install http://wombat.doc.ic.ac.uk/emacs/browse-url.el, and
309add one of the following lines to your setup:
310
311\(setq ffap-url-fetcher 'browse-url-netscape\)
312\(setq ffap-url-fetcher 'browse-url-mosaic\)
313 193
314Or for something hairier \(choose fetch method based on url type and 194(defvar ffap-url-fetcher
315prompting\) get ffap-url.el wherever you ffap.el." 195 (cond ((fboundp 'w3-fetch) 'w3-fetch)
316 ;; Big old `lambda' examples deleted. Some remote-control references: 196 ((fboundp 'browse-url-netscape) 'browse-url-netscape)
197 (t 'w3-fetch))
198 ;; Remote control references:
317 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html 199 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
318 ;; http://home.netscape.com/newsref/std/x-remote.html 200 ;; http://home.netscape.com/newsref/std/x-remote.html
319 ) 201 "*A function of one argument, called by ffap to fetch an URL.
202Reasonable choices are `w3-fetch' or `browse-url-netscape'.
203For a fancier alternative, get ffap-url.el.")
320(put 'ffap-url-fetcher 'risky-local-variable t) 204(put 'ffap-url-fetcher 'risky-local-variable t)
321 205
322 206
323;;; Command ffap-next: 207;;; Command ffap-next:
324;; 208;;
325;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. 209;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
326;; Since then, broke up into ffap-next-guess (noninteractive) and 210;; then, broke it up into ffap-next-guess (noninteractive) and
327;; ffap-next (a command), now work on files as well as url's. 211;; ffap-next (a command). It now work on files as well as url's.
328 212
329(defvar ffap-next-regexp 213(defvar ffap-next-regexp
330 ;; If you want ffap-next to find URL's only, try this: 214 ;; If you want ffap-next to find URL's only, try this:
@@ -334,12 +218,12 @@ prompting\) get ffap-url.el wherever you ffap.el."
334 ;; It pays to put a big fancy regexp here, since ffap-guesser is 218 ;; It pays to put a big fancy regexp here, since ffap-guesser is
335 ;; much more time-consuming than regexp searching: 219 ;; much more time-consuming than regexp searching:
336 "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\." 220 "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
337 "*Regular expression governing search of ffap-next.") 221 "*Regular expression governing movements of `ffap-next'.")
338 222
339(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.") 223(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.")
340(defun ffap-next-guess (&optional back lim) 224(defun ffap-next-guess (&optional back lim)
341 "Move point to next file or url, and return it as a string. 225 "Move point to next file or url, and return it as a string.
342If nothing found, leaves point at limit and returns nil. 226If nothing is found, leave point at limit and return nil.
343Optional BACK argument makes search backwards. 227Optional BACK argument makes search backwards.
344Optional LIM argument limits the search. 228Optional LIM argument limits the search.
345Only considers strings that match `ffap-next-regexp'." 229Only considers strings that match `ffap-next-regexp'."
@@ -360,7 +244,7 @@ Optional argument BACK says to search backwards.
360Optional argument WRAP says to try wrapping around if necessary. 244Optional argument WRAP says to try wrapping around if necessary.
361Interactively: use a single prefix to search backwards, 245Interactively: use a single prefix to search backwards,
362double prefix to wrap forward, triple to wrap backwards. 246double prefix to wrap forward, triple to wrap backwards.
363Actual search is done by ffap-next-guess." 247Actual search is done by `ffap-next-guess'."
364 (interactive 248 (interactive
365 (cdr (assq (prefix-numeric-value current-prefix-arg) 249 (cdr (assq (prefix-numeric-value current-prefix-arg)
366 '((1) (4 t) (16 nil t) (64 t t))))) 250 '((1) (4 t) (16 nil t) (64 t t)))))
@@ -379,7 +263,7 @@ Actual search is done by ffap-next-guess."
379 (if wrap "" "more "))))) 263 (if wrap "" "more ")))))
380 264
381(defun ffap-next-url (&optional back wrap) 265(defun ffap-next-url (&optional back wrap)
382 "Just like ffap-next, but searches with `ffap-url-regexp'." 266 "Like `ffap-next', but search with `ffap-url-regexp'."
383 (interactive) 267 (interactive)
384 (let ((ffap-next-regexp ffap-url-regexp)) 268 (let ((ffap-next-regexp ffap-url-regexp))
385 (if (interactive-p) 269 (if (interactive-p)
@@ -387,151 +271,95 @@ Actual search is done by ffap-next-guess."
387 (ffap-next back wrap)))) 271 (ffap-next back wrap))))
388 272
389 273
390;;; Hooks for GNUS, VM, Rmail:
391;;
392;; See "Installation" above for suggested use of these hooks.
393;; If you do not like these bindings, just write hooks with
394;; whatever bindings you would prefer.
395;;
396;; Any suggestions of more "memorable" bindings? -- Mic
397
398(defun ffap-ro-mode-hook nil
399 "Binds ffap-gnus-next and ffap-gnus-menu to M-l and M-m, resp."
400 (local-set-key "\M-l" 'ffap-next)
401 (local-set-key "\M-m" 'ffap-menu)
402 )
403
404(defun ffap-gnus-hook nil
405 "Binds ffap-gnus-next and ffap-gnus-menu to L and M, resp."
406 (set (make-local-variable 'ffap-foo@bar-prefix) "news") ; message-id's
407 ;; Note lowercase l and m are taken:
408 (local-set-key "L" 'ffap-gnus-next)
409 (local-set-key "M" 'ffap-gnus-menu))
410
411(defun ffap-gnus-wrapper (form) ; used by both commands below
412 (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
413 (gnus-summary-select-article)) ; get article of current line
414 ;; Preserve selected buffer, but do not do save-window-excursion,
415 ;; since we want to see any window created by form. Temporarily
416 ;; select the article buffer, so we see any point movement.
417 (let ((sb (window-buffer (selected-window))))
418 (gnus-configure-windows 'article)
419 (pop-to-buffer gnus-article-buffer)
420 (widen)
421 ;; Skip headers at first, for ffap-gnus-next (which wraps around)
422 (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
423 (unwind-protect
424 (eval form)
425 (pop-to-buffer sb))))
426
427(defun ffap-gnus-next nil
428 "Run ffap-next in the GNUS article buffer."
429 (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
430
431(defun ffap-gnus-menu nil
432 "Run ffap-menu in the GNUS article buffer."
433 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
434
435
436;;; Remote machines and paths: 274;;; Remote machines and paths:
437 275
438(fset 'ffap-replace-path-component 276(defun ffap-replace-path-component (fullname name)
439 (if (or (featurep 'efs) 277 "In remote FULLNAME, replace path with NAME. May return nil."
440 (and 278 ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
441 (boundp 'file-name-handler-alist) ; v19 279 (let (found)
442 (rassq 'efs-file-handler-function file-name-handler-alist))) 280 (mapcar
443 'efs-replace-path-component 281 (function (lambda (sym) (and (fboundp sym) (setq found sym))))
444 'ange-ftp-replace-name-component)) 282 '(
283 efs-replace-path-component
284 ange-ftp-replace-path-component
285 ange-ftp-replace-name-component
286 ))
287 (and found
288 (fset 'ffap-replace-path-component found)
289 (funcall found fullname name))))
290;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
445 291
446(defun ffap-file-exists-string (file) 292(defun ffap-file-exists-string (file)
447 ;; With certain packages (ange-ftp, jka-compr?) file-exists-p 293 ;; With certain packages (ange-ftp, jka-compr?) file-exists-p
448 ;; sometimes returns a nicer string than it is given. Otherwise, it 294 ;; sometimes returns a nicer string than it is given. Otherwise, it
449 ;; just returns nil or t. 295 ;; just returns nil or t.
450 "Return FILE \(maybe modified\) if it exists, else nil." 296 "Return FILE \(maybe modified\) if it exists, else nil."
451 (let ((exists (file-exists-p file))) 297 (and file ; quietly reject nil
452 (and exists (if (stringp exists) exists file)))) 298 (let ((exists (file-exists-p file)))
299 (and exists (if (stringp exists) exists file)))))
453 300
454;; I cannot decide a "best" strategy here, so these are variables. In 301;; I cannot decide a "best" strategy here, so these are variables. In
455;; particular, if `Pinging...' is broken or takes too long on your 302;; particular, if `Pinging...' is broken or takes too long on your
456;; machine, try setting these all to accept or reject. 303;; machine, try setting these all to accept or reject.
457(defvar ffap-machine-p-local 'reject ; this happens often 304(defvar ffap-machine-p-local 'reject ; this happens often
458 "A symbol, one of: ping, accept, reject. 305 "*A symbol, one of: ping, accept, reject.
459This is what ffap-machine-p does with hostnames that have no domain.") 306What `ffap-machine-p' does with hostnames that have no domain.")
460(defvar ffap-machine-p-known 'ping ; 'accept for speed 307(defvar ffap-machine-p-known 'ping ; 'accept for speed
461 "A symbol, one of: ping, accept, reject. 308 "*A symbol, one of: ping, accept, reject.
462This is what ffap-machine-p does with hostnames that have a known domain 309What `ffap-machine-p' does with hostnames that have a known domain
463\(see lisp/mail-extr.el for the list of known domains\).") 310\(see mail-extr.el for the known domains\).")
464(defvar ffap-machine-p-unknown 'reject 311(defvar ffap-machine-p-unknown 'reject
465 "A symbol, one of: ping, accept, reject. 312 "*A symbol, one of: ping, accept, reject.
466This is what ffap-machine-p does with hostnames that have an unknown domain 313What `ffap-machine-p' does with hostnames that have an unknown domain
467\(see lisp/mail-extr.el for the list of known domains\).") 314\(see mail-extr.el for the known domains\).")
468 315
469(defvar ffap-machine-p-known-domains 316(defun ffap-what-domain (domain)
470 '("com" "edu" "net" "org" "mil" "gov" "us" "arpa") ; USA USA... 317 ;; Like what-domain in mail-extr.el, returns string or nil.
471 ;; This variable is mainly for emacs18. 318 (require 'mail-extr)
472 "Top-level domains known to ffap. Ignored if mail-extr is loadable.") 319 (defvar mail-extr-all-top-level-domains
473 320 (ffap-soft-value "all-top-level-domains" obarray)) ; XEmacs, old Emacs
474(defun ffap-machine-p (host &optional service quiet) 321 (get (intern-soft (downcase domain) mail-extr-all-top-level-domains)
475 "Indicate whether HOST is the name of a real machine. 322 'domain-name))
476The variables ffap-machine-p-local, ffap-machine-p-known, and ffap-machine-p-unknown 323
477control ffap-machine-p depending on HOST's domain \(none/known/unknown\). 324(defun ffap-machine-p (host &optional service quiet strategy)
478Pinging is done using open-network-stream to decide HOST existence. 325 "Decide whether HOST is the name of a real, reachable machine.
479Optional SERVICE specifies the service used \(default \"discard\"\). 326Depending on the domain (none, known, or unknown), follow the strategy
327named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
328or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
329Optional SERVICE specifies the port used \(default \"discard\"\).
480Optional QUIET flag suppresses the \"Pinging...\" message. 330Optional QUIET flag suppresses the \"Pinging...\" message.
331Optional STRATEGY overrides the three variables above.
481Returned values: 332Returned values:
482A t value means that HOST answered. 333 t means that HOST answered.
483A symbol \(accept\) means the relevant variable told us to accept. 334'accept means the relevant variable told us to accept.
484A string means the machine exists, but does not respond for some reason." 335\"mesg\" means HOST exists, but does not respond for some reason."
485 ;; Try some: 336 ;; Try some (Emory local):
486 ;; (ffap-machine-p "ftp") 337 ;; (ffap-machine-p "ftp" nil nil 'ping)
487 ;; (ffap-machine-p "nonesuch") 338 ;; (ffap-machine-p "nonesuch" nil nil 'ping)
488 ;; (ffap-machine-p "ftp.mathcs.emory.edu") 339 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
489 ;; (ffap-machine-p "foo.bonk") 340 ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
490 ;; (ffap-machine-p "foo.bonk.com") 341 ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
491 ;; (ffap-machine-p "cs" 5678) 342 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
492 ;; (ffap-machine-p "gopher.house.gov")
493 ;; Not known to 19.28
494 ;; (ffap-
495 (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?) 343 (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
496 (not (string-match "[^0-9]" host))) ; all numeric! reject it 344 (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
497 nil 345 nil
498 (let* ((domain 346 (let* ((domain
499 (and (string-match "\\.[^.]*$" host) 347 (and (string-match "\\.[^.]*$" host)
500 (downcase (substring host (1+ (match-beginning 0)))))) 348 (downcase (substring host (1+ (match-beginning 0))))))
501 (domain-name ; t, "Country", "Local", or nil 349 (what-domain (if domain (ffap-what-domain domain) "Local")))
502 (cond 350 (or strategy
503 ((not domain) "Local") 351 (setq strategy
504 ;; common non-country domains (some imply US though): 352 (cond ((not domain) ffap-machine-p-local)
505 ;; t) 353 ((not what-domain) ffap-machine-p-unknown)
506 (t 354 (t ffap-machine-p-known))))
507 ;; Use domain-name properties from v19 lisp/mail-extr.el;
508 ;; bbdb/mail-extr also puts this in `all-top-level-domains'.
509 (if (or (featurep 'mail-extr)
510 (and (load "mail-extr" t t)
511 ;; It became a feature between 19.22 and 19.28
512 (provide 'mail-extr)))
513 (get (intern-soft
514 domain
515 (condition-case nil
516 mail-extr-all-top-level-domains
517 ;; Before 19.28, the symbols were in `obarray':
518 (error obarray)))
519 'domain-name)
520 ;; Emacs18 does not have mail-extr:
521 (and (member domain ffap-machine-p-known-domains) t))
522 )))
523 (strategy
524 (cond ((not domain) ffap-machine-p-local)
525 ((not domain-name) ffap-machine-p-unknown)
526 (ffap-machine-p-known))))
527 (cond 355 (cond
528 ((eq strategy 'accept) 'accept) 356 ((eq strategy 'accept) 'accept)
529 ((eq strategy 'reject) nil) 357 ((eq strategy 'reject) nil)
530 ;; assume (eq strategy 'ping) 358 ;; assume (eq strategy 'ping)
531 (t 359 (t
532 (or quiet 360 (or quiet
533 (if (stringp domain-name) 361 (if (stringp what-domain)
534 (message "Pinging %s (%s)..." host domain-name) 362 (message "Pinging %s (%s)..." host what-domain)
535 (message "Pinging %s ..." host))) 363 (message "Pinging %s ..." host)))
536 (condition-case error 364 (condition-case error
537 (progn 365 (progn
@@ -555,7 +383,7 @@ A string means the machine exists, but does not respond for some reason."
555 ((equal mesg "connection failed") 383 ((equal mesg "connection failed")
556 (if (equal (nth 2 error) "permission denied") 384 (if (equal (nth 2 error) "permission denied")
557 nil ; host does not exist 385 nil ; host does not exist
558 ;; Other errors mean host exists: 386 ;; Other errors mean the host exists:
559 (nth 2 error))) 387 (nth 2 error)))
560 ;; Could be "Unknown service": 388 ;; Could be "Unknown service":
561 (t (signal (car error) (cdr error)))))))))))) 389 (t (signal (car error) (cdr error))))))))))))
@@ -563,45 +391,48 @@ A string means the machine exists, but does not respond for some reason."
563(defun ffap-file-remote-p (filename) 391(defun ffap-file-remote-p (filename)
564 "If FILENAME looks remote, return it \(maybe slightly improved\)." 392 "If FILENAME looks remote, return it \(maybe slightly improved\)."
565 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") 393 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
566 ;; (ffap-file-remote-p "/foo.dom://path") 394 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
395 ;; (ffap-file-remote-p "/ffap.el:80")
567 (or (and ffap-ftp-regexp 396 (or (and ffap-ftp-regexp
568 (string-match ffap-ftp-regexp filename) 397 (string-match ffap-ftp-regexp filename)
569 ;; Convert "/host://path" to "/host:/path", to handle a dying 398 ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
570 ;; practice of advertising ftp paths as "host.dom://path". 399 ;; practice of advertising ftp paths as "host.dom://path".
571 (if (string-match "//" filename) 400 (if (string-match "//" filename)
572 (concat (substring filename 0 (match-beginning 0)) 401 ;; (replace-match "/" nil nil filename)
573 (substring filename (1- (match-end 0)))) 402 (concat (substring filename 0 (1+ (match-beginning 0)))
403 (substring filename (match-end 0)))
574 filename)) 404 filename))
575 (and ffap-rfs-regexp 405 (and ffap-rfs-regexp
576 (string-match ffap-rfs-regexp filename) 406 (string-match ffap-rfs-regexp filename)
577 filename))) 407 filename)))
578 408
579(defun ffap-machine-at-point nil 409(defun ffap-machine-at-point nil
580 "Return machine name from around point if it exists, or nil." 410 "Return machine name at point if it exists, or nil."
581 (let ((mach (ffap-string-at-point "-a-zA-Z0-9." nil "."))) 411 (let ((mach (ffap-string-at-point 'machine)))
582 (and (ffap-machine-p mach) mach))) 412 (and (ffap-machine-p mach) mach)))
583 413
414(defsubst ffap-host-to-path (host)
415 "Convert HOST to something like \"/anonymous@HOST:\".
416Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
417 (if (equal host "localhost") ""
418 (concat "/"
419 ffap-ftp-default-user (and ffap-ftp-default-user "@")
420 host ":")))
421
584(defun ffap-fixup-machine (mach) 422(defun ffap-fixup-machine (mach)
585 ;; Convert a machine into an URL, an ftp path, or nil. 423 ;; Convert a hostname into an url, an ftp path, or nil.
586 (cond 424 (cond
587 ((not (and ffap-url-regexp (stringp mach))) nil) 425 ((not (and ffap-url-regexp (stringp mach))) nil)
426 ;; gopher.well.com
588 ((string-match "\\`gopher[-.]" mach) ; or "info"? 427 ((string-match "\\`gopher[-.]" mach) ; or "info"?
589 (concat "gopher://" mach "/")) 428 (concat "gopher://" mach "/"))
429 ;; www.ncsa.uiuc.edu
590 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) 430 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
591 (concat "http://" mach "/")) 431 (concat "http://" mach "/"))
592 ;; More cases? Maybe "telnet:" for archie? 432 ;; More cases? Maybe "telnet:" for archie?
593 (ffap-ftp-regexp (ffap-host-to-path mach)) 433 (ffap-ftp-regexp (ffap-host-to-path mach))
594 )) 434 ))
595 435
596(defun ffap-host-to-path (host)
597 "Convert \"HOST\" to \"/anonymous@HOST:\" (or \"\" for \"localhost\").
598Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
599 (if (equal host "localhost")
600 ""
601 (if ffap-ftp-default-user
602 (concat "/" ffap-ftp-default-user "@" host ":")
603 (concat "/" host ":"))))
604
605(defun ffap-newsgroup-p (string) 436(defun ffap-newsgroup-p (string)
606 "Return STRING if it looks like a newsgroup name, else nil." 437 "Return STRING if it looks like a newsgroup name, else nil."
607 (and 438 (and
@@ -617,7 +448,7 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
617 ;; gnus-gethash is just a macro for intern-soft. 448 ;; gnus-gethash is just a macro for intern-soft.
618 (and (intern-soft string (symbol-value htb)) 449 (and (intern-soft string (symbol-value htb))
619 (setq ret string htbs nil)) 450 (setq ret string htbs nil))
620 ;; If we made it this far, GNUS is running, so ignore "heads": 451 ;; If we made it this far, gnus is running, so ignore "heads":
621 (setq heads nil)) 452 (setq heads nil))
622 (error nil))) 453 (error nil)))
623 (or ret (not heads) 454 (or ret (not heads)
@@ -625,36 +456,36 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
625 (and head (setq head (substring string 0 (match-end 1))) 456 (and head (setq head (substring string 0 (match-end 1)))
626 (member head heads) 457 (member head heads)
627 (setq ret string)))) 458 (setq ret string))))
628 ;; Ever any need to modify string as a newsgroup name? 459 ;; Is there ever a need to modify string as a newsgroup name?
629 ret))) 460 ret)))
630(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" 461(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
631 "ffap-newsgroup-p quickly rejects strings that do not match this.") 462 "Strings not matching this fail `ffap-newsgroup-p'.")
632(defvar ffap-newsgroup-heads ; entirely inadequate 463(defvar ffap-newsgroup-heads ; entirely inadequate
633 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk") 464 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
634 "Used by ffap-newsgroup-p if GNUS is not running.") 465 "Used by `ffap-newsgroup-p' if gnus is not running.")
635 466
636(defun ffap-url-p (string) 467(defsubst ffap-url-p (string)
637 "If STRING looks like an URL, return it (maybe improved), else nil." 468 "If STRING looks like an url, return it (maybe improved), else nil."
638 ;; Does it look like an URL? Ignore case.
639 (let ((case-fold-search t)) 469 (let ((case-fold-search t))
640 (and ffap-url-regexp (string-match ffap-url-regexp string) 470 (and ffap-url-regexp (string-match ffap-url-regexp string)
641 ;; I lied, no improvement: 471 ;; I lied, no improvement:
642 string))) 472 string)))
643 473
644;; Broke these two out of ffap-fixup-url, for sake of ffap-url package. 474;; Broke these out of ffap-fixup-url, for use of ffap-url package.
645(defun ffap-url-unwrap-local (url) 475(defsubst ffap-url-unwrap-local (url)
646 "Return unwrapped local file URL, or nil. Ignores ffap-* variables." 476 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
647 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) 477 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
648 (substring url (1+ (match-end 1))))) 478 (substring url (1+ (match-end 1)))))
649(defun ffap-url-unwrap-remote (url) 479(defsubst ffap-url-unwrap-remote (url)
650 "Return unwrapped remote file URL, or nil. Ignores ffap-* variables." 480 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
651 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) 481 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
652 (concat 482 (concat
653 (ffap-host-to-path (substring url (match-beginning 2) (match-end 2))) 483 (ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
654 (substring url (match-beginning 3) (match-end 3))))) 484 (substring url (match-beginning 3) (match-end 3)))))
485;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
655 486
656(defun ffap-fixup-url (url) 487(defun ffap-fixup-url (url)
657 "Given URL, clean it up and return it. May become a file name." 488 "Clean up URL and return it, maybe as a file name."
658 (cond 489 (cond
659 ((not (stringp url)) nil) 490 ((not (stringp url)) nil)
660 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) 491 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
@@ -672,23 +503,25 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
672;; 503;;
673;; Search actions depending on the major-mode or extensions of the 504;; Search actions depending on the major-mode or extensions of the
674;; current name. Note all the little defun's could be broken out, at 505;; current name. Note all the little defun's could be broken out, at
675;; some loss of locality. I have had a vote for eliminating this 506;; some loss of locality. A good example of featuritis.
676;; from ffap (featuritis)
677 507
678;; First, some helpers for functions in `ffap-alist': 508;; First, some helpers for functions in `ffap-alist':
679 509
510(defvar path-separator ":") ; for XEmacs 19.13
511
680(defun ffap-list-env (env &optional empty) 512(defun ffap-list-env (env &optional empty)
681 ;; Replace this with parse-colon-path (lisp/files.el)? 513 ;; Replace this with parse-colon-path (lisp/files.el)?
682 "Directory list parsed from \":\"-separated ENVironment variable. 514 "Directory list parsed from path envinronment variable ENV.
683Optional EMPTY is default if (getenv ENV) is undefined, and is also 515Optional EMPTY is default if (getenv ENV) is undefined, and is also
684substituted for the first empty-string component, if there is one." 516substituted for the first empty-string component, if there is one.
517Uses `path-separator' to separate the path into directories."
685 ;; Derived from psg-list-env in RHOGEE's ff-paths and 518 ;; Derived from psg-list-env in RHOGEE's ff-paths and
686 ;; bib-cite packages. The `empty' argument is intended to mimic 519 ;; bib-cite packages. The `empty' argument is intended to mimic
687 ;; the semantics of TeX/BibTeX variables, it is substituted for 520 ;; the semantics of TeX/BibTeX variables, it is substituted for
688 ;; any empty string entry. 521 ;; any empty string entry.
689 (if (or empty (getenv env)) ; should return something 522 (if (or empty (getenv env)) ; should return something
690 (let ((start 0) match dir ret) 523 (let ((start 0) match dir ret)
691 (setq env (concat (getenv env) path-separator)) ; note undefined -> ":" 524 (setq env (concat (getenv env) path-separator))
692 (while (setq match (string-match path-separator env start)) 525 (while (setq match (string-match path-separator env start))
693 (setq dir (substring env start match) start (1+ match)) 526 (setq dir (substring env start match) start (1+ match))
694 ;;(and (file-directory-p dir) (not (member dir ret)) ...) 527 ;;(and (file-directory-p dir) (not (member dir ret)) ...)
@@ -701,10 +534,11 @@ substituted for the first empty-string component, if there is one."
701 ret))) 534 ret)))
702 535
703(defun ffap-reduce-path (path) 536(defun ffap-reduce-path (path)
704 "Remove duplicates or non-dirs from PATH." 537 "Remove duplicates and non-directories from PATH list."
705 (let (ret tem) 538 (let (ret tem)
706 (while path 539 (while path
707 (setq tem path path (cdr path)) 540 (setq tem path path (cdr path))
541 (if (equal (car tem) ".") (setcar tem ""))
708 (or (member (car tem) ret) 542 (or (member (car tem) ret)
709 (not (file-directory-p (car tem))) 543 (not (file-directory-p (car tem)))
710 (progn (setcdr tem ret) (setq ret tem)))) 544 (progn (setcdr tem ret) (setq ret tem))))
@@ -726,21 +560,18 @@ substituted for the first empty-string component, if there is one."
726 (nreverse ret))) 560 (nreverse ret)))
727 561
728(defvar ffap-locate-jka-suffixes t 562(defvar ffap-locate-jka-suffixes t
729 "List of compression suffixes that ffap-locate-file tries. 563 "List of compression suffixes tried by `ffap-locate-file'.
730If not a list, it will be initialized by ffap-locate-file, 564If not a list, it is initialized by `ffap-locate-file',
731and it will become nil unless you are using jka-compr. 565and it becomes nil unless you are using jka-compr.
732You might set this to nil or a list like '(\".gz\" \".z\" \".Z\").") 566Typical values are nil or '(\".gz\" \".z\" \".Z\").")
733 567
734(defun ffap-locate-file (file &optional nosuffix path) 568(defun ffap-locate-file (file &optional nosuffix path)
735 ;; If this package is only working in v19 now, maybe should 569 "A generic path-searching function, mimics `load' by default.
736 ;; replace this with a quiet version of locate-library. 570Returns path to file that \(load FILE\) would load, or nil.
737 "A generic path-searching function, defaults mimic `load' behavior. 571Optional NOSUFFIX, if nil or t, is like the fourth argument
738Returns path of an existing FILE that (load FILE) would load, or nil. 572for load: whether to try the suffixes (\".elc\" \".el\" \"\").
739Optional second argument NOSUFFIX, if t, is like the fourth argument 573If a nonempty list, it is a list of suffixes to try instead.
740for load, i.e. don't try adding suffixes \".elc\" and \".el\". 574Optional PATH is a list of directories instead of `load-path'."
741If a list, it is taken as a list of suffixes to try instead.
742Optional third argument PATH specifies a different search path, it
743defaults to `load-path'."
744 (or path (setq path load-path)) 575 (or path (setq path load-path))
745 (if (file-name-absolute-p file) 576 (if (file-name-absolute-p file)
746 (setq path (list (file-name-directory file)) 577 (setq path (list (file-name-directory file))
@@ -750,19 +581,18 @@ defaults to `load-path'."
750 ((consp nosuffix) nosuffix) 581 ((consp nosuffix) nosuffix)
751 (nosuffix '("")) 582 (nosuffix '(""))
752 (t '(".elc" ".el" ""))))) 583 (t '(".elc" ".el" "")))))
753 ;; Compensate for modern (19.28) jka-compr, that no longer searches 584 ;; Modern (>19.27) jka-compr doesn't try foo.gz when you want foo.
754 ;; for foo.gz when you asked for foo:
755 (or (listp ffap-locate-jka-suffixes) 585 (or (listp ffap-locate-jka-suffixes)
756 (setq ffap-locate-jka-suffixes 586 (setq ffap-locate-jka-suffixes
757 (and (featurep 'jka-compr) ; an early version was jka-compr19 587 (and (featurep 'jka-compr)
758 (not (featurep 'jka-aux)) 588 (not (featurep 'jka-aux))
759 jka-compr-file-name-handler-entry 589 jka-compr-file-name-handler-entry
760 (not (string-match 590 (not (string-match
761 (car jka-compr-file-name-handler-entry) 591 (car jka-compr-file-name-handler-entry)
762 "foo")) 592 "foo"))
763 ;; Hard to do cleverly across various jka-compr versions: 593 ;; Hard to do this cleverly across jka-compr versions:
764 '(".gz" ".Z")))) 594 '(".gz" ".Z"))))
765 (if ffap-locate-jka-suffixes 595 (if ffap-locate-jka-suffixes ; so nil behaves like '("")
766 (setq suffixes-to-try 596 (setq suffixes-to-try
767 (apply 597 (apply
768 'nconc 598 'nconc
@@ -817,7 +647,7 @@ defaults to `load-path'."
817 '(help-mode . ffap-el-mode) ; v19.29 647 '(help-mode . ffap-el-mode) ; v19.29
818 (cons 'c-mode 648 (cons 'c-mode
819 (progn 649 (progn
820 ;; Need better default here: 650 ;; Need better defaults here!
821 (defvar ffap-c-path '("/usr/include" "/usr/local/include")) 651 (defvar ffap-c-path '("/usr/include" "/usr/local/include"))
822 (defun ffap-c-mode (name) 652 (defun ffap-c-mode (name)
823 (ffap-locate-file name t ffap-c-path)))) 653 (ffap-locate-file name t ffap-c-path))))
@@ -828,27 +658,38 @@ defaults to `load-path'."
828 ;; Complicated because auctex may not be loaded yet. 658 ;; Complicated because auctex may not be loaded yet.
829 (progn 659 (progn
830 (defvar ffap-tex-path 660 (defvar ffap-tex-path
831 (ffap-reduce-path 661 t ; delayed initialization
832 (append 662 "Path where `ffap-tex-mode' looks for tex files.
833 (list ".") 663If t, `ffap-tex-init' will initialize this when needed.")
834 (ffap-list-env "TEXINPUTS") 664 (defun ffap-tex-init nil
835 ;; (ffap-list-env "BIBINPUTS") 665 ;; Compute ffap-tex-path if it is now t.
836 (ffap-add-subdirs 666 (and (eq t ffap-tex-path)
837 (ffap-list-env "TEXINPUTS_SUBDIR" 667 (message "Initializing ffap-tex-path ...")
838 (ffap-soft-value 668 (setq ffap-tex-path
839 "TeX-macro-global" 669 (ffap-reduce-path
840 '("/usr/local/lib/tex/macros" 670 (append
841 "/usr/local/lib/tex/inputs") 671 (list ".")
842 ))))) 672 (ffap-list-env "TEXINPUTS")
843 "*Where ffap-tex-mode looks for tex files.") 673 ;; (ffap-list-env "BIBINPUTS")
674 (ffap-add-subdirs
675 (ffap-list-env "TEXINPUTS_SUBDIR"
676 (ffap-soft-value
677 "TeX-macro-global"
678 '("/usr/local/lib/tex/macros"
679 "/usr/local/lib/tex/inputs")
680 ))))))))
844 (defun ffap-tex-mode (name) 681 (defun ffap-tex-mode (name)
682 (ffap-tex-init)
845 (ffap-locate-file name '(".tex" "") ffap-tex-path)))) 683 (ffap-locate-file name '(".tex" "") ffap-tex-path))))
846 (cons 'latex-mode 684 (cons 'latex-mode
847 (defun ffap-latex-mode (name) 685 (defun ffap-latex-mode (name)
686 (ffap-tex-init)
848 ;; Any real need for "" here? 687 ;; Any real need for "" here?
849 (ffap-locate-file name '(".sty" ".tex" "") ffap-tex-path))) 688 (ffap-locate-file name '(".cls" ".sty" ".tex" "")
850 (cons "\\.\\(tex\\|sty\\|doc\\)\\'" 689 ffap-tex-path)))
690 (cons "\\.\\(tex\\|sty\\|doc\\|cls\\)\\'"
851 (defun ffap-tex (name) 691 (defun ffap-tex (name)
692 (ffap-tex-init)
852 (ffap-locate-file name t ffap-tex-path))) 693 (ffap-locate-file name t ffap-tex-path)))
853 (cons "\\.bib\\'" 694 (cons "\\.bib\\'"
854 (defun ffap-bib (name) 695 (defun ffap-bib (name)
@@ -890,16 +731,31 @@ defaults to `load-path'."
890 (defun ffap-rfc (name) 731 (defun ffap-rfc (name)
891 (format ffap-rfc-path 732 (format ffap-rfc-path
892 (substring name (match-beginning 1) (match-end 1)))))) 733 (substring name (match-beginning 1) (match-end 1))))))
734 (cons "\\`[^/]*\\'"
735 (defun ffap-dired (name)
736 (let ((pt (point)) dir try)
737 (save-excursion
738 (and (progn
739 (beginning-of-line)
740 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
741 (re-search-backward "^ *$" nil t)
742 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
743 (file-exists-p
744 (setq try
745 (expand-file-name
746 name
747 (buffer-substring
748 (match-beginning 1) (match-end 1)))))
749 try)))))
893 ) 750 )
894 "Alist of \(KEY . FUNCTION\), applied to text around point. 751 "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
895 752If string NAME at point (maybe \"\") is not a file or url, these pairs
896If ffap-file-at-point has a string NAME (maybe \"\") which is not an 753specify actions to try creating such a string. A pair matches if either
897existing filename, it looks for pairs with a matching KEY: 754 KEY is a symbol, and it equals `major-mode', or
898 * if KEY is a symbol, it should equal `major-mode'. 755 KEY is a string, it should matches NAME as a regexp.
899 * if KEY is a string, it should match NAME as a regular expression. 756On a match, \(FUNCTION NAME\) is called and should return a file, an
900If KEY matches, ffap-file-at-point calls \(FUNCTION NAME\). 757url, or nil. If nil, search the alist for further matches.")
901FUNCTION should return a file, url, or nil \(nil means keep looking 758
902for more KEY matches\). Note URL's are ok despite the function name.")
903(put 'ffap-alist 'risky-local-variable t) 759(put 'ffap-alist 'risky-local-variable t)
904 760
905 761
@@ -907,55 +763,63 @@ for more KEY matches\). Note URL's are ok despite the function name.")
907 763
908(defvar ffap-string-at-point-mode-alist 764(defvar ffap-string-at-point-mode-alist
909 '( 765 '(
766 ;; The default, used when the `major-mode' is not found.
910 ;; Slightly controversial decisions: 767 ;; Slightly controversial decisions:
911 ;; * strip trailing "@" and ":" 768 ;; * strip trailing "@" and ":"
912 ;; * no commas (good for latex) 769 ;; * no commas (good for latex)
913 (t "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") 770 (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
914 (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:") ; allow backquote 771 ;; An url, or maybe a email/news message-id:
915 ;; Note: you are better off using "C-c C-c" in compilation buffers: 772 (url "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
916 ;; Maybe handle "$HOME", or "$(HOME)/bin/foo" in makefile-mode? 773 ;; Find a string that does *not* contain a colon:
774 (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
775 ;; A machine:
776 (machine "-a-zA-Z0-9." "" ".")
777 ;; Mathematica paths: allow backquotes
778 (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
917 ) 779 )
918 "Alist of \(MODE CHARS BEG END\), where MODE is a major-mode or t. 780 "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
919The data are arguments to ffap-string-at-point, used to guess the 781possibly a `major-mode' or some symbol internal to ffap
920filename at point. The `t' entry is the default.") 782\(such as 'file, 'url, 'machine, and 'nocolon\).
783`ffap-string-at-point' uses the data fields as follows:
7841. find a maximal string of CHARS around point,
7852. strip BEG chars before point from the beginning,
7863. Strip END chars after point from the end.")
921 787
922(defvar ffap-string-at-point-region '(1 1) 788(defvar ffap-string-at-point-region '(1 1)
923 "List (BEG END), last region returned by ffap-string-at-point.") 789 "List (BEG END), last region returned by `ffap-string-at-point'.")
924 790
925(defvar ffap-string-at-point nil 791(defvar ffap-string-at-point nil
926 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. 792 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
927 "Last string returned by ffap-string-at-point.") 793 "Last string returned by `ffap-string-at-point'.")
928(defun ffap-string-at-point (&optional chars begpunct endpunct) 794
929 "Return maximal string of CHARS (a string) around point. 795(defun ffap-string-at-point (&optional mode)
930Optional BEGPUNCT chars before point are stripped from the beginning; 796 "Return a string of characters from around point.
931Optional ENDPUNCT chars after point are stripped from the end. 797MODE (defaults to `major-mode') is a symbol used to lookup string
932Without arguments, uses `ffap-string-at-point-mode-alist'. 798syntax parameters in `ffap-string-at-point-mode-alist'.
933Also sets `ffap-string-at-point' and `ffap-string-at-point-region'." 799If MODE is not found, we fall back on the symbol 'file.
934 (if chars 800Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
935 (let* ((pt (point)) 801 (let* ((args
936 (str 802 (cdr
937 (buffer-substring 803 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
938 (save-excursion 804 (assq 'file ffap-string-at-point-mode-alist))))
939 (skip-chars-backward chars) 805 (pt (point))
940 (and begpunct (skip-chars-forward begpunct pt)) 806 (str
941 (setcar ffap-string-at-point-region (point))) 807 (buffer-substring
942 (save-excursion 808 (save-excursion
943 (skip-chars-forward chars) 809 (skip-chars-backward (car args))
944 (and endpunct (skip-chars-backward endpunct pt)) 810 (skip-chars-forward (nth 1 args) pt)
945 (setcar (cdr ffap-string-at-point-region) (point)))))) 811 (setcar ffap-string-at-point-region (point)))
946 (set-text-properties 0 (length str) nil str) 812 (save-excursion
947 (setq ffap-string-at-point str)) 813 (skip-chars-forward (car args))
948 ;; Get default args from `ffap-string-at-point-mode-alist' 814 (skip-chars-backward (nth 2 args) pt)
949 (apply 'ffap-string-at-point 815 (setcar (cdr ffap-string-at-point-region) (point))))))
950 (cdr (or (assq major-mode ffap-string-at-point-mode-alist) 816 (or ffap-xemacs (set-text-properties 0 (length str) nil str))
951 (assq t ffap-string-at-point-mode-alist) 817 (setq ffap-string-at-point str)))
952 ;; avoid infinite loop!
953 (error "ffap-string-at-point: bad alist")
954 )))))
955 818
956(defun ffap-string-around nil 819(defun ffap-string-around nil
957 ;; Sometimes useful to decide how to treat a string. 820 ;; Sometimes useful to decide how to treat a string.
958 "Return string of two characters around last ffap-string-at-point." 821 "Return string of two chars around last `ffap-string-at-point'.
822Assumes the buffer has not changed."
959 (save-excursion 823 (save-excursion
960 (format "%c%c" 824 (format "%c%c"
961 (progn 825 (progn
@@ -966,12 +830,23 @@ Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
966 (following-char)) ; maybe 0 830 (following-char)) ; maybe 0
967 ))) 831 )))
968 832
833(defun ffap-copy-string-as-kill (&optional mode)
834 ;; Requested by MCOOK. Useful?
835 "Call `ffap-string-at-point', and copy result to `kill-ring'."
836 (interactive)
837 (let ((str (ffap-string-at-point mode)))
838 (if (equal "" str)
839 (message "No string found around point.")
840 (kill-new str)
841 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
842 (message "Copied to kill ring: %s" str))))
843
969(defun ffap-url-at-point nil 844(defun ffap-url-at-point nil
970 "Return URL from around point if it exists, or nil." 845 "Return url from around point if it exists, or nil."
971 ;; Could use url-get-url-at-point instead ... how do they compare? 846 ;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
972 ;; Both handle "URL:", ignore non-relative links, trim punctuation. 847 ;; ignore non-relative links, trim punctuation. The other will
973 ;; The other will actually look back if point is in whitespace, but 848 ;; actually look back if point is in whitespace, but I would rather
974 ;; I would rather ffap be non-rabid in such situations. 849 ;; ffap be non-rabid in such situations.
975 (and 850 (and
976 ffap-url-regexp 851 ffap-url-regexp
977 (or 852 (or
@@ -983,21 +858,19 @@ Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
983 (consp (setq tem (w3-zone-data tem))) 858 (consp (setq tem (w3-zone-data tem)))
984 (nth 2 tem))) 859 (nth 2 tem)))
985 ;; Is there a reason not to strip trailing colon? 860 ;; Is there a reason not to strip trailing colon?
986 (let ((name (ffap-string-at-point 861 (let ((name (ffap-string-at-point 'url)))
987 ;; Allow leading digits for email/news id's:
988 "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")))
989 ;; (case-fold-search t), why? 862 ;; (case-fold-search t), why?
990 (cond 863 (cond
991 ((string-match "^url:" name) (setq name (substring name 4))) 864 ((string-match "^url:" name) (setq name (substring name 4)))
992 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z]\\'" name) 865 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z]\\'" name)
993 ;; "foo@bar": could be "mailto" or "news" (a Message-ID). 866 ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
994 ;; If not adorned with "<>", it must be "mailto". 867 ;; If not adorned with "<>", it must be "mailto".
995 ;; Otherwise could be either, so consult `ffap-foo@bar-prefix'. 868 ;; Otherwise could be either, so consult `ffap-foo-at-bar-prefix'.
996 (let ((prefix (if (and (equal (ffap-string-around) "<>") 869 (let ((prefix (if (and (equal (ffap-string-around) "<>")
997 ;; At least a couple of odd characters: 870 ;; At least a couple of odd characters:
998 (string-match "[$.0-9].*[$.0-9].*@" name)) 871 (string-match "[$.0-9].*[$.0-9].*@" name))
999 ;; Could be news: 872 ;; Could be news:
1000 ffap-foo@bar-prefix 873 ffap-foo-at-bar-prefix
1001 "mailto"))) 874 "mailto")))
1002 (and prefix (setq name (concat prefix ":" name)))))) 875 (and prefix (setq name (concat prefix ":" name))))))
1003 ((ffap-newsgroup-p name) (setq name (concat "news:" name))) 876 ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
@@ -1014,12 +887,11 @@ Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
1014(defvar ffap-gopher-regexp 887(defvar ffap-gopher-regexp
1015 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" 888 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
1016 "Regexp Matching a line in a gopher bookmark (maybe indented). 889 "Regexp Matching a line in a gopher bookmark (maybe indented).
1017Two subexpressions are the KEY and VALUE.") 890The two subexpressions are the KEY and VALUE.")
1018 891
1019(defun ffap-gopher-at-point nil 892(defun ffap-gopher-at-point nil
1020 "If point is inside a gopher bookmark block, return its url." 893 "If point is inside a gopher bookmark block, return its url."
1021 ;; We could use gopher-parse-bookmark from gopher.el, but it is not 894 ;; `gopher-parse-bookmark' from gopher.el is not so robust
1022 ;; so robust, and w3 users are better off without gopher.el anyway.
1023 (save-excursion 895 (save-excursion
1024 (beginning-of-line) 896 (beginning-of-line)
1025 (if (looking-at ffap-gopher-regexp) 897 (if (looking-at ffap-gopher-regexp)
@@ -1050,10 +922,9 @@ Two subexpressions are the KEY and VALUE.")
1050(defvar ffap-ftp-sans-slash-regexp 922(defvar ffap-ftp-sans-slash-regexp
1051 (and 923 (and
1052 ffap-ftp-regexp 924 ffap-ftp-regexp
1053 ;; Note: by now, we know it is not an URL. 925 ;; Note: by now, we know it is not an url.
1054 ;; Icky regexp avoids: default: 123: foo::bar cs:pub 926 ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1055 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end) 927 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
1056 ;; Todo: handle foo.com://path
1057 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)") 928 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
1058 "Strings matching this are coerced to ftp paths by ffap. 929 "Strings matching this are coerced to ftp paths by ffap.
1059That is, ffap just prepends \"/\". Set to nil to disable.") 930That is, ffap just prepends \"/\". Set to nil to disable.")
@@ -1062,17 +933,19 @@ That is, ffap just prepends \"/\". Set to nil to disable.")
1062 "Return filename from around point if it exists, or nil. 933 "Return filename from around point if it exists, or nil.
1063Existence test is skipped for names that look remote. 934Existence test is skipped for names that look remote.
1064If the filename is not obvious, it also tries `ffap-alist', 935If the filename is not obvious, it also tries `ffap-alist',
1065which may actually result in an URL rather than a filename." 936which may actually result in an url rather than a filename."
1066 ;; Note: this function does not need to look for URL's, just 937 ;; Note: this function does not need to look for url's, just
1067 ;; filenames. On the other hand, it is responsible for converting 938 ;; filenames. On the other hand, it is responsible for converting
1068 ;; a pseudo-URL "site.dom://path" to an ftp path "/site.dom:/path" 939 ;; a pseudo-url "site.com://path" to an ftp path
1069 (let* ((case-fold-search t) ; url prefixes are case-insensitive 940 (let* ((case-fold-search t) ; url prefixes are case-insensitive
1070 (data (match-data)) 941 (data (match-data))
1071 (string (ffap-string-at-point)) ; use its mode-alist 942 (string (ffap-string-at-point)) ; uses mode alist
1072 (name 943 (name
1073 (condition-case nil 944 (or (condition-case nil
1074 (substitute-in-file-name string) 945 (and (not (string-match "//" string)) ; foo.com://bar
1075 (error string))) 946 (substitute-in-file-name string))
947 (error nil))
948 string))
1076 (abs (file-name-absolute-p name)) 949 (abs (file-name-absolute-p name))
1077 (default-directory default-directory)) 950 (default-directory default-directory))
1078 (unwind-protect 951 (unwind-protect
@@ -1092,6 +965,10 @@ which may actually result in an URL rather than a filename."
1092 (ffap-file-remote-p (concat "/" name))))) 965 (ffap-file-remote-p (concat "/" name)))))
1093 ;; Ok, not remote, try the existence test even if it is absolute: 966 ;; Ok, not remote, try the existence test even if it is absolute:
1094 ((and abs (ffap-file-exists-string name))) 967 ((and abs (ffap-file-exists-string name)))
968 ;; If it contains a colon, get rid of it (and return if exists)
969 ((and (string-match path-separator name)
970 (setq name (ffap-string-at-point 'nocolon))
971 (ffap-file-exists-string name)))
1095 ;; File does not exist, try the alist: 972 ;; File does not exist, try the alist:
1096 ((let ((alist ffap-alist) tem try case-fold-search) 973 ((let ((alist ffap-alist) tem try case-fold-search)
1097 (while (and alist (not try)) 974 (while (and alist (not try))
@@ -1135,76 +1012,86 @@ which may actually result in an URL rather than a filename."
1135 1012
1136;;; ffap-read-file-or-url: 1013;;; ffap-read-file-or-url:
1137;; 1014;;
1138;; Want to read filenames with completion as in read-file-name, but 1015;; We want to complete filenames as in read-file-name, but also url's
1139;; also allow URL's which read-file-name-internal would truncate at 1016;; which read-file-name-internal would truncate at the "//" string.
1140;; the "//" string. Solution here is to replace read-file-name-internal 1017;; The solution here is to replace read-file-name-internal with
1141;; with another function that does not attempt to complete url's. 1018;; `ffap-read-file-or-url-internal', which checks the minibuffer
1142 1019;; contents before attempting to complete filenames.
1143;; We implement a pretty clean completion semantics to work with
1144;; packages like complete.el and exit-minibuffer.el. Even for
1145;; complete.el (v19.22), we still need to make a small patch (it has a
1146;; hardwired list of `minibuffer-completion-table' values which it
1147;; considers to deal with filenames, this ought to be a variable).
1148 1020
1149(defun ffap-read-file-or-url (prompt guess) 1021(defun ffap-read-file-or-url (prompt guess)
1150 "Read a file or url from minibuffer, with PROMPT and initial GUESS." 1022 "Read file or url from minibuffer, with PROMPT and initial GUESS."
1151 (or guess (setq guess default-directory)) 1023 (or guess (setq guess default-directory))
1152 (let ((filep (not (ffap-url-p guess))) dir) 1024 (let (dir)
1153 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" 1025 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
1154 ;; or "w3/" or "../el/ffap.el" or "../../../" 1026 ;; or "w3/" or "../el/ffap.el" or "../../../"
1155 (if filep 1027 (or (ffap-url-p guess)
1156 (progn 1028 (progn
1157 (or (ffap-file-remote-p guess) 1029 (or (ffap-file-remote-p guess)
1158 (setq guess (abbreviate-file-name (expand-file-name guess)))) 1030 (setq guess (abbreviate-file-name (expand-file-name guess))))
1159 (setq dir (file-name-directory guess)))) 1031 (setq dir (file-name-directory guess))))
1160 (apply 1032 (setq guess
1161 'completing-read 1033 (completing-read
1162 prompt 1034 prompt
1163 'ffap-read-file-or-url-internal 1035 'ffap-read-file-or-url-internal
1164 dir 1036 dir
1165 nil 1037 nil
1166 (if (and dir) (cons guess (length dir)) guess) 1038 (if dir (cons guess (length dir)) guess)
1167 (list 'file-name-history) 1039 (list 'file-name-history)
1168 ))) 1040 ))
1169 1041 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1170(defvar url-global-history-completion-list nil) ; variable in w3/url.el 1042 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
1043 ;; Should not do it on url's, where $ is a common (VMS?) character.
1044 ;; Note: upcoming url.el package ought to handle this automatically.
1045 guess))
1171 1046
1172(defun ffap-read-url-internal (string dir action) 1047(defun ffap-read-url-internal (string dir action)
1173 ;; Complete URL's from history, always treat given url as acceptable. 1048 "Complete url's from history, treating given string as valid."
1174 (let ((hist url-global-history-completion-list)) 1049 (let ((hist (ffap-soft-value "url-global-history-hash-table")))
1175 (cond 1050 (cond
1176 ((not action) 1051 ((not action)
1177 (or (try-completion string hist) string)) 1052 (or (try-completion string hist) string))
1178 ((eq action t) 1053 ((eq action t)
1179 (or (all-completions string hist) (list string))) 1054 (or (all-completions string hist) (list string)))
1180 ;; lambda? 1055 ;; action == lambda, documented where? Tests whether string is a
1181 (t string)))) 1056 ;; valid "match". Let us always say yes.
1057 (t t))))
1182 1058
1183(defun ffap-read-file-or-url-internal (string dir action) 1059(defun ffap-read-file-or-url-internal (string dir action)
1184 (if (ffap-url-p string) 1060 (if (ffap-url-p string)
1185 (ffap-read-url-internal string dir action) 1061 (ffap-read-url-internal string dir action)
1186 (read-file-name-internal string dir action))) 1062 (read-file-name-internal string dir action)))
1187 1063
1188;; Unfortunately, for complete.el to work correctly, we need to vary 1064;; The rest of this page is just to work with package complete.el.
1189;; the value it sees of minibuffer-completion-table, depending on the 1065;; This code assumes that you load ffap.el after complete.el.
1190;; current minibuffer contents! It would be nice if it were written a 1066;;
1191;; little more easily. I consider this a bug in complete.el, since 1067;; We must inform complete about whether our completion function
1192;; the builtin emacs functions do not have this problem. 1068;; will do filename style completion. For earlier versions of
1069;; complete.el, this requires a defadvice. For recent versions
1070;; there may be a special variable for this purpose.
1071
1072(defun ffap-complete-as-file-p nil
1073 ;; Will `minibuffer-completion-table' complete the minibuffer
1074 ;; contents as a filename? Assumes the minibuffer is current.
1075 ;; Note: t and non-nil mean somewhat different reasons.
1076 (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
1077 (not (ffap-url-p (buffer-string))) ; t
1078 (memq minibuffer-completion-table
1079 '(read-file-name-internal read-directory-name-internal)) ; list
1080 ))
1081
1193(and 1082(and
1194 (featurep 'complete) 1083 (featurep 'complete)
1195 (require 'advice) 1084 (if (boundp 'PC-completion-as-file-name-predicate)
1196 (defadvice PC-do-completion (around ffap-fix act) 1085 ;; modern version of complete.el, just set the variable:
1197 "Work with ffap.el." 1086 (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
1198 (let ((minibuffer-completion-table minibuffer-completion-table) 1087 (require 'advice)
1199 ;; (minibuffer-completion-predicate minibuffer-completion-predicate) 1088 (defadvice PC-do-completion (around ffap-fix act)
1200 ) 1089 "Work with ffap."
1201 (and (eq minibuffer-completion-table 'ffap-read-file-or-url-internal) 1090 (let ((minibuffer-completion-table
1202 (setq minibuffer-completion-table 1091 (if (eq t (ffap-complete-as-file-p))
1203 (if (ffap-url-p (buffer-string)) 1092 'read-file-name-internal
1204 ;; List would work better with icomplete ... 1093 minibuffer-completion-table)))
1205 'ffap-read-url-internal 1094 ad-do-it))))
1206 'read-file-name-internal)))
1207 ad-do-it)))
1208 1095
1209 1096
1210;;; Highlighting: 1097;;; Highlighting:
@@ -1214,31 +1101,32 @@ which may actually result in an URL rather than a filename."
1214(defvar ffap-highlight (and window-system t) 1101(defvar ffap-highlight (and window-system t)
1215 "If non-nil, ffap highlights the current buffer substring.") 1102 "If non-nil, ffap highlights the current buffer substring.")
1216 1103
1217(defvar ffap-overlay nil "Overlay used by ffap-highlight.") 1104(defvar ffap-highlight-overlay nil "Overlay used by `ffap-highlight'.")
1218 1105
1219(defun ffap-highlight (&optional remove) 1106(defun ffap-highlight (&optional remove)
1220 "If `ffap-highlight' is set, highlight the guess in the buffer. 1107 "If `ffap-highlight' is set, highlight the guess in this buffer.
1221That is, the last buffer substring found by ffap-string-at-point. 1108That is, the last buffer substring found by `ffap-string-at-point'.
1222Optional argument REMOVE means to remove any such highlighting. 1109Optional argument REMOVE means to remove any such highlighting.
1223Uses the face `ffap' if it is defined, else `highlight'." 1110Uses the face `ffap' if it is defined, or else `highlight'."
1224 (cond 1111 (cond
1225 (remove (and ffap-overlay (delete-overlay ffap-overlay))) 1112 (remove (and ffap-highlight-overlay (delete-overlay ffap-highlight-overlay)))
1226 ((not ffap-highlight) nil) 1113 ((not ffap-highlight) nil)
1227 (ffap-overlay 1114 (ffap-highlight-overlay
1228 (move-overlay ffap-overlay 1115 (move-overlay ffap-highlight-overlay
1229 (car ffap-string-at-point-region) 1116 (car ffap-string-at-point-region)
1230 (nth 1 ffap-string-at-point-region) 1117 (nth 1 ffap-string-at-point-region)
1231 (current-buffer))) 1118 (current-buffer)))
1232 (t 1119 (t
1233 (setq ffap-overlay (apply 'make-overlay ffap-string-at-point-region)) 1120 (setq ffap-highlight-overlay (apply 'make-overlay ffap-string-at-point-region))
1234 (overlay-put ffap-overlay 'face 1121 (overlay-put ffap-highlight-overlay 'face
1235 (if (internal-find-face 'ffap nil) 1122 (if (internal-find-face 'ffap nil)
1236 'ffap 'highlight))))) 1123 'ffap 'highlight)))))
1124
1237 1125
1238;;; The big enchilada: 1126;;; The big enchilada:
1239 1127
1240(defun ffap-guesser nil 1128(defun ffap-guesser nil
1241 "Return file or URL or nil, guessed from text around point." 1129 "Return file or url or nil, guessed from text around point."
1242 (or (and ffap-url-regexp 1130 (or (and ffap-url-regexp
1243 (ffap-fixup-url (or (ffap-url-at-point) 1131 (ffap-fixup-url (or (ffap-url-at-point)
1244 (ffap-gopher-at-point)))) 1132 (ffap-gopher-at-point))))
@@ -1247,36 +1135,40 @@ Uses the face `ffap' if it is defined, else `highlight'."
1247 1135
1248(defun ffap-prompter (&optional guess) 1136(defun ffap-prompter (&optional guess)
1249 ;; Does guess and prompt step for find-file-at-point. 1137 ;; Does guess and prompt step for find-file-at-point.
1250 ;; Extra complication just to do the temporary highlighting. 1138 ;; Extra complication for the temporary highlighting.
1251 (unwind-protect 1139 (unwind-protect
1252 (ffap-read-file-or-url 1140 (ffap-read-file-or-url
1253 (if ffap-url-regexp "Find file or URL: " "Find file: ") 1141 (if ffap-url-regexp "Find file or URL: " "Find file: ")
1254 (prog1 1142 (prog1
1255 (setq guess (or guess (ffap-guesser))) 1143 (setq guess (or guess (ffap-guesser)))
1256 (and guess (ffap-highlight)))) 1144 (and guess (ffap-highlight))
1145 ))
1257 (ffap-highlight t))) 1146 (ffap-highlight t)))
1258 1147
1259;;;###autoload 1148;;;###autoload
1260(defun find-file-at-point (&optional filename) 1149(defun find-file-at-point (&optional filename)
1261 "Find FILENAME (or url), guessing default from text around point. 1150 "Find FILENAME (or url), guessing default from text around point.
1262If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired. 1151If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired.
1263See also the functions ffap-file-at-point, ffap-url-at-point. 1152See also the functions `ffap-file-at-point', `ffap-url-at-point'.
1264With a prefix, this command behaves *exactly* like `ffap-file-finder'. 1153With a prefix, this command behaves *exactly* like `ffap-file-finder'.
1265If `ffap-require-prefix' is set, the prefix meaning is reversed. 1154If `ffap-require-prefix' is set, the prefix meaning is reversed.
1266 1155
1267See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version." 1156See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
1268 (interactive) 1157 (interactive)
1269 (if (and (interactive-p) 1158 (if (and (interactive-p)
1270 (if ffap-require-prefix (not current-prefix-arg) 1159 (if ffap-require-prefix (not current-prefix-arg)
1271 current-prefix-arg)) 1160 current-prefix-arg))
1272 ;; Do exactly the ffap-file-finder command, even the prompting: 1161 ;; Do exactly the ffap-file-finder command, even the prompting:
1273 (call-interactively ffap-file-finder) 1162 (let (current-prefix-arg) ; we already interpreted it
1163 (call-interactively ffap-file-finder))
1274 (or filename (setq filename (ffap-prompter))) 1164 (or filename (setq filename (ffap-prompter)))
1275 (cond 1165 (cond
1276 ((ffap-url-p filename) 1166 ((ffap-url-p filename)
1277 (funcall ffap-url-fetcher filename)) 1167 (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
1168 (funcall ffap-url-fetcher filename)))
1278 ;; This junk more properly belongs in a modified ffap-file-finder: 1169 ;; This junk more properly belongs in a modified ffap-file-finder:
1279 ((and ffap-dired-wildcards (string-match ffap-dired-wildcards filename)) 1170 ((and ffap-dired-wildcards
1171 (string-match ffap-dired-wildcards filename))
1280 (dired filename)) 1172 (dired filename))
1281 ((or (not ffap-newfile-prompt) 1173 ((or (not ffap-newfile-prompt)
1282 (file-exists-p filename) 1174 (file-exists-p filename)
@@ -1290,7 +1182,8 @@ See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version."
1290 filename)))))) 1182 filename))))))
1291 1183
1292;; M-x shortcut: 1184;; M-x shortcut:
1293(fset 'ffap 'find-file-at-point) 1185;;###autoload
1186(defalias 'ffap 'find-file-at-point)
1294 1187
1295 1188
1296;;; Menu support: 1189;;; Menu support:
@@ -1299,21 +1192,31 @@ See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version."
1299;; Or just use it through the ffap-at-mouse binding (next section). 1192;; Or just use it through the ffap-at-mouse binding (next section).
1300 1193
1301(defvar ffap-menu-regexp nil 1194(defvar ffap-menu-regexp nil
1302 "*If non-nil, overrides `ffap-next-regexp' during ffap-menu. 1195 "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
1303Make this more restrictive for faster menu building. 1196Make this more restrictive for faster menu building.
1304For example, try \":/\" for url (and some ftp) references.") 1197For example, try \":/\" for url (and some ftp) references.")
1305 1198
1306(defvar ffap-menu-alist nil 1199(defvar ffap-menu-alist nil
1307 "Buffer local menu of files and urls cached by ffap-menu.") 1200 "Buffer local cache of menu presented by `ffap-menu'.")
1308(make-variable-buffer-local 'ffap-menu-alist) 1201(make-variable-buffer-local 'ffap-menu-alist)
1309 1202
1203(defvar ffap-menu-text-plist
1204 (and window-system
1205 ;; These choices emulate goto-addr:
1206 (if ffap-xemacs
1207 '(face bold highlight t) ; keymap <map>
1208 '(face bold mouse-face highlight) ; keymap <mousy-map>
1209 ))
1210 "Text properties applied to strings found by `ffap-menu-rescan'.
1211These properties may be used to fontify the menu references.")
1212
1310;;;###autoload 1213;;;###autoload
1311(defun ffap-menu (&optional rescan) 1214(defun ffap-menu (&optional rescan)
1312 "Puts up a menu of files and urls mentioned in the buffer. 1215 "Put up a menu of files and urls mentioned in this buffer.
1313Sets mark, jumps to choice, and tries to fetch it. 1216Then set mark, jump to choice, and try to fetch it. The menu is
1314Menu is cached in `ffap-menu-alist', but will always be rebuilt 1217cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
1315with the optional RESCAN argument (a prefix interactively). 1218The optional RESCAN argument \(a prefix, interactively\) forces
1316Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp')." 1219a rebuild. Searches with `ffap-menu-regexp'."
1317 (interactive "P") 1220 (interactive "P")
1318 ;; (require 'imenu) -- no longer used, but roughly emulated 1221 ;; (require 'imenu) -- no longer used, but roughly emulated
1319 (if (or (not ffap-menu-alist) rescan 1222 (if (or (not ffap-menu-alist) rescan
@@ -1348,13 +1251,12 @@ Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp')."
1348Arguments are TITLE, ALIST, and CONT (a continuation). 1251Arguments are TITLE, ALIST, and CONT (a continuation).
1349This uses either a menu or the minibuffer depending on invocation. 1252This uses either a menu or the minibuffer depending on invocation.
1350The TITLE string is used as either the prompt or menu title. 1253The TITLE string is used as either the prompt or menu title.
1351Each (string . data) entry in ALIST defines a choice (data is ignored). 1254Each \(string . data\) ALIST entry defines a choice \(data is ignored\).
1352Once the user makes a choice, function CONT is applied to the entry. 1255Once the user makes a choice, function CONT is applied to the entry.
1353Always returns nil." 1256Always returns nil."
1354 ;; Bug: minibuffer prompting assumes the strings are unique. 1257 ;; Bug: minibuffer prompting assumes the strings are unique.
1355 ;; Todo: break up long menus into multiple panes (like imenu).
1356 (let ((choice 1258 (let ((choice
1357 (if (and (fboundp 'x-popup-menu) ; 19 or XEmacs 19.13 1259 (if (and (fboundp 'x-popup-menu) ; Emacs 19 or XEmacs 19.13
1358 (boundp 'last-nonmenu-event) ; not in XEmacs 19.13 1260 (boundp 'last-nonmenu-event) ; not in XEmacs 19.13
1359 (listp last-nonmenu-event)) 1261 (listp last-nonmenu-event))
1360 (x-popup-menu 1262 (x-popup-menu
@@ -1364,19 +1266,18 @@ Always returns nil."
1364 (mapcar 1266 (mapcar
1365 (function (lambda (i) (cons (car i) i))) 1267 (function (lambda (i) (cons (car i) i)))
1366 alist)))) 1268 alist))))
1367 ;; Automatically popup completion help, one way or another: 1269 ;; Immediately popup completion buffer:
1368 (let ((minibuffer-setup-hook 'minibuffer-completion-help) 1270 (prog1
1369 (unread-command-char -1)) 1271 (let ((minibuffer-setup-hook 'minibuffer-completion-help))
1370 ;; BUG: this code assumes that "" is not a valid choice 1272 ;; BUG: this code assumes that "" is not a valid choice
1371 (completing-read 1273 (completing-read
1372 (format "%s (default %s): " title (car (car alist))) 1274 (format "%s (default %s): " title (car (car alist)))
1373 alist nil t 1275 alist nil t
1374 ;; Let first be default: 1276 ;; (cons (car (car alist)) 0)
1375 ;; (if ffap-v18 (car (car alist)) 1277 nil
1376 ;; (cons (car (car alist)) 0)) 1278 ))
1377 ;; No, then you do not get all completions! 1279 ;; Redraw original screen:
1378 nil 1280 (sit-for 0)))))
1379 )))))
1380 ;; Defaulting: convert "" to (car (car alist)) 1281 ;; Defaulting: convert "" to (car (car alist))
1381 (and (equal choice "") (setq choice (car (car alist)))) 1282 (and (equal choice "") (setq choice (car (car alist))))
1382 (and (stringp choice) (setq choice (assoc choice alist))) 1283 (and (stringp choice) (setq choice (assoc choice alist)))
@@ -1384,14 +1285,24 @@ Always returns nil."
1384 nil) ; return nothing 1285 nil) ; return nothing
1385 1286
1386(defun ffap-menu-rescan nil 1287(defun ffap-menu-rescan nil
1288 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
1289Applies `ffap-menu-text-plist' text properties at all matches."
1387 (interactive) 1290 (interactive)
1388 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp)) 1291 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
1389 (range (- (point-max) (point-min))) item) 1292 (range (- (point-max) (point-min))) item
1293 buffer-read-only ; to set text-properties
1294 ;; Avoid repeated searches of the *mode-alist:
1295 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
1296 major-mode
1297 'file))
1298 )
1390 (setq ffap-menu-alist nil) 1299 (setq ffap-menu-alist nil)
1391 (save-excursion 1300 (save-excursion
1392 (goto-char (point-min)) 1301 (goto-char (point-min))
1393 (while (setq item (ffap-next-guess)) 1302 (while (setq item (ffap-next-guess))
1394 (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist)) 1303 (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
1304 (add-text-properties (car ffap-string-at-point-region) (point)
1305 ffap-menu-text-plist)
1395 (message "Scanning...%2d%% <%s>" 1306 (message "Scanning...%2d%% <%s>"
1396 (/ (* 100 (- (point) (point-min))) range) item)))) 1307 (/ (* 100 (- (point) (point-min))) range) item))))
1397 (message "Scanning...done") 1308 (message "Scanning...done")
@@ -1413,16 +1324,15 @@ Always returns nil."
1413 1324
1414;;; Mouse Support: 1325;;; Mouse Support:
1415;; 1326;;
1416;; I suggest a mouse binding, something like: 1327;; See the suggested binding in ffap-bindings (near eof).
1417;; (global-set-key [S-mouse-1] 'ffap-at-mouse)
1418 1328
1419(defvar ffap-at-mouse-fallback 'ffap-menu 1329(defvar ffap-at-mouse-fallback 'ffap-menu
1420 "Invoked by ffap-at-mouse if no file or url found at point. 1330 "Invoked by `ffap-at-mouse' if no file or url at click.
1421A command symbol, or nil for nothing.") 1331A command symbol, or nil for nothing.")
1422(put 'ffap-at-mouse-fallback 'risky-local-variable t) 1332(put 'ffap-at-mouse-fallback 'risky-local-variable t)
1423 1333
1424(defun ffap-at-mouse (e) 1334(defun ffap-at-mouse (e)
1425 "Find file or URL guessed from text around mouse point. 1335 "Find file or url guessed from text around mouse point.
1426If none is found, call `ffap-at-mouse-fallback'." 1336If none is found, call `ffap-at-mouse-fallback'."
1427 (interactive "e") 1337 (interactive "e")
1428 (let ((guess 1338 (let ((guess
@@ -1449,54 +1359,135 @@ If none is found, call `ffap-at-mouse-fallback'."
1449 1359
1450 1360
1451;;; ffap-other-* commands 1361;;; ffap-other-* commands
1452;; Suggested by KPC. Possible bindings for C-x 4 C-f, C-x 5 C-f. 1362;; Suggested by KPC.
1453 1363
1454(defun ffap-other-window nil 1364(defun ffap-other-window nil
1455 "Like ffap, but put buffer in another window." 1365 "Like `ffap', but put buffer in another window."
1456 (interactive) 1366 (interactive)
1457 (switch-to-buffer-other-window 1367 (switch-to-buffer-other-window
1458 (save-window-excursion (call-interactively 'ffap) (current-buffer)))) 1368 (save-window-excursion (call-interactively 'ffap) (current-buffer))))
1459 1369
1460(defun ffap-other-frame nil 1370(defun ffap-other-frame nil
1461 "Like ffap, but put buffer in another frame." 1371 "Like `ffap', but put buffer in another frame."
1462 (interactive) 1372 (interactive)
1463 (switch-to-buffer-other-frame 1373 (switch-to-buffer-other-frame
1464 (save-window-excursion (call-interactively 'ffap) (current-buffer)))) 1374 (save-window-excursion (call-interactively 'ffap) (current-buffer))))
1465 1375
1466 1376
1467;;; ffap-bug: 1377;;; Bug Reporter:
1378
1468(defun ffap-bug nil 1379(defun ffap-bug nil
1469 ;; Tested with Emacs 19.28 reporter.el 1380 "Submit a bug report for the ffap package."
1470 "Submit a bug report for ffap." 1381 ;; Important: keep the version string here in synch with that at top
1382 ;; of file! Could use lisp-mnt from Emacs 19, but that would depend
1383 ;; on being able to find the ffap.el source file.
1471 (interactive) 1384 (interactive)
1472 (require 'reporter) 1385 (require 'reporter)
1473 (let ((reporter-prompt-for-summary-p t)) 1386 (let ((reporter-prompt-for-summary-p t))
1474 (reporter-submit-bug-report 1387 (reporter-submit-bug-report
1475 "mic@mathcs.emory.edu" "ffap " 1388 "Michelangelo Grigni <mic@mathcs.emory.edu>"
1476 (mapcar 'intern (all-completions "ffap-" obarray 'boundp)) 1389 "ffap 1.6"
1477 ))) 1390 (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
1391
1478(fset 'ffap-submit-bug 'ffap-bug) ; another likely name 1392(fset 'ffap-submit-bug 'ffap-bug) ; another likely name
1479 1393
1480 1394
1481;;; Todo, End. 1395;;; Hooks for Gnus, VM, Rmail:
1482;;
1483;; * w3 may eventually make URL's part of the filesystem!
1484;; this package (prompt & completion) could become much simpler
1485;; * improve minibuffer-completion-help display of long completions
1486;; * notice "machine.dom blah blah blah path/file" (how?)
1487;; * check X selections (x-get-selection PRIMARY/SECONDARY LENGTH/TEXT)
1488;; * let "/path/file#key" jump to key (anchor or regexp) in /path/file
1489;; * notice node in "(dired)Virtual Dired" (how to handle space?)
1490;; * try find-tag on symbol if TAGS is loaded (need above)
1491;; 1396;;
1492;; For information on URL/URI syntax, try: 1397;; If you do not like these bindings, write versions with whatever
1493;; <http://ds.internic.net/rfc/rfc1630.txt> 1398;; bindings you would prefer.
1494;; <http://www.w3.org/hypertext/WWW/Protocols/Overview.html>
1495;; <http://info.cern.ch/hypertext/WWW/Addressing/Addressing.html>
1496 1399
1497;; Local Variables? 1400(defun ffap-ro-mode-hook nil
1498;; foo: bar 1401 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1499;; End: 1402 (local-set-key "\M-l" 'ffap-next)
1403 (local-set-key "\M-m" 'ffap-menu)
1404 )
1500 1405
1406(defun ffap-gnus-hook nil
1407 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
1408 (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
1409 ;; Note "l", "L", "m", "M" are taken:
1410 (local-set-key "\M-l" 'ffap-gnus-next)
1411 (local-set-key "\M-m" 'ffap-gnus-menu))
1501 1412
1413(defun ffap-gnus-wrapper (form) ; used by both commands below
1414 (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
1415 (gnus-summary-select-article)) ; get article of current line
1416 ;; Preserve selected buffer, but do not do save-window-excursion,
1417 ;; since we want to see any window created by the form. Temporarily
1418 ;; select the article buffer, so we can see any point movement.
1419 (let ((sb (window-buffer (selected-window))))
1420 (gnus-configure-windows 'article)
1421 (pop-to-buffer gnus-article-buffer)
1422 (widen)
1423 ;; Skip headers for ffap-gnus-next (which will wrap around)
1424 (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
1425 (unwind-protect
1426 (eval form)
1427 (pop-to-buffer sb))))
1428
1429(defun ffap-gnus-next nil
1430 "Run `ffap-next' in the gnus article buffer."
1431 (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
1432
1433(defun ffap-gnus-menu nil
1434 "Run `ffap-menu' in the gnus article buffer."
1435 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1436
1437
1438;;; ffap-bindings: offer default global bindings
1439
1440(defvar ffap-bindings
1441 (nconc
1442 (cond
1443 ((not (eq window-system 'x))
1444 nil)
1445 ;; GNU coding standards say packages should not bind S-mouse-*.
1446 ;; Is it ok to simply suggest such a binding to the user?
1447 (ffap-xemacs
1448 '((global-set-key '(shift button3) 'ffap-at-mouse)))
1449 (t
1450 '((global-set-key [S-down-mouse-3] 'ffap-at-mouse))))
1451 '(
1452 (global-set-key "\C-x\C-f" 'find-file-at-point)
1453 (global-set-key "\C-x4f" 'ffap-other-window)
1454 (global-set-key "\C-x5f" 'ffap-other-frame)
1455 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
1456 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
1457 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
1458 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
1459 ;; (setq dired-x-hands-off-my-keys t) ; the default
1460 ))
1461 "List of forms evaluated by function `ffap-bindings'.
1462A reasonable ffap installation needs just these two lines:
1463 (require 'ffap)
1464 (ffap-bindings)
1465These are only suggestions, they may be modified or ignored.")
1466
1467(defun ffap-bindings nil
1468 "Evaluate the forms in variable `ffap-bindings'."
1469 (eval (cons 'progn ffap-bindings)))
1470
1471;; Example modifications:
1472;;
1473;; (setq ffap-alist ; remove a feature in `ffap-alist'
1474;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
1475;;
1476;; (setq ffap-alist ; add something to `ffap-alist'
1477;; (cons
1478;; (cons "^[Yy][Ss][Nn][0-9]+$"
1479;; (defun ffap-ysn (name)
1480;; (concat
1481;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
1482;; (substring name 3) ".html")))
1483;; ffap-alist))
1484
1485
1486;;; XEmacs:
1487;; Extended suppport in another file, for copyright reasons.
1488(or (not ffap-xemacs)
1489 (load "ffap-xe" t t)
1490 (message "ffap warning: ffap-xe.el not found"))
1491
1492
1502;;; ffap.el ends here 1493;;; ffap.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-12 00:55:25 +0000