summaryrefslogtreecommitdiff
path: root/lisp/ffap.el
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>1996-03-24 14:20:05 +0000
committerRichard M. Stallman <rms@gnu.org>1996-03-24 14:20:05 +0000
commit6f5dd6faeb97b19663b9d1cc40817d7e54636c01 (patch)
tree65e3ffa1f4ccefb921d0efeb8c66a858749bbaa8 /lisp/ffap.el
parent94948fad76255958b050b76207db7c8d7e9fed8b (diff)
downloademacs-6f5dd6faeb97b19663b9d1cc40817d7e54636c01.tar.gz
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 (limited to 'lisp/ffap.el')
-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 @@
-;;; ffap.el -- find-file-at-point,
+;;; ffap.el --- find file or url at point
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
+;; Created: 29 Mar 1993
+;; Keywords: files, hypermedia, matching, mouse
+;; X-Latest: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
;; This file is part of GNU Emacs.
@@ -21,189 +24,88 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Commentary:
-
-;; A replacement for find-file {C-x C-f}: finds file or URL,
-;; guessing default from text at point. Many features!
-;; Send bugs or suggestions with M-x ffap-bug.
-
-;; See ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ for most recent version:
-;; ffap.el.gz -- this file, compressed with gzip
-;; ffap-xe.el -- support code for XEmacs 19.*
-;; COPYING.gz -- GNU General Public License, version 2
-;; README -- description of these and other files
-;;
-;; For the last version sent to elisp-archive@cis.ohio-state.edu, see:
-;; ftp://ftp.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/misc/ffap.el.Z
-;; (mirrored in gatekeeper.dec.com:/pub/GNU/elisp-archive/misc/)
-
-;;; Description:
-;;
-;; Command find-file-at-point (== ffap) replaces find-file. With a
-;; prefix, it behaves exactly like find-file. Without a prefix, it
-;; first tries to guess a default file or URL based on the text around
-;; the point (set `ffap-require-prefix' to swap these behaviors).
-;; This is a quick way to fetch URL and file references in many
-;; situations, such as in mail or news messages, README's, and
-;; MANIFEST's.
-;;
-;; Some related commands are ffap-at-mouse, ffap-next, ffap-menu,
-;; ffap-other-window, ffap-other-frame.
-;;
-;; This package is about user convenience. It adds nothing to the
-;; elisp programmer's repertoire.
-
-;;; Installation:
-
-;; Quick Setup:
-;;
-;; For a basic installation, just install ffap.el somewhere in your
-;; `load-path', byte-compile it, and add the following two lines near
-;; the end of your ~/.emacs (or equivalent) file:
-;;
-;; (require 'ffap) ; load this file
-;; (global-set-key "\C-x\C-f" 'find-file-at-point)
-;;
-;; Other Packages: ffap notices the presence of several other packages
-;; when it is loaded. In particular, if you use ange-ftp, efs, w3,
-;; complete, or ff-paths (version < 3.00), it is best to load or
-;; autoload them before loading ffap (ffap does not need any of them).
-;; If you use ff-paths version >= 3.00, load it after ffap.
-
-;; Fancier Setup:
-;;
-;; ffap has many options. The next comment block contains some
-;; fancier code that you might want to adapt for your .emacs. For
-;; even more features, look at the documentation (M-x apropos ffap),
-;; and perhaps check the comments in the "User Variables" and "Peanut
-;; Gallery" sections of this file.
-
-;; ;; Before loading ffap:
-;;
-;; (setq ffap-url-regexp nil) ; to disable all URL features
-;;
-;; ;; Loading ffap:
-;; (require 'ffap) ; as in "Quick Setup" above
-;;
-;; After loading ffap:
-;;
-;; (global-set-key "\C-x\C-f" 'find-file-at-point) ; as in "Quick Setup"
-;; (global-set-key "\C-x4f" 'ffap-other-window) ; or \C-f
-;; (global-set-key "\C-x5f" 'ffap-other-frame) ; or \C-f
-;;
-;; (setq ffap-alist ; remove something in `ffap-alist'
-;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
-;;
-;; (setq ffap-alist ; add something to `ffap-alist'
-;; (cons
-;; (cons "^[Yy][Ss][Nn][0-9]+$"
-;; (defun ffap-ysn (name)
-;; (concat
-;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
-;; (substring name 3) ".html")))
-;; ffap-alist))
-;;
-;;
-;; Before or after loading ffap:
-;;
-;; (setq ffap-alist nil) ; disable all `ffap-alist' actions
-;;
-;; (setq ffap-require-prefix t) ; without prefix, ffap == find-file
-;;
-;; (setq ffap-machine-p-known 'accept) ; to avoid pinging
+;;; Commentary:
;;
-;; ;; Choose a mouse binding appropriate for your emacs version:
-;; (global-set-key [S-mouse-1] 'ffap-at-mouse) ; Emacs 19
-;; (global-set-key [(meta button1)] 'ffap-at-mouse) ; XEmacs
-;; (and window-system ; Emacs 18 (from .emacs)
-;; (setq window-setup-hook
-;; '(lambda nil (define-key mouse-map x-button-s-left
-;; 'ffap-at-mouse))))
+;; Command find-file-at-point replaces find-file. With a prefix, it
+;; behaves exactly like find-file. Without a prefix, it first tries
+;; to guess a default file or url from the text around the point
+;; (`ffap-require-prefix' swaps these behaviors). This is useful for
+;; following references in situations such as mail or news buffers,
+;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
+;; M-x ffap-bug.
;;
-;; ;; Use Netscape instead of w3 to fetch URL's. Mosaic is very similar.
-;; (if (eq window-system 'x)
-;; (progn
-;; ;; Get browse-url at http://wombat.doc.ic.ac.uk/emacs/browse-url.el,
-;; ;; or get a (probably out of date) copy from the ftp site above.
-;; (autoload 'browse-url-netscape "browse-url" nil t)
-;; (setq ffap-url-fetcher 'browse-url-netscape)))
-;; ;; Or for a hairier ffap-url-fetcher, get ffap-url.el (same ftp site).
+;; For the default installation, byte-compile ffap.el somewhere in
+;; your `load-path' and add these two lines to your .emacs file:
;;
-;; ;; Support for gnus, vm, rmail (see hook definitions for bindings):
-;; (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
-;; (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
-;; (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
-;; (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
-
-
-;;; Related packages:
+;; (require 'ffap) ; load the package
+;; (ffap-bindings) ; do default key bindings
;;
-;; If you have hyperbole, you may not need this package, although ffap
-;; is smaller and smarter at this particular task. Also note that w3
-;; (ftp.cs.indiana.edu:/pub/elisp/w3/README) offers a similar command
-;; w3-follow-url-at-point.
+;; ffap-bindings makes the following global key bindings:
;;
-;; The browse-url package (above) notices URL's and hands them off to
-;; w3 or an external WWW browser. Package |~/misc/goto-address.el.gz|
-;; by Eric J. Ding <ericding@mit.edu> notices URL's and mail
-;; addresses, and can pre-fontify a buffer to highlight them. Gnus5
-;; (ding) and vm also provide similar support in their messages.
-
-
-;;; Examples:
+;; C-x C-f find-file-at-point (abbreviated as ffap)
+;; C-x 4 f ffap-other-window
+;; C-x 5 f ffap-other-frame
+;; S-mouse-3 ffap-at-mouse
;;
-;; Try M-x find-file-at-point (maybe {C-x C-f}) on these examples.
-;; These local file examples use ordinary find-file:
+;; ffap-bindings also adds hooks to make the following local bindings
+;; in vm, gnus, and rmail:
;;
-;; ffap.el, /etc/motd, $MAIL -- find local or absolute files
-;; .emacs book.sty info/cl pwd.h -- search paths depending on filename
-;; (require 'rmail) -- search paths depending on major-mode
-;; file:/etc/motd -- depends on `ffap-url-unwrap-local'
+;; M-l ffap-next, or ffap-gnus-next in gnus
+;; M-m ffap-menu, or ffap-gnus-menu in gnus
;;
-;; These remote file examples work if you have ange-ftp or efs:
+;; If you do not like these bindings, modify the variable
+;; `ffap-bindings', or write your own.
;;
-;; ftp:/pub -- no ping (always works)
-;; ftp.x.org:README -- no ping, a nice recursive example
-;; anonymous@ftp.x.org:/README -- synonym
-;; ftp.x.org://README -- synonym
-;; ftp://ftp.x.org/README -- depends on `ffap-url-unwrap-remote'
-;; ftp.mathcs.emory.edu -- depends on `ffap-machine-p-known'
-;; mic@ftp:/ -- depends on `ffap-machine-p-local'
-;; ftp.mathcs.emory.edu:/ -- depends on `ffap-ftp-sans-slash-regexp'
+;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
+;; to load or autoload them before ffap. If you use ff-paths, load it
+;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
+;; option variables. In particular, if ffap is slow, try these:
;;
-;; These URL examples use `ffap-url-fetcher' (default w3-fetch):
+;; (setq ffap-alist nil) ; faster, dumber prompting
+;; (setq ffap-machine-p-known 'accept) ; no pinging
+;; (setq ffap-url-regexp nil) ; disable url features in ffap
;;
-;; http://www.cc.emory.edu
-;; http://www.cs.indiana.edu/elisp/w3/docs.html
-;; http://info.cern.ch/default.html
-;; news:news.newusers.questions
-;; mailto:mic@mathcs.emory.edu
-;; mic@mathcs.emory.edu -- same as previous
-;; <mic@mathcs.emory.edu> -- same as previous
-;; <root> -- mailto:root
-;; <mic.9@mathcs.emory.edu> -- see `ffap-foo@bar-prefix'
-;; file:/etc/motd -- see `ffap-url-unwrap-local'
-;; ftp://ftp.x.org/README -- see `ffap-url-unwrap-remote'
-;;
-;; Multiline gopher blocks (as in .gopherrc and usenet of yesteryear):
-;;
-;; Type=1
-;; Name=Electronic Texts (ffap ignores this)
-;; Path=
-;; Host=etext.archive.umich.edu
-;; Port=70
+;; ffap uses w3 (if found) or else browse-url to fetch url's. For
+;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
+;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
+;; the file and url references within a buffer.
+
+;;; Todo list:
+;; * recognize paths inside /usr/bin:/bin:/etc, ./ffap.el:80:
+;; * let "/path/file#key" jump to key (offset or regexp) in /path/file
+;; * find file of symbol if TAGS is loaded (like above)
+;; * break up long menus into multiple panes (like imenu?)
+;; * notice node in "(dired)Virtual Dired" (handle the space?)
+;; * notice "machine.dom blah blah blah path/file" (how?)
+;; * if w3 becomes standard, could rewrite to use its functions
+;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
+;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
+;; * support for custom.el
+;; + handle "$(HOME)" in Makefiles?
+;; + modify `font-lock-keywords' to do fontification
;;; Code:
(provide 'ffap)
+;; Versions: This file is tested with Emacs 19.30. It mostly works
+;; with XEmacs, but get ffap-xe.el for the popup menu. Emacs 18 is
+;; now abandoned (get ffap-15.el instead).
+
+(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t)
+ "Whether ffap thinks it is running under XEmacs.")
+
+
+
;;; User Variables:
;; This function is used inside defvars:
(defun ffap-soft-value (name &optional default)
- ;; Avoid interning. Bug: (ffap-soft-value "nil" 5) --> 5
+ "Return value of symbol with NAME, if it is interned.
+Otherwise return nil (or the optional DEFAULT value)."
+ ;; Bug: (ffap-soft-value "nil" 5) --> 5
(let ((sym (intern-soft name)))
(if (and sym (boundp sym)) (symbol-value sym) default)))
@@ -221,10 +123,10 @@
Nil also disables the generation of such paths by ffap.")
(defvar ffap-url-unwrap-local t
- "*If set, convert local \"file:\" URL to path before prompting.")
+ "*If non-nil, convert \"file:\" url to local path before prompting.")
(defvar ffap-url-unwrap-remote t
- "*Convert remote \"file:\" or \"ftp:\" URL to path before prompting.
+ "*If non-nil, convert \"ftp:\" url to remote path before prompting.
This is ignored if `ffap-ftp-regexp' is nil.")
(defvar ffap-ftp-default-user
@@ -232,14 +134,14 @@ This is ignored if `ffap-ftp-regexp' is nil.")
(equal (ffap-soft-value "efs-default-user") "anonymous"))
nil
"anonymous")
- "*User name in ftp paths generated by ffap (see host-to-ftp-path).
-Nil to fall back on `efs-default-user' or `ange-ftp-default-user'.")
+ "*User name in ftp paths generated by `ffap-host-to-path'.
+Nil to rely on `efs-default-user' or `ange-ftp-default-user'.")
(defvar ffap-rfs-regexp
;; Remote file access built into file system? HP rfa or Andrew afs:
"\\`/\\(afs\\|net\\)/."
;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
- "*Paths matching this are remote file-system paths. Nil to disable.")
+ "*Matching paths are treated as remote. Nil to disable.")
(defvar ffap-url-regexp
;; 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'.")
"\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
"\\)." ; require one more character
)
- "Regexp matching URL's, or nil to disable.")
+ "Regexp matching url's. Nil to disable url features in ffap.")
-(defvar ffap-foo@bar-prefix "mailto"
+(defvar ffap-foo-at-bar-prefix "mailto"
"*Presumed url prefix type of strings like \"<foo.9z@bar>\".
Sensible values are nil, \"news\", or \"mailto\".")
;;; Peanut Gallery:
-
+;;
;; Users of ffap occasionally suggest new features. If I consider
;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them. Read
-;; through this section, and for any features you like, put an
-;; appropriate form in your ~/.emacs file.
+;; through this section for features that you like, put an appropriate
+;; enabler in your .emacs file.
(defvar ffap-dired-wildcards nil ; "[*?][^/]*$"
- ;; From RHOGEE, 07 Jul 1994.
- ;; Disabled: dired is still available by "C-x C-d <pattern>", and
- ;; valid filenames may contain wildcard characters.
+ ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still
+ ;; available by "C-x C-d <pattern>", and valid filenames may
+ ;; sometimes contain wildcard characters.
"*A regexp matching filename wildcard characters, or nil.
-If find-file-at-point gets a filename matching this pattern,
-it passes it on to dired instead of find-file.")
+If `find-file-at-point' gets a filename matching this pattern,
+it passes it on to `dired' instead of `find-file'.")
(defvar ffap-newfile-prompt nil ; t
- ;; From RHOGEE, 11 Jul 1994.
- ;; Disabled: this is better handled by `find-file-not-found-hooks'.
- "*Whether find-file-at-point prompts about a nonexistent file.")
+ ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
+ ;; better handled by `find-file-not-found-hooks'.
+ "*Whether `find-file-at-point' prompts about a nonexistent file.")
(defvar ffap-require-prefix nil
- ;; From RHOGEE, 20 Oct 1994.
- ;; This is nil so that neophytes notice ffap. Experts instead may
- ;; prefer to disable ffap most of the time.
- "*If set, reverses the prefix argument to find-file-at-point.")
-
-(defvar ffap-file-finder
- ;; From RHOGEE, 20 Oct 1994.
- ;; This allows compatibility with ff-paths version < 3.00.
- ;; For ff-paths version >= 3.00, just load it after ffap.
- (if (commandp 'find-file-using-paths)
- 'find-file-using-paths
- ;; Try to overcome load-order dependency:
- (eval-after-load
- "ff-paths"
- '(and (commandp 'find-file-using-paths)
- (setq ffap-file-finder find-file-using-paths)))
- 'find-file)
- "*The command symbol called by find-file-at-point to find a file.
-Probably find-file, or find-file-using-paths if you use ff-paths
-with version < 3.00.")
-(put 'ffap-file-finder 'risky-local-variable t)
+ ;; Suggestion from RHOGEE, 20 Oct 1994.
+ "*If set, reverses the prefix argument to `find-file-at-point'.
+This is nil so neophytes notice ffap. Experts may prefer to disable
+ffap most of the time.")
-(defvar ffap-url-fetcher 'w3-fetch
- "*A function of one argument, called by ffap to fetch URL's.
-The default is w3-fetch from the w3 package. If you prefer Mosaic or
-Netscape, install http://wombat.doc.ic.ac.uk/emacs/browse-url.el, and
-add one of the following lines to your setup:
-
-\(setq ffap-url-fetcher 'browse-url-netscape\)
-\(setq ffap-url-fetcher 'browse-url-mosaic\)
+(defvar ffap-file-finder 'find-file
+ "*The command called by `find-file-at-point' to find a file.")
+(put 'ffap-file-finder 'risky-local-variable t)
-Or for something hairier \(choose fetch method based on url type and
-prompting\) get ffap-url.el wherever you ffap.el."
- ;; Big old `lambda' examples deleted. Some remote-control references:
+(defvar ffap-url-fetcher
+ (cond ((fboundp 'w3-fetch) 'w3-fetch)
+ ((fboundp 'browse-url-netscape) 'browse-url-netscape)
+ (t 'w3-fetch))
+ ;; Remote control references:
;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
;; http://home.netscape.com/newsref/std/x-remote.html
- )
+ "*A function of one argument, called by ffap to fetch an URL.
+Reasonable choices are `w3-fetch' or `browse-url-netscape'.
+For a fancier alternative, get ffap-url.el.")
(put 'ffap-url-fetcher 'risky-local-variable t)
;;; Command ffap-next:
;;
-;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995.
-;; Since then, broke up into ffap-next-guess (noninteractive) and
-;; ffap-next (a command), now work on files as well as url's.
+;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
+;; then, broke it up into ffap-next-guess (noninteractive) and
+;; ffap-next (a command). It now work on files as well as url's.
(defvar ffap-next-regexp
;; 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."
;; It pays to put a big fancy regexp here, since ffap-guesser is
;; much more time-consuming than regexp searching:
"[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
- "*Regular expression governing search of ffap-next.")
+ "*Regular expression governing movements of `ffap-next'.")
(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.")
(defun ffap-next-guess (&optional back lim)
"Move point to next file or url, and return it as a string.
-If nothing found, leaves point at limit and returns nil.
+If nothing is found, leave point at limit and return nil.
Optional BACK argument makes search backwards.
Optional LIM argument limits the search.
Only considers strings that match `ffap-next-regexp'."
@@ -360,7 +244,7 @@ Optional argument BACK says to search backwards.
Optional argument WRAP says to try wrapping around if necessary.
Interactively: use a single prefix to search backwards,
double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by ffap-next-guess."
+Actual search is done by `ffap-next-guess'."
(interactive
(cdr (assq (prefix-numeric-value current-prefix-arg)
'((1) (4 t) (16 nil t) (64 t t)))))
@@ -379,7 +263,7 @@ Actual search is done by ffap-next-guess."
(if wrap "" "more ")))))
(defun ffap-next-url (&optional back wrap)
- "Just like ffap-next, but searches with `ffap-url-regexp'."
+ "Like `ffap-next', but search with `ffap-url-regexp'."
(interactive)
(let ((ffap-next-regexp ffap-url-regexp))
(if (interactive-p)
@@ -387,151 +271,95 @@ Actual search is done by ffap-next-guess."
(ffap-next back wrap))))
-;;; Hooks for GNUS, VM, Rmail:
-;;
-;; See "Installation" above for suggested use of these hooks.
-;; If you do not like these bindings, just write hooks with
-;; whatever bindings you would prefer.
-;;
-;; Any suggestions of more "memorable" bindings? -- Mic
-
-(defun ffap-ro-mode-hook nil
- "Binds ffap-gnus-next and ffap-gnus-menu to M-l and M-m, resp."
- (local-set-key "\M-l" 'ffap-next)
- (local-set-key "\M-m" 'ffap-menu)
- )
-
-(defun ffap-gnus-hook nil
- "Binds ffap-gnus-next and ffap-gnus-menu to L and M, resp."
- (set (make-local-variable 'ffap-foo@bar-prefix) "news") ; message-id's
- ;; Note lowercase l and m are taken:
- (local-set-key "L" 'ffap-gnus-next)
- (local-set-key "M" 'ffap-gnus-menu))
-
-(defun ffap-gnus-wrapper (form) ; used by both commands below
- (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
- (gnus-summary-select-article)) ; get article of current line
- ;; Preserve selected buffer, but do not do save-window-excursion,
- ;; since we want to see any window created by form. Temporarily
- ;; select the article buffer, so we see any point movement.
- (let ((sb (window-buffer (selected-window))))
- (gnus-configure-windows 'article)
- (pop-to-buffer gnus-article-buffer)
- (widen)
- ;; Skip headers at first, for ffap-gnus-next (which wraps around)
- (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
- (unwind-protect
- (eval form)
- (pop-to-buffer sb))))
-
-(defun ffap-gnus-next nil
- "Run ffap-next in the GNUS article buffer."
- (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
-
-(defun ffap-gnus-menu nil
- "Run ffap-menu in the GNUS article buffer."
- (interactive) (ffap-gnus-wrapper '(ffap-menu)))
-
-
;;; Remote machines and paths:
-(fset 'ffap-replace-path-component
- (if (or (featurep 'efs)
- (and
- (boundp 'file-name-handler-alist) ; v19
- (rassq 'efs-file-handler-function file-name-handler-alist)))
- 'efs-replace-path-component
- 'ange-ftp-replace-name-component))
+(defun ffap-replace-path-component (fullname name)
+ "In remote FULLNAME, replace path with NAME. May return nil."
+ ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
+ (let (found)
+ (mapcar
+ (function (lambda (sym) (and (fboundp sym) (setq found sym))))
+ '(
+ efs-replace-path-component
+ ange-ftp-replace-path-component
+ ange-ftp-replace-name-component
+ ))
+ (and found
+ (fset 'ffap-replace-path-component found)
+ (funcall found fullname name))))
+;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
(defun ffap-file-exists-string (file)
;; With certain packages (ange-ftp, jka-compr?) file-exists-p
;; sometimes returns a nicer string than it is given. Otherwise, it
;; just returns nil or t.
"Return FILE \(maybe modified\) if it exists, else nil."
- (let ((exists (file-exists-p file)))
- (and exists (if (stringp exists) exists file))))
+ (and file ; quietly reject nil
+ (let ((exists (file-exists-p file)))
+ (and exists (if (stringp exists) exists file)))))
;; I cannot decide a "best" strategy here, so these are variables. In
;; particular, if `Pinging...' is broken or takes too long on your
;; machine, try setting these all to accept or reject.
(defvar ffap-machine-p-local 'reject ; this happens often
- "A symbol, one of: ping, accept, reject.
-This is what ffap-machine-p does with hostnames that have no domain.")
+ "*A symbol, one of: ping, accept, reject.
+What `ffap-machine-p' does with hostnames that have no domain.")
(defvar ffap-machine-p-known 'ping ; 'accept for speed
- "A symbol, one of: ping, accept, reject.
-This is what ffap-machine-p does with hostnames that have a known domain
-\(see lisp/mail-extr.el for the list of known domains\).")
+ "*A symbol, one of: ping, accept, reject.
+What `ffap-machine-p' does with hostnames that have a known domain
+\(see mail-extr.el for the known domains\).")
(defvar ffap-machine-p-unknown 'reject
- "A symbol, one of: ping, accept, reject.
-This is what ffap-machine-p does with hostnames that have an unknown domain
-\(see lisp/mail-extr.el for the list of known domains\).")
-
-(defvar ffap-machine-p-known-domains
- '("com" "edu" "net" "org" "mil" "gov" "us" "arpa") ; USA USA...
- ;; This variable is mainly for emacs18.
- "Top-level domains known to ffap. Ignored if mail-extr is loadable.")
-
-(defun ffap-machine-p (host &optional service quiet)
- "Indicate whether HOST is the name of a real machine.
-The variables ffap-machine-p-local, ffap-machine-p-known, and ffap-machine-p-unknown
-control ffap-machine-p depending on HOST's domain \(none/known/unknown\).
-Pinging is done using open-network-stream to decide HOST existence.
-Optional SERVICE specifies the service used \(default \"discard\"\).
+ "*A symbol, one of: ping, accept, reject.
+What `ffap-machine-p' does with hostnames that have an unknown domain
+\(see mail-extr.el for the known domains\).")
+
+(defun ffap-what-domain (domain)
+ ;; Like what-domain in mail-extr.el, returns string or nil.
+ (require 'mail-extr)
+ (defvar mail-extr-all-top-level-domains
+ (ffap-soft-value "all-top-level-domains" obarray)) ; XEmacs, old Emacs
+ (get (intern-soft (downcase domain) mail-extr-all-top-level-domains)
+ 'domain-name))
+
+(defun ffap-machine-p (host &optional service quiet strategy)
+ "Decide whether HOST is the name of a real, reachable machine.
+Depending on the domain (none, known, or unknown), follow the strategy
+named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
+or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
+Optional SERVICE specifies the port used \(default \"discard\"\).
Optional QUIET flag suppresses the \"Pinging...\" message.
+Optional STRATEGY overrides the three variables above.
Returned values:
-A t value means that HOST answered.
-A symbol \(accept\) means the relevant variable told us to accept.
-A string means the machine exists, but does not respond for some reason."
- ;; Try some:
- ;; (ffap-machine-p "ftp")
- ;; (ffap-machine-p "nonesuch")
- ;; (ffap-machine-p "ftp.mathcs.emory.edu")
- ;; (ffap-machine-p "foo.bonk")
- ;; (ffap-machine-p "foo.bonk.com")
- ;; (ffap-machine-p "cs" 5678)
- ;; (ffap-machine-p "gopher.house.gov")
- ;; Not known to 19.28
- ;; (ffap-
+ t means that HOST answered.
+'accept means the relevant variable told us to accept.
+\"mesg\" means HOST exists, but does not respond for some reason."
+ ;; Try some (Emory local):
+ ;; (ffap-machine-p "ftp" nil nil 'ping)
+ ;; (ffap-machine-p "nonesuch" nil nil 'ping)
+ ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
+ ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
+ ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
+ ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
(if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
- (not (string-match "[^0-9]" host))) ; all numeric! reject it
+ (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
nil
(let* ((domain
(and (string-match "\\.[^.]*$" host)
(downcase (substring host (1+ (match-beginning 0))))))
- (domain-name ; t, "Country", "Local", or nil
- (cond
- ((not domain) "Local")
- ;; common non-country domains (some imply US though):
- ;; t)
- (t
- ;; Use domain-name properties from v19 lisp/mail-extr.el;
- ;; bbdb/mail-extr also puts this in `all-top-level-domains'.
- (if (or (featurep 'mail-extr)
- (and (load "mail-extr" t t)
- ;; It became a feature between 19.22 and 19.28
- (provide 'mail-extr)))
- (get (intern-soft
- domain
- (condition-case nil
- mail-extr-all-top-level-domains
- ;; Before 19.28, the symbols were in `obarray':
- (error obarray)))
- 'domain-name)
- ;; Emacs18 does not have mail-extr:
- (and (member domain ffap-machine-p-known-domains) t))
- )))
- (strategy
- (cond ((not domain) ffap-machine-p-local)
- ((not domain-name) ffap-machine-p-unknown)
- (ffap-machine-p-known))))
+ (what-domain (if domain (ffap-what-domain domain) "Local")))
+ (or strategy
+ (setq strategy
+ (cond ((not domain) ffap-machine-p-local)
+ ((not what-domain) ffap-machine-p-unknown)
+ (t ffap-machine-p-known))))
(cond
((eq strategy 'accept) 'accept)
((eq strategy 'reject) nil)
;; assume (eq strategy 'ping)
(t
(or quiet
- (if (stringp domain-name)
- (message "Pinging %s (%s)..." host domain-name)
+ (if (stringp what-domain)
+ (message "Pinging %s (%s)..." host what-domain)
(message "Pinging %s ..." host)))
(condition-case error
(progn
@@ -555,7 +383,7 @@ A string means the machine exists, but does not respond for some reason."
((equal mesg "connection failed")
(if (equal (nth 2 error) "permission denied")
nil ; host does not exist
- ;; Other errors mean host exists:
+ ;; Other errors mean the host exists:
(nth 2 error)))
;; Could be "Unknown service":
(t (signal (car error) (cdr error))))))))))))
@@ -563,45 +391,48 @@ A string means the machine exists, but does not respond for some reason."
(defun ffap-file-remote-p (filename)
"If FILENAME looks remote, return it \(maybe slightly improved\)."
;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
- ;; (ffap-file-remote-p "/foo.dom://path")
+ ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
+ ;; (ffap-file-remote-p "/ffap.el:80")
(or (and ffap-ftp-regexp
(string-match ffap-ftp-regexp filename)
- ;; Convert "/host://path" to "/host:/path", to handle a dying
+ ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
;; practice of advertising ftp paths as "host.dom://path".
(if (string-match "//" filename)
- (concat (substring filename 0 (match-beginning 0))
- (substring filename (1- (match-end 0))))
+ ;; (replace-match "/" nil nil filename)
+ (concat (substring filename 0 (1+ (match-beginning 0)))
+ (substring filename (match-end 0)))
filename))
(and ffap-rfs-regexp
(string-match ffap-rfs-regexp filename)
filename)))
(defun ffap-machine-at-point nil
- "Return machine name from around point if it exists, or nil."
- (let ((mach (ffap-string-at-point "-a-zA-Z0-9." nil ".")))
+ "Return machine name at point if it exists, or nil."
+ (let ((mach (ffap-string-at-point 'machine)))
(and (ffap-machine-p mach) mach)))
+(defsubst ffap-host-to-path (host)
+ "Convert HOST to something like \"/anonymous@HOST:\".
+Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
+ (if (equal host "localhost") ""
+ (concat "/"
+ ffap-ftp-default-user (and ffap-ftp-default-user "@")
+ host ":")))
+
(defun ffap-fixup-machine (mach)
- ;; Convert a machine into an URL, an ftp path, or nil.
+ ;; Convert a hostname into an url, an ftp path, or nil.
(cond
((not (and ffap-url-regexp (stringp mach))) nil)
+ ;; gopher.well.com
((string-match "\\`gopher[-.]" mach) ; or "info"?
(concat "gopher://" mach "/"))
+ ;; www.ncsa.uiuc.edu
((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
(concat "http://" mach "/"))
;; More cases? Maybe "telnet:" for archie?
(ffap-ftp-regexp (ffap-host-to-path mach))
))
-(defun ffap-host-to-path (host)
- "Convert \"HOST\" to \"/anonymous@HOST:\" (or \"\" for \"localhost\").
-Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
- (if (equal host "localhost")
- ""
- (if ffap-ftp-default-user
- (concat "/" ffap-ftp-default-user "@" host ":")
- (concat "/" host ":"))))
-
(defun ffap-newsgroup-p (string)
"Return STRING if it looks like a newsgroup name, else nil."
(and
@@ -617,7 +448,7 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
;; gnus-gethash is just a macro for intern-soft.
(and (intern-soft string (symbol-value htb))
(setq ret string htbs nil))
- ;; If we made it this far, GNUS is running, so ignore "heads":
+ ;; If we made it this far, gnus is running, so ignore "heads":
(setq heads nil))
(error nil)))
(or ret (not heads)
@@ -625,36 +456,36 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
(and head (setq head (substring string 0 (match-end 1)))
(member head heads)
(setq ret string))))
- ;; Ever any need to modify string as a newsgroup name?
+ ;; Is there ever a need to modify string as a newsgroup name?
ret)))
(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
- "ffap-newsgroup-p quickly rejects strings that do not match this.")
+ "Strings not matching this fail `ffap-newsgroup-p'.")
(defvar ffap-newsgroup-heads ; entirely inadequate
'("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
- "Used by ffap-newsgroup-p if GNUS is not running.")
+ "Used by `ffap-newsgroup-p' if gnus is not running.")
-(defun ffap-url-p (string)
- "If STRING looks like an URL, return it (maybe improved), else nil."
- ;; Does it look like an URL? Ignore case.
+(defsubst ffap-url-p (string)
+ "If STRING looks like an url, return it (maybe improved), else nil."
(let ((case-fold-search t))
(and ffap-url-regexp (string-match ffap-url-regexp string)
;; I lied, no improvement:
string)))
-;; Broke these two out of ffap-fixup-url, for sake of ffap-url package.
-(defun ffap-url-unwrap-local (url)
- "Return unwrapped local file URL, or nil. Ignores ffap-* variables."
+;; Broke these out of ffap-fixup-url, for use of ffap-url package.
+(defsubst ffap-url-unwrap-local (url)
+ "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
(and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
(substring url (1+ (match-end 1)))))
-(defun ffap-url-unwrap-remote (url)
- "Return unwrapped remote file URL, or nil. Ignores ffap-* variables."
+(defsubst ffap-url-unwrap-remote (url)
+ "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
(and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
(concat
(ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
(substring url (match-beginning 3) (match-end 3)))))
+;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
(defun ffap-fixup-url (url)
- "Given URL, clean it up and return it. May become a file name."
+ "Clean up URL and return it, maybe as a file name."
(cond
((not (stringp url)) nil)
((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
@@ -672,23 +503,25 @@ Variable `ffap-ftp-default-user' overrides or suppresses \"anonymous\"."
;;
;; Search actions depending on the major-mode or extensions of the
;; current name. Note all the little defun's could be broken out, at
-;; some loss of locality. I have had a vote for eliminating this
-;; from ffap (featuritis)
+;; some loss of locality. A good example of featuritis.
;; First, some helpers for functions in `ffap-alist':
+(defvar path-separator ":") ; for XEmacs 19.13
+
(defun ffap-list-env (env &optional empty)
;; Replace this with parse-colon-path (lisp/files.el)?
- "Directory list parsed from \":\"-separated ENVironment variable.
+ "Directory list parsed from path envinronment variable ENV.
Optional EMPTY is default if (getenv ENV) is undefined, and is also
-substituted for the first empty-string component, if there is one."
+substituted for the first empty-string component, if there is one.
+Uses `path-separator' to separate the path into directories."
;; Derived from psg-list-env in RHOGEE's ff-paths and
;; bib-cite packages. The `empty' argument is intended to mimic
;; the semantics of TeX/BibTeX variables, it is substituted for
;; any empty string entry.
(if (or empty (getenv env)) ; should return something
(let ((start 0) match dir ret)
- (setq env (concat (getenv env) path-separator)) ; note undefined -> ":"
+ (setq env (concat (getenv env) path-separator))
(while (setq match (string-match path-separator env start))
(setq dir (substring env start match) start (1+ match))
;;(and (file-directory-p dir) (not (member dir ret)) ...)
@@ -701,10 +534,11 @@ substituted for the first empty-string component, if there is one."
ret)))
(defun ffap-reduce-path (path)
- "Remove duplicates or non-dirs from PATH."
+ "Remove duplicates and non-directories from PATH list."
(let (ret tem)
(while path
(setq tem path path (cdr path))
+ (if (equal (car tem) ".") (setcar tem ""))
(or (member (car tem) ret)
(not (file-directory-p (car tem)))
(progn (setcdr tem ret) (setq ret tem))))
@@ -726,21 +560,18 @@ substituted for the first empty-string component, if there is one."
(nreverse ret)))
(defvar ffap-locate-jka-suffixes t
- "List of compression suffixes that ffap-locate-file tries.
-If not a list, it will be initialized by ffap-locate-file,
-and it will become nil unless you are using jka-compr.
-You might set this to nil or a list like '(\".gz\" \".z\" \".Z\").")
+ "List of compression suffixes tried by `ffap-locate-file'.
+If not a list, it is initialized by `ffap-locate-file',
+and it becomes nil unless you are using jka-compr.
+Typical values are nil or '(\".gz\" \".z\" \".Z\").")
(defun ffap-locate-file (file &optional nosuffix path)
- ;; If this package is only working in v19 now, maybe should
- ;; replace this with a quiet version of locate-library.
- "A generic path-searching function, defaults mimic `load' behavior.
-Returns path of an existing FILE that (load FILE) would load, or nil.
-Optional second argument NOSUFFIX, if t, is like the fourth argument
-for load, i.e. don't try adding suffixes \".elc\" and \".el\".
-If a list, it is taken as a list of suffixes to try instead.
-Optional third argument PATH specifies a different search path, it
-defaults to `load-path'."
+ "A generic path-searching function, mimics `load' by default.
+Returns path to file that \(load FILE\) would load, or nil.
+Optional NOSUFFIX, if nil or t, is like the fourth argument
+for load: whether to try the suffixes (\".elc\" \".el\" \"\").
+If a nonempty list, it is a list of suffixes to try instead.
+Optional PATH is a list of directories instead of `load-path'."
(or path (setq path load-path))
(if (file-name-absolute-p file)
(setq path (list (file-name-directory file))
@@ -750,19 +581,18 @@ defaults to `load-path'."
((consp nosuffix) nosuffix)
(nosuffix '(""))
(t '(".elc" ".el" "")))))
- ;; Compensate for modern (19.28) jka-compr, that no longer searches
- ;; for foo.gz when you asked for foo:
+ ;; Modern (>19.27) jka-compr doesn't try foo.gz when you want foo.
(or (listp ffap-locate-jka-suffixes)
(setq ffap-locate-jka-suffixes
- (and (featurep 'jka-compr) ; an early version was jka-compr19
+ (and (featurep 'jka-compr)
(not (featurep 'jka-aux))
jka-compr-file-name-handler-entry
(not (string-match
(car jka-compr-file-name-handler-entry)
"foo"))
- ;; Hard to do cleverly across various jka-compr versions:
+ ;; Hard to do this cleverly across jka-compr versions:
'(".gz" ".Z"))))
- (if ffap-locate-jka-suffixes
+ (if ffap-locate-jka-suffixes ; so nil behaves like '("")
(setq suffixes-to-try
(apply
'nconc
@@ -817,7 +647,7 @@ defaults to `load-path'."
'(help-mode . ffap-el-mode) ; v19.29
(cons 'c-mode
(progn
- ;; Need better default here:
+ ;; Need better defaults here!
(defvar ffap-c-path '("/usr/include" "/usr/local/include"))
(defun ffap-c-mode (name)
(ffap-locate-file name t ffap-c-path))))
@@ -828,27 +658,38 @@ defaults to `load-path'."
;; Complicated because auctex may not be loaded yet.
(progn
(defvar ffap-tex-path
- (ffap-reduce-path
- (append
- (list ".")
- (ffap-list-env "TEXINPUTS")
- ;; (ffap-list-env "BIBINPUTS")
- (ffap-add-subdirs
- (ffap-list-env "TEXINPUTS_SUBDIR"
- (ffap-soft-value
- "TeX-macro-global"
- '("/usr/local/lib/tex/macros"
- "/usr/local/lib/tex/inputs")
- )))))
- "*Where ffap-tex-mode looks for tex files.")
+ t ; delayed initialization
+ "Path where `ffap-tex-mode' looks for tex files.
+If t, `ffap-tex-init' will initialize this when needed.")
+ (defun ffap-tex-init nil
+ ;; Compute ffap-tex-path if it is now t.
+ (and (eq t ffap-tex-path)
+ (message "Initializing ffap-tex-path ...")
+ (setq ffap-tex-path
+ (ffap-reduce-path
+ (append
+ (list ".")
+ (ffap-list-env "TEXINPUTS")
+ ;; (ffap-list-env "BIBINPUTS")
+ (ffap-add-subdirs
+ (ffap-list-env "TEXINPUTS_SUBDIR"
+ (ffap-soft-value
+ "TeX-macro-global"
+ '("/usr/local/lib/tex/macros"
+ "/usr/local/lib/tex/inputs")
+ ))))))))
(defun ffap-tex-mode (name)
+ (ffap-tex-init)
(ffap-locate-file name '(".tex" "") ffap-tex-path))))
(cons 'latex-mode
(defun ffap-latex-mode (name)
+ (ffap-tex-init)
;; Any real need for "" here?
- (ffap-locate-file name '(".sty" ".tex" "") ffap-tex-path)))
- (cons "\\.\\(tex\\|sty\\|doc\\)\\'"
+ (ffap-locate-file name '(".cls" ".sty" ".tex" "")
+ ffap-tex-path)))
+ (cons "\\.\\(tex\\|sty\\|doc\\|cls\\)\\'"
(defun ffap-tex (name)
+ (ffap-tex-init)
(ffap-locate-file name t ffap-tex-path)))
(cons "\\.bib\\'"
(defun ffap-bib (name)
@@ -890,16 +731,31 @@ defaults to `load-path'."
(defun ffap-rfc (name)
(format ffap-rfc-path
(substring name (match-beginning 1) (match-end 1))))))
+ (cons "\\`[^/]*\\'"
+ (defun ffap-dired (name)
+ (let ((pt (point)) dir try)
+ (save-excursion
+ (and (progn
+ (beginning-of-line)
+ (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
+ (re-search-backward "^ *$" nil t)
+ (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
+ (file-exists-p
+ (setq try
+ (expand-file-name
+ name
+ (buffer-substring
+ (match-beginning 1) (match-end 1)))))
+ try)))))
)
- "Alist of \(KEY . FUNCTION\), applied to text around point.
-
-If ffap-file-at-point has a string NAME (maybe \"\") which is not an
-existing filename, it looks for pairs with a matching KEY:
- * if KEY is a symbol, it should equal `major-mode'.
- * if KEY is a string, it should match NAME as a regular expression.
-If KEY matches, ffap-file-at-point calls \(FUNCTION NAME\).
-FUNCTION should return a file, url, or nil \(nil means keep looking
-for more KEY matches\). Note URL's are ok despite the function name.")
+ "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
+If string NAME at point (maybe \"\") is not a file or url, these pairs
+specify actions to try creating such a string. A pair matches if either
+ KEY is a symbol, and it equals `major-mode', or
+ KEY is a string, it should matches NAME as a regexp.
+On a match, \(FUNCTION NAME\) is called and should return a file, an
+url, or nil. If nil, search the alist for further matches.")
+
(put 'ffap-alist 'risky-local-variable t)
@@ -907,55 +763,63 @@ for more KEY matches\). Note URL's are ok despite the function name.")
(defvar ffap-string-at-point-mode-alist
'(
+ ;; The default, used when the `major-mode' is not found.
;; Slightly controversial decisions:
;; * strip trailing "@" and ":"
;; * no commas (good for latex)
- (t "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
- (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:") ; allow backquote
- ;; Note: you are better off using "C-c C-c" in compilation buffers:
- ;; Maybe handle "$HOME", or "$(HOME)/bin/foo" in makefile-mode?
+ (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
+ ;; An url, or maybe a email/news message-id:
+ (url "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
+ ;; Find a string that does *not* contain a colon:
+ (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
+ ;; A machine:
+ (machine "-a-zA-Z0-9." "" ".")
+ ;; Mathematica paths: allow backquotes
+ (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
)
- "Alist of \(MODE CHARS BEG END\), where MODE is a major-mode or t.
-The data are arguments to ffap-string-at-point, used to guess the
-filename at point. The `t' entry is the default.")
+ "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
+possibly a `major-mode' or some symbol internal to ffap
+\(such as 'file, 'url, 'machine, and 'nocolon\).
+`ffap-string-at-point' uses the data fields as follows:
+1. find a maximal string of CHARS around point,
+2. strip BEG chars before point from the beginning,
+3. Strip END chars after point from the end.")
(defvar ffap-string-at-point-region '(1 1)
- "List (BEG END), last region returned by ffap-string-at-point.")
+ "List (BEG END), last region returned by `ffap-string-at-point'.")
(defvar ffap-string-at-point nil
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
- "Last string returned by ffap-string-at-point.")
-(defun ffap-string-at-point (&optional chars begpunct endpunct)
- "Return maximal string of CHARS (a string) around point.
-Optional BEGPUNCT chars before point are stripped from the beginning;
-Optional ENDPUNCT chars after point are stripped from the end.
-Without arguments, uses `ffap-string-at-point-mode-alist'.
-Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
- (if chars
- (let* ((pt (point))
- (str
- (buffer-substring
- (save-excursion
- (skip-chars-backward chars)
- (and begpunct (skip-chars-forward begpunct pt))
- (setcar ffap-string-at-point-region (point)))
- (save-excursion
- (skip-chars-forward chars)
- (and endpunct (skip-chars-backward endpunct pt))
- (setcar (cdr ffap-string-at-point-region) (point))))))
- (set-text-properties 0 (length str) nil str)
- (setq ffap-string-at-point str))
- ;; Get default args from `ffap-string-at-point-mode-alist'
- (apply 'ffap-string-at-point
- (cdr (or (assq major-mode ffap-string-at-point-mode-alist)
- (assq t ffap-string-at-point-mode-alist)
- ;; avoid infinite loop!
- (error "ffap-string-at-point: bad alist")
- )))))
+ "Last string returned by `ffap-string-at-point'.")
+
+(defun ffap-string-at-point (&optional mode)
+ "Return a string of characters from around point.
+MODE (defaults to `major-mode') is a symbol used to lookup string
+syntax parameters in `ffap-string-at-point-mode-alist'.
+If MODE is not found, we fall back on the symbol 'file.
+Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
+ (let* ((args
+ (cdr
+ (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
+ (assq 'file ffap-string-at-point-mode-alist))))
+ (pt (point))
+ (str
+ (buffer-substring
+ (save-excursion
+ (skip-chars-backward (car args))
+ (skip-chars-forward (nth 1 args) pt)
+ (setcar ffap-string-at-point-region (point)))
+ (save-excursion
+ (skip-chars-forward (car args))
+ (skip-chars-backward (nth 2 args) pt)
+ (setcar (cdr ffap-string-at-point-region) (point))))))
+ (or ffap-xemacs (set-text-properties 0 (length str) nil str))
+ (setq ffap-string-at-point str)))
(defun ffap-string-around nil
;; Sometimes useful to decide how to treat a string.
- "Return string of two characters around last ffap-string-at-point."
+ "Return string of two chars around last `ffap-string-at-point'.
+Assumes the buffer has not changed."
(save-excursion
(format "%c%c"
(progn
@@ -966,12 +830,23 @@ Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
(following-char)) ; maybe 0
)))
+(defun ffap-copy-string-as-kill (&optional mode)
+ ;; Requested by MCOOK. Useful?
+ "Call `ffap-string-at-point', and copy result to `kill-ring'."
+ (interactive)
+ (let ((str (ffap-string-at-point mode)))
+ (if (equal "" str)
+ (message "No string found around point.")
+ (kill-new str)
+ ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
+ (message "Copied to kill ring: %s" str))))
+
(defun ffap-url-at-point nil
- "Return URL from around point if it exists, or nil."
- ;; Could use url-get-url-at-point instead ... how do they compare?
- ;; Both handle "URL:", ignore non-relative links, trim punctuation.
- ;; The other will actually look back if point is in whitespace, but
- ;; I would rather ffap be non-rabid in such situations.
+ "Return url from around point if it exists, or nil."
+ ;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
+ ;; ignore non-relative links, trim punctuation. The other will
+ ;; actually look back if point is in whitespace, but I would rather
+ ;; ffap be non-rabid in such situations.
(and
ffap-url-regexp
(or
@@ -983,21 +858,19 @@ Also sets `ffap-string-at-point' and `ffap-string-at-point-region'."
(consp (setq tem (w3-zone-data tem)))
(nth 2 tem)))
;; Is there a reason not to strip trailing colon?
- (let ((name (ffap-string-at-point
- ;; Allow leading digits for email/news id's:
- "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")))
+ (let ((name (ffap-string-at-point 'url)))
;; (case-fold-search t), why?
(cond
((string-match "^url:" name) (setq name (substring name 4)))
((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z]\\'" name)
;; "foo@bar": could be "mailto" or "news" (a Message-ID).
;; If not adorned with "<>", it must be "mailto".
- ;; Otherwise could be either, so consult `ffap-foo@bar-prefix'.
+ ;; Otherwise could be either, so consult `ffap-foo-at-bar-prefix'.
(let ((prefix (if (and (equal (ffap-string-around) "<>")
;; At least a couple of odd characters:
(string-match "[$.0-9].*[$.0-9].*@" name))
;; Could be news:
- ffap-foo@bar-prefix
+ ffap-foo-at-bar-prefix
"mailto")))
(and prefix (setq name (concat prefix ":" name))))))
((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'."
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
"Regexp Matching a line in a gopher bookmark (maybe indented).
-Two subexpressions are the KEY and VALUE.")
+The two subexpressions are the KEY and VALUE.")
(defun ffap-gopher-at-point nil
"If point is inside a gopher bookmark block, return its url."
- ;; We could use gopher-parse-bookmark from gopher.el, but it is not
- ;; so robust, and w3 users are better off without gopher.el anyway.
+ ;; `gopher-parse-bookmark' from gopher.el is not so robust
(save-excursion
(beginning-of-line)
(if (looking-at ffap-gopher-regexp)
@@ -1050,10 +922,9 @@ Two subexpressions are the KEY and VALUE.")
(defvar ffap-ftp-sans-slash-regexp
(and
ffap-ftp-regexp
- ;; Note: by now, we know it is not an URL.
+ ;; Note: by now, we know it is not an url.
;; Icky regexp avoids: default: 123: foo::bar cs:pub
;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
- ;; Todo: handle foo.com://path
"\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
"Strings matching this are coerced to ftp paths by ffap.
That is, ffap just prepends \"/\". Set to nil to disable.")
@@ -1062,17 +933,19 @@ That is, ffap just prepends \"/\". Set to nil to disable.")
"Return filename from around point if it exists, or nil.
Existence test is skipped for names that look remote.
If the filename is not obvious, it also tries `ffap-alist',
-which may actually result in an URL rather than a filename."
- ;; Note: this function does not need to look for URL's, just
+which may actually result in an url rather than a filename."
+ ;; Note: this function does not need to look for url's, just
;; filenames. On the other hand, it is responsible for converting
- ;; a pseudo-URL "site.dom://path" to an ftp path "/site.dom:/path"
+ ;; a pseudo-url "site.com://path" to an ftp path
(let* ((case-fold-search t) ; url prefixes are case-insensitive
(data (match-data))
- (string (ffap-string-at-point)) ; use its mode-alist
+ (string (ffap-string-at-point)) ; uses mode alist
(name
- (condition-case nil
- (substitute-in-file-name string)
- (error string)))
+ (or (condition-case nil
+ (and (not (string-match "//" string)) ; foo.com://bar
+ (substitute-in-file-name string))
+ (error nil))
+ string))
(abs (file-name-absolute-p name))
(default-directory default-directory))
(unwind-protect
@@ -1092,6 +965,10 @@ which may actually result in an URL rather than a filename."
(ffap-file-remote-p (concat "/" name)))))
;; Ok, not remote, try the existence test even if it is absolute:
((and abs (ffap-file-exists-string name)))
+ ;; If it contains a colon, get rid of it (and return if exists)
+ ((and (string-match path-separator name)
+ (setq name (ffap-string-at-point 'nocolon))
+ (ffap-file-exists-string name)))
;; File does not exist, try the alist:
((let ((alist ffap-alist) tem try case-fold-search)
(while (and alist (not try))
@@ -1135,76 +1012,86 @@ which may actually result in an URL rather than a filename."
;;; ffap-read-file-or-url:
;;
-;; Want to read filenames with completion as in read-file-name, but
-;; also allow URL's which read-file-name-internal would truncate at
-;; the "//" string. Solution here is to replace read-file-name-internal
-;; with another function that does not attempt to complete url's.
-
-;; We implement a pretty clean completion semantics to work with
-;; packages like complete.el and exit-minibuffer.el. Even for
-;; complete.el (v19.22), we still need to make a small patch (it has a
-;; hardwired list of `minibuffer-completion-table' values which it
-;; considers to deal with filenames, this ought to be a variable).
+;; We want to complete filenames as in read-file-name, but also url's
+;; which read-file-name-internal would truncate at the "//" string.
+;; The solution here is to replace read-file-name-internal with
+;; `ffap-read-file-or-url-internal', which checks the minibuffer
+;; contents before attempting to complete filenames.
(defun ffap-read-file-or-url (prompt guess)
- "Read a file or url from minibuffer, with PROMPT and initial GUESS."
+ "Read file or url from minibuffer, with PROMPT and initial GUESS."
(or guess (setq guess default-directory))
- (let ((filep (not (ffap-url-p guess))) dir)
+ (let (dir)
;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
;; or "w3/" or "../el/ffap.el" or "../../../"
- (if filep
+ (or (ffap-url-p guess)
(progn
(or (ffap-file-remote-p guess)
(setq guess (abbreviate-file-name (expand-file-name guess))))
(setq dir (file-name-directory guess))))
- (apply
- 'completing-read
- prompt
- 'ffap-read-file-or-url-internal
- dir
- nil
- (if (and dir) (cons guess (length dir)) guess)
- (list 'file-name-history)
- )))
-
-(defvar url-global-history-completion-list nil) ; variable in w3/url.el
+ (setq guess
+ (completing-read
+ prompt
+ 'ffap-read-file-or-url-internal
+ dir
+ nil
+ (if dir (cons guess (length dir)) guess)
+ (list 'file-name-history)
+ ))
+ ;; Do file substitution like (interactive "F"), suggested by MCOOK.
+ (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
+ ;; Should not do it on url's, where $ is a common (VMS?) character.
+ ;; Note: upcoming url.el package ought to handle this automatically.
+ guess))
(defun ffap-read-url-internal (string dir action)
- ;; Complete URL's from history, always treat given url as acceptable.
- (let ((hist url-global-history-completion-list))
+ "Complete url's from history, treating given string as valid."
+ (let ((hist (ffap-soft-value "url-global-history-hash-table")))
(cond
((not action)
(or (try-completion string hist) string))
((eq action t)
(or (all-completions string hist) (list string)))
- ;; lambda?
- (t string))))
+ ;; action == lambda, documented where? Tests whether string is a
+ ;; valid "match". Let us always say yes.
+ (t t))))
(defun ffap-read-file-or-url-internal (string dir action)
(if (ffap-url-p string)
(ffap-read-url-internal string dir action)
(read-file-name-internal string dir action)))
-;; Unfortunately, for complete.el to work correctly, we need to vary
-;; the value it sees of minibuffer-completion-table, depending on the
-;; current minibuffer contents! It would be nice if it were written a
-;; little more easily. I consider this a bug in complete.el, since
-;; the builtin emacs functions do not have this problem.
+;; The rest of this page is just to work with package complete.el.
+;; This code assumes that you load ffap.el after complete.el.
+;;
+;; We must inform complete about whether our completion function
+;; will do filename style completion. For earlier versions of
+;; complete.el, this requires a defadvice. For recent versions
+;; there may be a special variable for this purpose.
+
+(defun ffap-complete-as-file-p nil
+ ;; Will `minibuffer-completion-table' complete the minibuffer
+ ;; contents as a filename? Assumes the minibuffer is current.
+ ;; Note: t and non-nil mean somewhat different reasons.
+ (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
+ (not (ffap-url-p (buffer-string))) ; t
+ (memq minibuffer-completion-table
+ '(read-file-name-internal read-directory-name-internal)) ; list
+ ))
+
(and
(featurep 'complete)
- (require 'advice)
- (defadvice PC-do-completion (around ffap-fix act)
- "Work with ffap.el."
- (let ((minibuffer-completion-table minibuffer-completion-table)
- ;; (minibuffer-completion-predicate minibuffer-completion-predicate)
- )
- (and (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
- (setq minibuffer-completion-table
- (if (ffap-url-p (buffer-string))
- ;; List would work better with icomplete ...
- 'ffap-read-url-internal
- 'read-file-name-internal)))
- ad-do-it)))
+ (if (boundp 'PC-completion-as-file-name-predicate)
+ ;; modern version of complete.el, just set the variable:
+ (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
+ (require 'advice)
+ (defadvice PC-do-completion (around ffap-fix act)
+ "Work with ffap."
+ (let ((minibuffer-completion-table
+ (if (eq t (ffap-complete-as-file-p))
+ 'read-file-name-internal
+ minibuffer-completion-table)))
+ ad-do-it))))
;;; Highlighting:
@@ -1214,31 +1101,32 @@ which may actually result in an URL rather than a filename."
(defvar ffap-highlight (and window-system t)
"If non-nil, ffap highlights the current buffer substring.")
-(defvar ffap-overlay nil "Overlay used by ffap-highlight.")
+(defvar ffap-highlight-overlay nil "Overlay used by `ffap-highlight'.")
(defun ffap-highlight (&optional remove)
- "If `ffap-highlight' is set, highlight the guess in the buffer.
-That is, the last buffer substring found by ffap-string-at-point.
+ "If `ffap-highlight' is set, highlight the guess in this buffer.
+That is, the last buffer substring found by `ffap-string-at-point'.
Optional argument REMOVE means to remove any such highlighting.
-Uses the face `ffap' if it is defined, else `highlight'."
+Uses the face `ffap' if it is defined, or else `highlight'."
(cond
- (remove (and ffap-overlay (delete-overlay ffap-overlay)))
+ (remove (and ffap-highlight-overlay (delete-overlay ffap-highlight-overlay)))
((not ffap-highlight) nil)
- (ffap-overlay
- (move-overlay ffap-overlay
+ (ffap-highlight-overlay
+ (move-overlay ffap-highlight-overlay
(car ffap-string-at-point-region)
(nth 1 ffap-string-at-point-region)
(current-buffer)))
(t
- (setq ffap-overlay (apply 'make-overlay ffap-string-at-point-region))
- (overlay-put ffap-overlay 'face
+ (setq ffap-highlight-overlay (apply 'make-overlay ffap-string-at-point-region))
+ (overlay-put ffap-highlight-overlay 'face
(if (internal-find-face 'ffap nil)
'ffap 'highlight)))))
+
;;; The big enchilada:
(defun ffap-guesser nil
- "Return file or URL or nil, guessed from text around point."
+ "Return file or url or nil, guessed from text around point."
(or (and ffap-url-regexp
(ffap-fixup-url (or (ffap-url-at-point)
(ffap-gopher-at-point))))
@@ -1247,36 +1135,40 @@ Uses the face `ffap' if it is defined, else `highlight'."
(defun ffap-prompter (&optional guess)
;; Does guess and prompt step for find-file-at-point.
- ;; Extra complication just to do the temporary highlighting.
+ ;; Extra complication for the temporary highlighting.
(unwind-protect
(ffap-read-file-or-url
(if ffap-url-regexp "Find file or URL: " "Find file: ")
(prog1
(setq guess (or guess (ffap-guesser)))
- (and guess (ffap-highlight))))
+ (and guess (ffap-highlight))
+ ))
(ffap-highlight t)))
;;;###autoload
(defun find-file-at-point (&optional filename)
"Find FILENAME (or url), guessing default from text around point.
If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired.
-See also the functions ffap-file-at-point, ffap-url-at-point.
+See also the functions `ffap-file-at-point', `ffap-url-at-point'.
With a prefix, this command behaves *exactly* like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
-See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version."
+See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
(interactive)
(if (and (interactive-p)
(if ffap-require-prefix (not current-prefix-arg)
current-prefix-arg))
;; Do exactly the ffap-file-finder command, even the prompting:
- (call-interactively ffap-file-finder)
+ (let (current-prefix-arg) ; we already interpreted it
+ (call-interactively ffap-file-finder))
(or filename (setq filename (ffap-prompter)))
(cond
((ffap-url-p filename)
- (funcall ffap-url-fetcher filename))
+ (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
+ (funcall ffap-url-fetcher filename)))
;; This junk more properly belongs in a modified ffap-file-finder:
- ((and ffap-dired-wildcards (string-match ffap-dired-wildcards filename))
+ ((and ffap-dired-wildcards
+ (string-match ffap-dired-wildcards filename))
(dired filename))
((or (not ffap-newfile-prompt)
(file-exists-p filename)
@@ -1290,7 +1182,8 @@ See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version."
filename))))))
;; M-x shortcut:
-(fset 'ffap 'find-file-at-point)
+;;###autoload
+(defalias 'ffap 'find-file-at-point)
;;; Menu support:
@@ -1299,21 +1192,31 @@ See ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ for most recent version."
;; Or just use it through the ffap-at-mouse binding (next section).
(defvar ffap-menu-regexp nil
- "*If non-nil, overrides `ffap-next-regexp' during ffap-menu.
+ "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
Make this more restrictive for faster menu building.
For example, try \":/\" for url (and some ftp) references.")
(defvar ffap-menu-alist nil
- "Buffer local menu of files and urls cached by ffap-menu.")
+ "Buffer local cache of menu presented by `ffap-menu'.")
(make-variable-buffer-local 'ffap-menu-alist)
+(defvar ffap-menu-text-plist
+ (and window-system
+ ;; These choices emulate goto-addr:
+ (if ffap-xemacs
+ '(face bold highlight t) ; keymap <map>
+ '(face bold mouse-face highlight) ; keymap <mousy-map>
+ ))
+ "Text properties applied to strings found by `ffap-menu-rescan'.
+These properties may be used to fontify the menu references.")
+
;;;###autoload
(defun ffap-menu (&optional rescan)
- "Puts up a menu of files and urls mentioned in the buffer.
-Sets mark, jumps to choice, and tries to fetch it.
-Menu is cached in `ffap-menu-alist', but will always be rebuilt
-with the optional RESCAN argument (a prefix interactively).
-Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp')."
+ "Put up a menu of files and urls mentioned in this buffer.
+Then set mark, jump to choice, and try to fetch it. The menu is
+cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
+The optional RESCAN argument \(a prefix, interactively\) forces
+a rebuild. Searches with `ffap-menu-regexp'."
(interactive "P")
;; (require 'imenu) -- no longer used, but roughly emulated
(if (or (not ffap-menu-alist) rescan
@@ -1348,13 +1251,12 @@ Searches buffer with `ffap-menu-regexp' (see `ffap-next-regexp')."
Arguments are TITLE, ALIST, and CONT (a continuation).
This uses either a menu or the minibuffer depending on invocation.
The TITLE string is used as either the prompt or menu title.
-Each (string . data) entry in ALIST defines a choice (data is ignored).
+Each \(string . data\) ALIST entry defines a choice \(data is ignored\).
Once the user makes a choice, function CONT is applied to the entry.
Always returns nil."
;; Bug: minibuffer prompting assumes the strings are unique.
- ;; Todo: break up long menus into multiple panes (like imenu).
(let ((choice
- (if (and (fboundp 'x-popup-menu) ; 19 or XEmacs 19.13
+ (if (and (fboundp 'x-popup-menu) ; Emacs 19 or XEmacs 19.13
(boundp 'last-nonmenu-event) ; not in XEmacs 19.13
(listp last-nonmenu-event))
(x-popup-menu
@@ -1364,19 +1266,18 @@ Always returns nil."
(mapcar
(function (lambda (i) (cons (car i) i)))
alist))))
- ;; Automatically popup completion help, one way or another:
- (let ((minibuffer-setup-hook 'minibuffer-completion-help)
- (unread-command-char -1))
- ;; BUG: this code assumes that "" is not a valid choice
- (completing-read
- (format "%s (default %s): " title (car (car alist)))
- alist nil t
- ;; Let first be default:
- ;; (if ffap-v18 (car (car alist))
- ;; (cons (car (car alist)) 0))
- ;; No, then you do not get all completions!
- nil
- )))))
+ ;; Immediately popup completion buffer:
+ (prog1
+ (let ((minibuffer-setup-hook 'minibuffer-completion-help))
+ ;; BUG: this code assumes that "" is not a valid choice
+ (completing-read
+ (format "%s (default %s): " title (car (car alist)))
+ alist nil t
+ ;; (cons (car (car alist)) 0)
+ nil
+ ))
+ ;; Redraw original screen:
+ (sit-for 0)))))
;; Defaulting: convert "" to (car (car alist))
(and (equal choice "") (setq choice (car (car alist))))
(and (stringp choice) (setq choice (assoc choice alist)))
@@ -1384,14 +1285,24 @@ Always returns nil."
nil) ; return nothing
(defun ffap-menu-rescan nil
+ "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
+Applies `ffap-menu-text-plist' text properties at all matches."
(interactive)
(let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
- (range (- (point-max) (point-min))) item)
+ (range (- (point-max) (point-min))) item
+ buffer-read-only ; to set text-properties
+ ;; Avoid repeated searches of the *mode-alist:
+ (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
+ major-mode
+ 'file))
+ )
(setq ffap-menu-alist nil)
(save-excursion
(goto-char (point-min))
(while (setq item (ffap-next-guess))
(setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
+ (add-text-properties (car ffap-string-at-point-region) (point)
+ ffap-menu-text-plist)
(message "Scanning...%2d%% <%s>"
(/ (* 100 (- (point) (point-min))) range) item))))
(message "Scanning...done")
@@ -1413,16 +1324,15 @@ Always returns nil."
;;; Mouse Support:
;;
-;; I suggest a mouse binding, something like:
-;; (global-set-key [S-mouse-1] 'ffap-at-mouse)
+;; See the suggested binding in ffap-bindings (near eof).
(defvar ffap-at-mouse-fallback 'ffap-menu
- "Invoked by ffap-at-mouse if no file or url found at point.
+ "Invoked by `ffap-at-mouse' if no file or url at click.
A command symbol, or nil for nothing.")
(put 'ffap-at-mouse-fallback 'risky-local-variable t)
(defun ffap-at-mouse (e)
- "Find file or URL guessed from text around mouse point.
+ "Find file or url guessed from text around mouse point.
If none is found, call `ffap-at-mouse-fallback'."
(interactive "e")
(let ((guess
@@ -1449,54 +1359,135 @@ If none is found, call `ffap-at-mouse-fallback'."
;;; ffap-other-* commands
-;; Suggested by KPC. Possible bindings for C-x 4 C-f, C-x 5 C-f.
+;; Suggested by KPC.
(defun ffap-other-window nil
- "Like ffap, but put buffer in another window."
+ "Like `ffap', but put buffer in another window."
(interactive)
(switch-to-buffer-other-window
(save-window-excursion (call-interactively 'ffap) (current-buffer))))
(defun ffap-other-frame nil
- "Like ffap, but put buffer in another frame."
+ "Like `ffap', but put buffer in another frame."
(interactive)
(switch-to-buffer-other-frame
(save-window-excursion (call-interactively 'ffap) (current-buffer))))
-;;; ffap-bug:
+;;; Bug Reporter:
+
(defun ffap-bug nil
- ;; Tested with Emacs 19.28 reporter.el
- "Submit a bug report for ffap."
+ "Submit a bug report for the ffap package."
+ ;; Important: keep the version string here in synch with that at top
+ ;; of file! Could use lisp-mnt from Emacs 19, but that would depend
+ ;; on being able to find the ffap.el source file.
(interactive)
(require 'reporter)
(let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
- "mic@mathcs.emory.edu" "ffap "
- (mapcar 'intern (all-completions "ffap-" obarray 'boundp))
- )))
+ "Michelangelo Grigni <mic@mathcs.emory.edu>"
+ "ffap 1.6"
+ (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
+
(fset 'ffap-submit-bug 'ffap-bug) ; another likely name
-;;; Todo, End.
-;;
-;; * w3 may eventually make URL's part of the filesystem!
-;; this package (prompt & completion) could become much simpler
-;; * improve minibuffer-completion-help display of long completions
-;; * notice "machine.dom blah blah blah path/file" (how?)
-;; * check X selections (x-get-selection PRIMARY/SECONDARY LENGTH/TEXT)
-;; * let "/path/file#key" jump to key (anchor or regexp) in /path/file
-;; * notice node in "(dired)Virtual Dired" (how to handle space?)
-;; * try find-tag on symbol if TAGS is loaded (need above)
+;;; Hooks for Gnus, VM, Rmail:
;;
-;; For information on URL/URI syntax, try:
-;; <http://ds.internic.net/rfc/rfc1630.txt>
-;; <http://www.w3.org/hypertext/WWW/Protocols/Overview.html>
-;; <http://info.cern.ch/hypertext/WWW/Addressing/Addressing.html>
+;; If you do not like these bindings, write versions with whatever
+;; bindings you would prefer.
-;; Local Variables?
-;; foo: bar
-;; End:
+(defun ffap-ro-mode-hook nil
+ "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
+ (local-set-key "\M-l" 'ffap-next)
+ (local-set-key "\M-m" 'ffap-menu)
+ )
+(defun ffap-gnus-hook nil
+ "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
+ (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
+ ;; Note "l", "L", "m", "M" are taken:
+ (local-set-key "\M-l" 'ffap-gnus-next)
+ (local-set-key "\M-m" 'ffap-gnus-menu))
+(defun ffap-gnus-wrapper (form) ; used by both commands below
+ (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
+ (gnus-summary-select-article)) ; get article of current line
+ ;; Preserve selected buffer, but do not do save-window-excursion,
+ ;; since we want to see any window created by the form. Temporarily
+ ;; select the article buffer, so we can see any point movement.
+ (let ((sb (window-buffer (selected-window))))
+ (gnus-configure-windows 'article)
+ (pop-to-buffer gnus-article-buffer)
+ (widen)
+ ;; Skip headers for ffap-gnus-next (which will wrap around)
+ (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
+ (unwind-protect
+ (eval form)
+ (pop-to-buffer sb))))
+
+(defun ffap-gnus-next nil
+ "Run `ffap-next' in the gnus article buffer."
+ (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
+
+(defun ffap-gnus-menu nil
+ "Run `ffap-menu' in the gnus article buffer."
+ (interactive) (ffap-gnus-wrapper '(ffap-menu)))
+
+
+;;; ffap-bindings: offer default global bindings
+
+(defvar ffap-bindings
+ (nconc
+ (cond
+ ((not (eq window-system 'x))
+ nil)
+ ;; GNU coding standards say packages should not bind S-mouse-*.
+ ;; Is it ok to simply suggest such a binding to the user?
+ (ffap-xemacs
+ '((global-set-key '(shift button3) 'ffap-at-mouse)))
+ (t
+ '((global-set-key [S-down-mouse-3] 'ffap-at-mouse))))
+ '(
+ (global-set-key "\C-x\C-f" 'find-file-at-point)
+ (global-set-key "\C-x4f" 'ffap-other-window)
+ (global-set-key "\C-x5f" 'ffap-other-frame)
+ (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
+ (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
+ (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
+ (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
+ ;; (setq dired-x-hands-off-my-keys t) ; the default
+ ))
+ "List of forms evaluated by function `ffap-bindings'.
+A reasonable ffap installation needs just these two lines:
+ (require 'ffap)
+ (ffap-bindings)
+These are only suggestions, they may be modified or ignored.")
+
+(defun ffap-bindings nil
+ "Evaluate the forms in variable `ffap-bindings'."
+ (eval (cons 'progn ffap-bindings)))
+
+;; Example modifications:
+;;
+;; (setq ffap-alist ; remove a feature in `ffap-alist'
+;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
+;;
+;; (setq ffap-alist ; add something to `ffap-alist'
+;; (cons
+;; (cons "^[Yy][Ss][Nn][0-9]+$"
+;; (defun ffap-ysn (name)
+;; (concat
+;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
+;; (substring name 3) ".html")))
+;; ffap-alist))
+
+
+;;; XEmacs:
+;; Extended suppport in another file, for copyright reasons.
+(or (not ffap-xemacs)
+ (load "ffap-xe" t t)
+ (message "ffap warning: ffap-xe.el not found"))
+
+
;;; ffap.el ends here