]> code.delx.au - gnu-emacs/blobdiff - lisp/ffap.el
Fix previous change.
[gnu-emacs] / lisp / ffap.el
index 2ce98117774352f326a20b05d3a10c9606c81018..9579cce1752acaf00bf44731b1065127b156b3b0 100644 (file)
@@ -1,11 +1,11 @@
-;;; ffap.el --- find file or url at point
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
+;;; ffap.el --- find file (or url) at point
+;;
+;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+;;
 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
 ;; Created: 29 Mar 1993
 ;; 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/
+;; Keywords: files, hypermedia, matching, mouse, convenience
+;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 
@@ -29,7 +29,7 @@
 ;;
 ;; Command find-file-at-point replaces find-file.  With a prefix, it
 ;; behaves exactly like find-file.  Without a prefix, it first tries
 ;;
 ;; 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
+;; 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
 ;; (`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
 ;; C-x 4 f       ffap-other-window
 ;; C-x 5 f       ffap-other-frame
 ;; S-mouse-3     ffap-at-mouse
 ;; C-x 4 f       ffap-other-window
 ;; C-x 5 f       ffap-other-frame
 ;; S-mouse-3     ffap-at-mouse
+;; C-S-mouse-3   ffap-menu
 ;;
 ;; ffap-bindings also adds hooks to make the following local bindings
 ;; in vm, gnus, and rmail:
 ;;
 ;;
 ;; ffap-bindings also adds hooks to make the following local bindings
 ;; in vm, gnus, and rmail:
 ;;
-;; M-l         ffap-next, or ffap-gnus-next in gnus
-;; M-m         ffap-menu, or ffap-gnus-menu in gnus
+;; M-l         ffap-next, or ffap-gnus-next in gnus (l == "link")
+;; M-m         ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
 ;;
 ;; If you do not like these bindings, modify the variable
 ;; `ffap-bindings', or write your own.
 ;;
 ;; If you do not like these bindings, modify the variable
 ;; `ffap-bindings', or write your own.
 ;;
 ;; (setq ffap-alist nil)                ; faster, dumber prompting
 ;; (setq ffap-machine-p-known 'accept)  ; no pinging
 ;;
 ;; (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
+;; (setq ffap-url-regexp nil)           ; disable URL features in ffap
 ;;
 ;;
-;; 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).
+;; ffap uses `browse-url' (if found, else `w3-fetch') 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
 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
-;; the file and url references within a buffer.
+;; the file and URL references within a buffer.  
+
+\f
+;;; Change Log:
+;;
+;; The History and Contributors moved to ffap.LOG (same ftp site),
+;; which also has some old examples and commentary from ffap 1.5.
 
 
+\f
 ;;; Todo list:
 ;;; 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
+;; * use kpsewhich
+;; * let "/path/file#key" jump to key (tag or regexp) in /path/file
 ;; * find file of symbol if TAGS is loaded (like above)
 ;; * 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?)
+;; * break long menus into multiple panes (like imenu?)
+;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
 ;; * notice "machine.dom blah blah blah path/file" (how?)
 ;; * notice "machine.dom blah blah blah path/file" (how?)
-;; * if w3 becomes standard, could rewrite to use its functions
+;; * as w3 becomes standard, rewrite to rely more on its functions
 ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
 ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
 ;; * 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
+;; * handle "$(VAR)" in Makefiles
+;; * use the font-lock machinery
 
 \f
 ;;; Code:
 
 (provide 'ffap)
 
 
 \f
 ;;; 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).
+;; Please do not delete this variable, it is checked in bug reports.
+(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>"
+  "The version of ffap: \"Major.Minor-Build <Timestamp>\"")
+
 
 
-(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t)
-  "Whether ffap thinks it is running under XEmacs.")
+(defgroup ffap nil
+  "Find file or URL at point."
+  :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
+  :group 'matching
+  :group 'convenience)
 
 
+;; The code is organized in pages, separated by formfeed characters.
+;; See the next two pages for standard customization ideas.
 
 \f
 ;;; User Variables:
 
 
 \f
 ;;; User Variables:
 
-;; This function is used inside defvars:
 (defun ffap-soft-value (name &optional default)
   "Return value of symbol with NAME, if it is interned.
 Otherwise return nil (or the optional DEFAULT value)."
 (defun ffap-soft-value (name &optional default)
   "Return value of symbol with NAME, if it is interned.
 Otherwise return nil (or the optional DEFAULT value)."
@@ -109,39 +121,42 @@ Otherwise return nil (or the optional DEFAULT value)."
   (let ((sym (intern-soft name)))
     (if (and sym (boundp sym)) (symbol-value sym) default)))
 
   (let ((sym (intern-soft name)))
     (if (and sym (boundp sym)) (symbol-value sym) default)))
 
-
-(defvar ffap-ftp-regexp
-  (and
-   (or (featurep 'ange-ftp)
-       (featurep 'efs)
-       (and (boundp 'file-name-handler-alist) ; v19
-           (or (rassq 'ange-ftp-hook-function file-name-handler-alist)
-               (rassq 'efs-file-handler-function file-name-handler-alist))))
-   ;; Apparently this is good enough for both ange-ftp and efs:
-   "\\`/[^/:]+:")
-  "*Treat paths matching this as remote ftp paths.  Nil to disable.
-Nil also disables the generation of such paths by ffap.")
-
-(defvar ffap-url-unwrap-local t
-  "*If non-nil, convert \"file:\" url to local path before prompting.")
-
-(defvar ffap-url-unwrap-remote t
+(defcustom ffap-ftp-regexp
+  ;; This used to test for ange-ftp or efs being present, but it should be
+  ;; harmless (and simpler) to give it this value unconditionally.
+  "\\`/[^/:]+:"
+  "*Paths matching this regexp are treated as remote ftp paths by ffap.
+If nil, ffap neither recognizes nor generates such paths."
+  :type '(choice (const :tag "Disable" nil)
+                (const :tag "Standard" "\\`/[^/:]+:")
+                regexp)
+  :group 'ffap)
+
+(defcustom ffap-url-unwrap-local t
+  "*If non-nil, convert \"file:\" url to local path before prompting."
+  :type 'boolean
+  :group 'ffap)
+
+(defcustom ffap-url-unwrap-remote t
   "*If non-nil, convert \"ftp:\" url to remote path before prompting.
   "*If non-nil, convert \"ftp:\" url to remote path before prompting.
-This is ignored if `ffap-ftp-regexp' is nil.")
+This is ignored if `ffap-ftp-regexp' is nil."
+  :type 'boolean
+  :group 'ffap)
 
 
-(defvar ffap-ftp-default-user
-  (if (or (equal (ffap-soft-value "ange-ftp-default-user") "anonymous")
-         (equal (ffap-soft-value "efs-default-user") "anonymous"))
-      nil
-    "anonymous")
+(defcustom ffap-ftp-default-user "anonymous"
   "*User name in ftp paths generated by `ffap-host-to-path'.
   "*User name in ftp paths generated by `ffap-host-to-path'.
-Nil to rely on `efs-default-user' or `ange-ftp-default-user'.")
+Note this name may be omitted if it equals the default
+\(either `efs-default-user' or `ange-ftp-default-user'\)."
+  :type 'string
+  :group 'ffap)
 
 
-(defvar ffap-rfs-regexp
+(defcustom 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/.")
   ;; Remote file access built into file system?  HP rfa or Andrew afs:
   "\\`/\\(afs\\|net\\)/."
   ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
-  "*Matching paths are treated as remote.  Nil to disable.")
+  "*Matching paths are treated as remote.  nil to disable."
+  :type 'regexp
+  :group 'ffap)
 
 (defvar ffap-url-regexp
   ;; Could just use `url-nonrelative-link' of w3, if loaded.
 
 (defvar ffap-url-regexp
   ;; Could just use `url-nonrelative-link' of w3, if loaded.
@@ -153,14 +168,20 @@ Nil to rely on `efs-default-user' or `ange-ftp-default-user'.")
    "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
    "\\)."                              ; require one more character
    )
    "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
    "\\)."                              ; require one more character
    )
-   "Regexp matching url's.  Nil to disable url features in ffap.")
-
-(defvar ffap-foo-at-bar-prefix "mailto"
-  "*Presumed url prefix type of strings like \"<foo.9z@bar>\".
-Sensible values are nil, \"news\", or \"mailto\".")
+   "Regexp matching URL's.  nil to disable URL features in ffap.")
+
+(defcustom ffap-foo-at-bar-prefix "mailto"
+  "*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
+Sensible values are nil, \"news\", or \"mailto\"."
+  :type '(choice (const "mailto")
+                (const "news")
+                (const :tag "Disable" nil)
+                ;; string -- possible, but not really useful
+                )
+  :group 'ffap)
 
 \f
 
 \f
-;;; Peanut Gallery:
+;;; Peanut Gallery (More User Variables):
 ;;
 ;; Users of ffap occasionally suggest new features.  If I consider
 ;; those features interesting but not clear winners (a matter of
 ;;
 ;; Users of ffap occasionally suggest new features.  If I consider
 ;; those features interesting but not clear winners (a matter of
@@ -168,49 +189,78 @@ Sensible values are nil, \"news\", or \"mailto\".")
 ;; through this section for features that you like, put an appropriate
 ;; enabler 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       ; "[*?][^/]*$"
+(defcustom ffap-dired-wildcards nil
   ;; 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,
   ;; 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'.")
-
-(defvar ffap-newfile-prompt nil                ; t
+it passes it on to `dired' instead of `find-file'."
+  :type '(choice (const :tag "Disable" nil)
+                (const :tag "Enable" "[*?][^/]*\\'")
+                ;; regexp -- probably not useful
+                )
+  :group 'ffap)
+
+(defcustom ffap-newfile-prompt nil
   ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
   ;; better handled by `find-file-not-found-hooks'.
   ;; 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.")
+  "*Whether `find-file-at-point' prompts about a nonexistent file."
+  :type 'boolean
+  :group 'ffap)
 
 
-(defvar ffap-require-prefix nil
+(defcustom ffap-require-prefix nil
   ;; 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
   ;; 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-file-finder 'find-file
-  "*The command called by `find-file-at-point' to find a file.")
+ffap most of the time."
+  :type 'boolean
+  :group 'ffap)
+
+(defcustom ffap-file-finder 'find-file
+  "*The command called by `find-file-at-point' to find a file."
+  :type 'function
+  :group 'ffap)
 (put 'ffap-file-finder 'risky-local-variable t)
 
 (put 'ffap-file-finder 'risky-local-variable t)
 
-(defvar ffap-url-fetcher
-  (cond ((fboundp 'w3-fetch) 'w3-fetch)
-       ((fboundp 'browse-url-netscape) 'browse-url-netscape)
-       (t 'w3-fetch))
+(defcustom ffap-url-fetcher
+  (if (fboundp 'browse-url)
+      'browse-url                      ; rely on browse-url-browser-function
+    '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.
   ;; 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.")
+Reasonable choices are `w3-fetch' or a `browse-url-*' function.
+For a fancy alternative, get ffap-url.el."
+  :type '(choice (const w3-fetch)
+                (const browse-url)     ; in recent versions of browse-url
+                (const browse-url-netscape)
+                (const browse-url-mosaic)
+                function)
+  :group 'ffap)
 (put 'ffap-url-fetcher 'risky-local-variable t)
 
 \f
 (put 'ffap-url-fetcher 'risky-local-variable t)
 
 \f
-;;; Command ffap-next:
+;;; Compatibility:
+;;
+;; This version of ffap supports Emacs 20 only, see the ftp site
+;; for a more general version.  The following functions are necessary
+;; "leftovers" from the more general version.
+
+(defun ffap-mouse-event nil            ; current mouse event, or nil
+  (and (listp last-nonmenu-event) last-nonmenu-event))
+(defun ffap-event-buffer (event)
+  (window-buffer (car (event-start event))))
+
+\f
+;;; Find Next Thing in buffer (`ffap-next'):
 ;;
 ;; 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.
 
 ;;
 ;; 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
+(defcustom ffap-next-regexp
   ;; If you want ffap-next to find URL's only, try this:
   ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
   ;;     (concat "\\<" (substring ffap-url-regexp 2))))
   ;; If you want ffap-next to find URL's only, try this:
   ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
   ;;     (concat "\\<" (substring ffap-url-regexp 2))))
@@ -218,11 +268,18 @@ For a fancier alternative, get ffap-url.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]*\\."
   ;; 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 movements of `ffap-next'.")
+  "*Regular expression governing movements of `ffap-next'."
+  :type 'regexp
+  :group 'ffap)
+
+(defvar ffap-next-guess nil
+  "Last value returned by `ffap-next-guess'.")
+
+(defvar ffap-string-at-point-region '(1 1)
+  "List (BEG END), last region returned by `ffap-string-at-point'.")
 
 
-(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.")
 (defun ffap-next-guess (&optional back lim)
 (defun ffap-next-guess (&optional back lim)
-  "Move point to next file or url, and return it as a string.
+  "Move point to next file or URL, and return it as a string.
 If nothing is found, leave point at limit and return nil.
 Optional BACK argument makes search backwards.
 Optional LIM argument limits the search.
 If nothing is found, leave point at limit and return nil.
 Optional BACK argument makes search backwards.
 Optional LIM argument limits the search.
@@ -239,7 +296,7 @@ Only considers strings that match `ffap-next-regexp'."
 
 ;;;###autoload
 (defun ffap-next (&optional back wrap)
 
 ;;;###autoload
 (defun ffap-next (&optional back wrap)
-  "Search buffer for next file or url, and run ffap.
+  "Search buffer for next file or URL, and run ffap.
 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,
 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,
@@ -259,7 +316,7 @@ Actual search is done by `ffap-next-guess'."
          (sit-for 0)                   ; display point movement
          (find-file-at-point (ffap-prompter guess)))
       (goto-char pt)                   ; restore point
          (sit-for 0)                   ; display point movement
          (find-file-at-point (ffap-prompter guess)))
       (goto-char pt)                   ; restore point
-      (message "No %sfiles or URL's found."
+      (message "No %sfiles or URL's found"
               (if wrap "" "more ")))))
 
 (defun ffap-next-url (&optional back wrap)
               (if wrap "" "more ")))))
 
 (defun ffap-next-url (&optional back wrap)
@@ -271,55 +328,41 @@ Actual search is done by `ffap-next-guess'."
       (ffap-next back wrap))))
 
 \f
       (ffap-next back wrap))))
 
 \f
-;;; Remote machines and paths:
-
-(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."
-  (and file                            ; quietly reject nil
-       (let ((exists (file-exists-p file)))
-        (and exists (if (stringp exists) exists file)))))
+;;; Machines (`ffap-machine-p'):
 
 ;; 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.
 
 ;; 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.
-What `ffap-machine-p' does with hostnames that have no domain.")
-(defvar ffap-machine-p-known 'ping     ; 'accept for speed
+(defcustom ffap-machine-p-local 'reject        ; this happens often
+  "*A symbol, one of: `ping', `accept', `reject'.
+What `ffap-machine-p' does with hostnames that have no domain."
+  :type '(choice (const ping)
+                (const accept)
+                (const reject))
+  :group 'ffap)
+(defcustom ffap-machine-p-known 'ping  ; 'accept for speed
   "*A symbol, one of: ping, accept, reject.
 What `ffap-machine-p' does with hostnames that have a known domain
   "*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
+\(see mail-extr.el for the known domains\)."
+  :type '(choice (const ping)
+                (const accept)
+                (const reject))
+  :group 'ffap)
+(defcustom ffap-machine-p-unknown 'reject
   "*A symbol, one of: ping, accept, reject.
 What `ffap-machine-p' does with hostnames that have an unknown domain
   "*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\).")
+\(see mail-extr.el for the known domains\)."
+  :type '(choice (const ping)
+                (const accept)
+                (const reject))
+  :group 'ffap)
 
 (defun ffap-what-domain (domain)
   ;; Like what-domain in mail-extr.el, returns string or nil.
   (require 'mail-extr)
 
 (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))
+  (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains")
+               (ffap-soft-value "all-top-level-domains")))) ; XEmacs
+    (and ob (get (intern-soft (downcase domain) ob) 'domain-name))))
 
 (defun ffap-machine-p (host &optional service quiet strategy)
   "Decide whether HOST is the name of a real, reachable machine.
 
 (defun ffap-machine-p (host &optional service quiet strategy)
   "Decide whether HOST is the name of a real, reachable machine.
@@ -388,6 +431,57 @@ Returned values:
              ;; Could be "Unknown service":
              (t (signal (car error) (cdr error))))))))))))
 
              ;; Could be "Unknown service":
              (t (signal (car error) (cdr error))))))))))))
 
+\f
+;;; Possibly Remote Resources:
+
+(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-suffix (file)
+  "Return trailing \".foo\" suffix of FILE, or nil if none."
+  (let ((pos (string-match "\\.[^./]*\\'" file)))
+    (and pos (substring file pos nil))))
+
+(defvar ffap-compression-suffixes '(".gz" ".Z")        ; .z is mostly dead
+  "List of suffixes tried by `ffap-file-exists-string'.")
+
+(defun ffap-file-exists-string (file &optional nomodify)
+  ;; Early jka-compr versions modified file-exists-p to return the
+  ;; filename, maybe modified by adding a suffix like ".gz".  That
+  ;; broke the interface of file-exists-p, so it was later dropped.
+  ;; Here we document and simulate the old behavior.
+  "Return FILE \(maybe modified\) if it exists, else nil.
+When using jka-compr (a.k.a. `auto-compression-mode'), the returned
+name may have a suffix added from `ffap-compression-suffixes'.
+The optional NOMODIFY argument suppresses the extra search."
+  (cond
+   ((not file) nil)                    ; quietly reject nil
+   ((file-exists-p file) file)         ; try unmodified first
+   ;; three reasons to suppress search:
+   (nomodify nil)
+   ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil)
+   ((member (ffap-file-suffix file) ffap-compression-suffixes) nil)
+   (t                                  ; ok, do the search
+    (let ((list ffap-compression-suffixes) try ret)
+      (while list
+       (if (file-exists-p (setq try (concat file (car list))))
+           (setq ret try list nil)
+         (setq list (cdr list))))
+      ret))))
+
 (defun ffap-file-remote-p (filename)
   "If FILENAME looks remote, return it \(maybe slightly improved\)."
   ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
 (defun ffap-file-remote-p (filename)
   "If FILENAME looks remote, return it \(maybe slightly improved\)."
   ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
@@ -412,12 +506,16 @@ Returned values:
     (and (ffap-machine-p mach) mach)))
 
 (defsubst ffap-host-to-path (host)
     (and (ffap-machine-p mach) mach)))
 
 (defsubst ffap-host-to-path (host)
-  "Convert HOST to something like \"/anonymous@HOST:\".
+  "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
 Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
 Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
-  (if (equal host "localhost") ""
-    (concat "/"
-           ffap-ftp-default-user (and ffap-ftp-default-user "@")
-           host ":")))
+  (if (equal host "localhost")
+      ""
+    (let ((user ffap-ftp-default-user))
+      ;; Avoid including the user if it is same as default:
+      (if (or (equal user (ffap-soft-value "ange-ftp-default-user"))
+             (equal user (ffap-soft-value "efs-default-user")))
+         (setq user nil))
+      (concat "/" user (and user "@") host ":"))))
 
 (defun ffap-fixup-machine (mach)
   ;; Convert a hostname into an url, an ftp path, or nil.
 
 (defun ffap-fixup-machine (mach)
   ;; Convert a hostname into an url, an ftp path, or nil.
@@ -433,6 +531,12 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
    (ffap-ftp-regexp (ffap-host-to-path mach))
    ))
 
    (ffap-ftp-regexp (ffap-host-to-path mach))
    ))
 
+(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
+  "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.")
+
 (defun ffap-newsgroup-p (string)
   "Return STRING if it looks like a newsgroup name, else nil."
   (and
 (defun ffap-newsgroup-p (string)
   "Return STRING if it looks like a newsgroup name, else nil."
   (and
@@ -458,11 +562,6 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
                (setq ret string))))
      ;; Is there ever a need to modify string as a newsgroup name?
      ret)))
                (setq ret string))))
      ;; Is there ever a need to modify string as a newsgroup name?
      ret)))
-(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
-  "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.")
 
 (defsubst ffap-url-p (string)
   "If STRING looks like an url, return it (maybe improved), else nil."
 
 (defsubst ffap-url-p (string)
   "If STRING looks like an url, return it (maybe improved), else nil."
@@ -491,34 +590,34 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
    ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
    ((and ffap-url-unwrap-remote ffap-ftp-regexp
         (ffap-url-unwrap-remote url)))
    ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
    ((and ffap-url-unwrap-remote ffap-ftp-regexp
         (ffap-url-unwrap-remote url)))
-   ;; Do not load w3 just for this:
-   (t (let ((normal (and (fboundp 'url-normalize-url)
-                        (url-normalize-url url))))
-       ;; In case url-normalize-url is confused:
-       (or (and normal (not (zerop (length normal))) normal)
-           url)))))
+   ((fboundp 'url-normalize-url)       ; may autoload url (part of w3)
+    (url-normalize-url url))
+   (url)))
 
 \f
 
 \f
-;;; `ffap-alist':
+;;; Path Handling:
 ;;
 ;;
-;; 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.  A good example of featuritis.
-
-;; First, some helpers for functions in `ffap-alist':
-
-(defvar path-separator ":")            ; for XEmacs 19.13
+;; The upcoming ffap-alist actions need various utilities to prepare
+;; and search paths of directories.  Too many features here.
+
+;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
+;; (defun ffap-splice (func inlist)
+;;  "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
+;;  (let* ((head (cons 17 nil)) (last head))
+;;    (while inlist
+;;      (setcdr last (funcall func (car inlist)))
+;;      (setq last (ffap-last last) inlist (cdr inlist)))
+;;    (cdr head)))
 
 (defun ffap-list-env (env &optional empty)
 
 (defun ffap-list-env (env &optional empty)
-  ;; Replace this with parse-colon-path (lisp/files.el)?
-  "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.
-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.
+  "Return a list of strings parsed from environment variable ENV.
+Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
+also is substituted for the first empty-string component, if there is one.
+Uses `path-separator' to separate the path into substrings."
+  ;; We cannot use parse-colon-path (files.el), since it kills
+  ;; "//" entries using file-name-as-directory.
+  ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
+  ;; in ff-paths and bib-cite.  The EMPTY arg may help mimic kpathsea.
   (if (or empty (getenv env))          ; should return something
       (let ((start 0) match dir ret)
        (setq env (concat (getenv env) path-separator))
   (if (or empty (getenv env))          ; should return something
       (let ((start 0) match dir ret)
        (setq env (concat (getenv env) path-separator))
@@ -528,7 +627,7 @@ Uses `path-separator' to separate the path into directories."
          (setq ret (cons dir ret)))
        (setq ret (nreverse ret))
        (and empty (setq match (member "" ret))
          (setq ret (cons dir ret)))
        (setq ret (nreverse ret))
        (and empty (setq match (member "" ret))
-            (progn
+            (progn                     ; allow string or list here
               (setcdr match (append (cdr-safe empty) (cdr match)))
               (setcar match (or (car-safe empty) empty))))
        ret)))
               (setcdr match (append (cdr-safe empty) (cdr match)))
               (setcar match (or (car-safe empty) empty))))
        ret)))
@@ -544,35 +643,64 @@ Uses `path-separator' to separate the path into directories."
          (progn (setcdr tem ret) (setq ret tem))))
     (nreverse ret)))
 
          (progn (setcdr tem ret) (setq ret tem))))
     (nreverse ret)))
 
-(defun ffap-add-subdirs (path)
-  "Return PATH augmented with its immediate subdirectories."
-  ;; (ffap-add-subdirs '("/notexist" "~"))
-  (let (ret subs)
-    (while path
-      (mapcar
-       (function
-       (lambda (f) (and (file-directory-p f) (setq ret (cons f ret)))))
-       (condition-case nil
-          (directory-files (car path) t "[^.]")
-        (error nil)))
-      (setq ret (cons (car path) ret)
-           path (cdr path)))
-    (nreverse ret)))
-
-(defvar ffap-locate-jka-suffixes t
-  "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)
+(defun ffap-all-subdirs (dir &optional depth)
+  "Return list all subdirectories under DIR, starting with itself.
+Directories beginning with \".\" are ignored, and directory symlinks
+are listed but never searched (to avoid loops).
+Optional DEPTH limits search depth."
+  (and (file-exists-p dir)
+       (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1))))
+
+(defun ffap-all-subdirs-loop (dir depth) ; internal
+  (setq depth (1- depth))
+  (cons dir
+       (and (not (eq depth -1))
+            (apply 'nconc
+                   (mapcar
+                    (function
+                     (lambda (d)
+                       (cond
+                        ((not (file-directory-p d)) nil)
+                        ((file-symlink-p d) (list d))
+                        (t (ffap-all-subdirs-loop d depth)))))
+                    (directory-files dir t "\\`[^.]")
+                    )))))
+
+(defvar ffap-kpathsea-depth 1
+  "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
+Set to 0 to avoid all searching, or nil for no limit.")
+
+(defun ffap-kpathsea-expand-path (path)
+  "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
+The subdirs begin with the original directory, and the depth of the
+search is bounded by `ffap-kpathsea-depth'.  This is intended to mimic
+kpathsea, a library used by some versions of TeX."
+  (apply 'nconc
+        (mapcar
+         (function
+          (lambda (dir)
+            (if (string-match "[^/]//\\'" dir)
+                (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
+              (list dir))))
+         path)))
+
+(defun ffap-locate-file (file &optional nosuffix path dir-ok)
+  ;; The Emacs 20 version of locate-library could almost replace this,
+  ;; except it does not let us overrride the suffix list.  The
+  ;; compression-suffixes search moved to ffap-file-exists-string.
   "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.
   "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'."
+Optional PATH is a list of directories instead of `load-path'.
+Optional DIR-OK means that returning a directory is allowed,
+DIR-OK is already implicit if FILE looks like a directory.
+
+This uses ffap-file-exists-string, which may try adding suffixes from
+`ffap-compression-suffixes'."
   (or path (setq path load-path))
   (or path (setq path load-path))
+  (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file))))
   (if (file-name-absolute-p file)
       (setq path (list (file-name-directory file))
            file (file-name-nondirectory file)))
   (if (file-name-absolute-p file)
       (setq path (list (file-name-directory file))
            file (file-name-nondirectory file)))
@@ -580,174 +708,54 @@ Optional PATH is a list of directories instead of `load-path'."
         (cond
          ((consp nosuffix) nosuffix)
          (nosuffix '(""))
         (cond
          ((consp nosuffix) nosuffix)
          (nosuffix '(""))
-         (t '(".elc" ".el" "")))))
-    ;; 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)
-                  (not (featurep 'jka-aux))
-                  jka-compr-file-name-handler-entry
-                  (not (string-match
-                        (car jka-compr-file-name-handler-entry)
-                        "foo"))
-                  ;; Hard to do this cleverly across jka-compr versions:
-                  '(".gz" ".Z"))))
-    (if ffap-locate-jka-suffixes       ; so nil behaves like '("")
-       (setq suffixes-to-try
-             (apply
-              'nconc
-              (mapcar
-               (function
-                (lambda (suf)
-                  (cons suf
-                        (mapcar
-                         (function (lambda (x) (concat suf x)))
-                         ffap-locate-jka-suffixes))))
-               suffixes-to-try))))
-    (let (found suffixes)
-      (while (and path (not found))
-       (setq suffixes suffixes-to-try)
-       (while (and suffixes (not found))
-         (let ((try (expand-file-name
-                     (concat file (car suffixes))
-                     (car path))))
-           (if (and (file-exists-p try) (not (file-directory-p try)))
-               (setq found try)))
-         (setq suffixes (cdr suffixes)))
-       (setq path (cdr path)))
-      found)))
+         (t '(".elc" ".el" ""))))
+       suffixes try found)
+    (while path
+      (setq suffixes suffixes-to-try)
+      (while suffixes
+       (setq try (ffap-file-exists-string
+                  (expand-file-name
+                   (concat file (car suffixes)) (car path))))
+       (if (and try (or dir-ok (not (file-directory-p try))))
+           (setq found try suffixes nil path nil)
+         (setq suffixes (cdr suffixes))))
+      (setq path (cdr path)))
+    found))
+
+\f
+;;; Action List (`ffap-alist'):
+;;
+;; These search actions depend on the major-mode or regexps matching
+;; the current name.  The little functions and their variables are
+;; deferred to the next section, at some loss of "code locality".  A
+;; good example of featuritis.  Trim this list for speed.
 
 (defvar ffap-alist
 
 (defvar ffap-alist
-  ;; A big mess!  Parts are probably useless.
-  (list
-   (cons "\\.info\\'"
-        (defun ffap-info (name)
-          (ffap-locate-file
-           name '("" ".info")
-           (or (ffap-soft-value "Info-directory-list")
-               (ffap-soft-value "Info-default-directory-list")
-               ;; v18:
-               (list (ffap-soft-value "Info-directory" "~/info/"))))))
-   ;; Since so many info files do not have .info extension, also do this:
-   (cons "\\`info/"
-        (defun ffap-info-2 (name) (ffap-info (substring name 5))))
-   (cons "\\`[-a-z]+\\'"
-        ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
-        (defun ffap-info-3 (name)
-          (and (equal (ffap-string-around) "()") (ffap-info name))))
-   (cons "\\.elc?\\'"
-        (defun ffap-el (name) (ffap-locate-file name t)))
-   (cons 'emacs-lisp-mode
-        (defun ffap-el-mode (name)
-          ;; We do not bother with "" here, since it was considered above.
-          ;; Also ignore "elc", for speed (who else reads elc files?)
-          (and (not (string-match "\\.el\\'" name))
-               (ffap-locate-file name '(".el")))))
-   '(finder-mode . ffap-el-mode)       ; v19: {C-h p}
-   '(help-mode . ffap-el-mode)         ; v19.29
-   (cons 'c-mode
-        (progn
-          ;; 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))))
-   '(c++-mode . ffap-c-mode)
-   '(cc-mode . ffap-c-mode)
-   '("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode)
-   (cons 'tex-mode
-        ;; Complicated because auctex may not be loaded yet.
-        (progn
-          (defvar ffap-tex-path
-            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 '(".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)
-          (ffap-locate-file
-           name t
-           (ffap-list-env "BIBINPUTS" '("/usr/local/lib/tex/macros/bib")))))
-   (cons 'math-mode
-        (defun ffap-math-mode (name)
-          (while (string-match "`" name)
-            (setq name (concat (substring name 0 (match-beginning 0))
-                               "/"
-                               (substring name (match-end 0)))))
-          (ffap-locate-file
-           name '(".m" "") (ffap-soft-value "Mathematica-search-path"))))
-   (cons "\\`\\." (defun ffap-home (name) (ffap-locate-file name t '("~"))))
-   (cons "\\`~/"
-        ;; Maybe a "Lisp Code Directory" reference:
-        (defun ffap-lcd (name)
-          (and
-           (or
-            ;; lisp-dir-apropos output buffer:
-            (string-match "Lisp Code Dir" (buffer-name))
-            ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
-            ;; or maybe the holy LCD-Datafile itself:
-            (member (ffap-string-around) '("||" "|\n")))
-           (concat
-            ;; lispdir.el may not be loaded yet:
-            (ffap-host-to-path
-             (ffap-soft-value "elisp-archive-host"
-                              "archive.cis.ohio-state.edu"))
-            (file-name-as-directory
-             (ffap-soft-value "elisp-archive-directory"
-                              "/pub/gnu/emacs/elisp-archive/"))
-            (substring name 2)))))
-   (cons "^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $
-        (progn
-          (defvar ffap-rfc-path
-            (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))
-          (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)))))
-   )
+  '(
+    ("" . ffap-completable)            ; completion, slow on some systems
+    ("\\.info\\'" . ffap-info)         ; gzip.info
+    ("\\`info/" . ffap-info-2)         ; info/emacs
+    ("\\`[-a-z]+\\'" . ffap-info-3)    ; (emacs)Top [only in the parentheses]
+    ("\\.elc?\\'" . ffap-el)           ; simple.el, simple.elc
+    (emacs-lisp-mode . ffap-el-mode)   ; rmail, gnus, simple, custom
+    ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
+    (finder-mode . ffap-el-mode)       ; type {C-h p} and try it
+    (help-mode . ffap-el-mode)         ; maybe useful
+    (c++-mode . ffap-c-mode)           ; search ffap-c-path
+    (cc-mode . ffap-c-mode)            ; same
+    ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
+    (fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB
+    ("\\.[fF]\\'" . ffap-fortran-mode)
+    (tex-mode . ffap-tex-mode)         ; search ffap-tex-path
+    (latex-mode . ffap-latex-mode)     ; similar
+    ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex)
+    ("\\.bib\\'" . ffap-bib)           ; search ffap-bib-path
+    ("\\`\\." . ffap-home)             ; .emacs, .bashrc, .profile
+    ("\\`~/" . ffap-lcd)               ; |~/misc/ffap.el.Z|
+    ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $
+     . ffap-rfc)                       ; "100% RFC2100 compliant"
+    (dired-mode . ffap-dired)          ; maybe in a subdirectory
+    )
   "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
   "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
@@ -758,6 +766,155 @@ url, or nil. If nil, search the alist for further matches.")
 
 (put 'ffap-alist 'risky-local-variable t)
 
 
 (put 'ffap-alist 'risky-local-variable t)
 
+;; Example `ffap-alist' 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 "^YSN[0-9]+$"
+;;             (defun ffap-ysn (name)
+;;               (concat
+;;                "http://www.physics.uiuc.edu/"
+;;                 "ysn/httpd/htdocs/ysnarchive/issuefiles/"
+;;                (substring name 3) ".html")))
+;;       ffap-alist))
+
+\f
+;;; Action Definitions:
+;;
+;; Define various default members of `ffap-alist'.
+
+(defun ffap-completable (name)
+  (let* ((dir (or (file-name-directory name) default-directory))
+        (cmp (file-name-completion (file-name-nondirectory name) dir)))
+    (and cmp (concat dir cmp))))
+
+(defun ffap-home (name) (ffap-locate-file name t '("~")))
+
+(defun ffap-info (name)
+  (ffap-locate-file
+   name '("" ".info")
+   (or (ffap-soft-value "Info-directory-list")
+       (ffap-soft-value "Info-default-directory-list")
+       )))
+
+(defun ffap-info-2 (name) (ffap-info (substring name 5)))
+
+(defun ffap-info-3 (name)
+  ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
+  (and (equal (ffap-string-around) "()") (ffap-info name)))
+
+(defun ffap-el (name) (ffap-locate-file name t))
+
+(defun ffap-el-mode (name)
+  ;; If name == "foo.el" we will skip it, since ffap-el already
+  ;; searched for it once.  (This assumes the default ffap-alist.)
+  (and (not (string-match "\\.el\\'" name))
+       (ffap-locate-file name '(".el"))))
+
+(defvar ffap-c-path
+  ;; Need smarter defaults here!  Suggestions welcome.
+  '("/usr/include" "/usr/local/include"))
+(defun ffap-c-mode (name)
+  (ffap-locate-file name t ffap-c-path))
+
+(defvar ffap-fortran-path '("../include" "/usr/include"))
+
+(defun ffap-fortran-mode (name)
+  (ffap-locate-file name t ffap-fortran-path))
+
+(defvar ffap-tex-path
+  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)
+       ;; this may be slow, so say something
+       (message "Initializing ffap-tex-path ...")
+       (setq ffap-tex-path
+            (ffap-reduce-path
+             (cons
+              "."
+              (ffap-kpathsea-expand-path
+               (append
+                (ffap-list-env "TEXINPUTS")
+                ;; (ffap-list-env "BIBINPUTS")
+                (ffap-soft-value
+                 "TeX-macro-global"    ; AUCTeX
+                 '("/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))
+
+(defun ffap-latex-mode (name)
+  (ffap-tex-init)
+  ;; only rare need for ""
+  (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
+
+(defun ffap-tex (name)
+  (ffap-tex-init)
+  (ffap-locate-file name t ffap-tex-path))
+
+(defvar ffap-bib-path
+  (ffap-list-env "BIBINPUTS"
+                (ffap-reduce-path
+                 '(
+                   ;; a few wild guesses, need better
+                   "/usr/local/lib/tex/macros/bib" ; Solaris?
+                   "/usr/lib/texmf/bibtex/bib" ; Linux?
+                   ))))
+
+(defun ffap-bib (name)
+  (ffap-locate-file name t ffap-bib-path))
+
+(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))))
+
+;; Maybe a "Lisp Code Directory" reference:
+(defun ffap-lcd (name)
+  (and
+   (or
+    ;; lisp-dir-apropos output buffer:
+    (string-match "Lisp Code Dir" (buffer-name))
+    ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
+    ;; or maybe the holy LCD-Datafile itself:
+    (member (ffap-string-around) '("||" "|\n")))
+   (concat
+    ;; lispdir.el may not be loaded yet:
+    (ffap-host-to-path
+     (ffap-soft-value "elisp-archive-host"
+                     "archive.cis.ohio-state.edu"))
+    (file-name-as-directory
+     (ffap-soft-value "elisp-archive-directory"
+                     "/pub/gnu/emacs/elisp-archive/"))
+    (substring name 2))))
+
+(defvar ffap-rfc-path
+  (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))
+
+(defun ffap-rfc (name)
+  (format ffap-rfc-path
+         (substring name (match-beginning 1) (match-end 1))))
+
 \f
 ;;; At-Point Functions:
 
 \f
 ;;; At-Point Functions:
 
@@ -769,7 +926,7 @@ url, or nil. If nil, search the alist for further matches.")
     ;; * no commas (good for latex)
     (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
     ;; An url, or maybe a email/news message-id:
     ;; * no commas (good for latex)
     (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
     ;; An url, or maybe a email/news message-id:
-    (url "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
+    (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
     ;; Find a string that does *not* contain a colon:
     (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
     ;; A machine:
     ;; Find a string that does *not* contain a colon:
     (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
     ;; A machine:
@@ -785,9 +942,6 @@ possibly a `major-mode' or some symbol internal to ffap
 2. strip BEG chars before point from the beginning,
 3. Strip END chars after point from the end.")
 
 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'.")
-
 (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'.")
 (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'.")
@@ -813,7 +967,7 @@ Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
             (skip-chars-forward (car args))
             (skip-chars-backward (nth 2 args) pt)
             (setcar (cdr ffap-string-at-point-region) (point))))))
             (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))
+    (set-text-properties 0 (length str) nil str)
     (setq ffap-string-at-point str)))
 
 (defun ffap-string-around nil
     (setq ffap-string-at-point str)))
 
 (defun ffap-string-around nil
@@ -846,28 +1000,24 @@ Assumes the buffer has not changed."
   ;; 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
   ;; 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.
+  ;; ffap be less aggressive in such situations.
   (and
    ffap-url-regexp
    (or
   (and
    ffap-url-regexp
    (or
-    ;; In a w3 buffer button zone?
-    (let (tem)
-      (and (eq major-mode 'w3-mode)
-          ;; assume: (boundp 'w3-zone-at) (boundp 'w3-zone-data)
-          (setq tem (w3-zone-at (point)))
-          (consp (setq tem (w3-zone-data tem)))
-          (nth 2 tem)))
+    ;; In a w3 buffer button?
+    (and (eq major-mode 'w3-mode)
+        ;; interface recommended by wmperry:
+        (w3-view-this-url t))
     ;; Is there a reason not to strip trailing colon?
     (let ((name (ffap-string-at-point 'url)))
     ;; Is there a reason not to strip trailing colon?
     (let ((name (ffap-string-at-point 'url)))
-      ;; (case-fold-search t), why?
       (cond
        ((string-match "^url:" name) (setq name (substring name 4)))
       (cond
        ((string-match "^url:" name) (setq name (substring name 4)))
-       ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z]\\'" name)
+       ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z0-9]\\'" name)
             ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
             ;; "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-at-bar-prefix'.
+            ;; Without "<>" it must be "mailto".  Otherwise could be
+            ;; either, so consult `ffap-foo-at-bar-prefix'.
             (let ((prefix (if (and (equal (ffap-string-around) "<>")
             (let ((prefix (if (and (equal (ffap-string-around) "<>")
-                                   ;; At least a couple of odd characters:
+                                   ;; Expect some odd characters:
                                    (string-match "[$.0-9].*[$.0-9].*@" name))
                               ;; Could be news:
                               ffap-foo-at-bar-prefix
                                    (string-match "[$.0-9].*[$.0-9].*@" name))
                               ;; Could be news:
                               ffap-foo-at-bar-prefix
@@ -976,7 +1126,10 @@ which may actually result in an url rather than a filename."
              (if (or (eq major-mode (car tem))
                      (and (stringp (car tem))
                           (string-match (car tem) name)))
              (if (or (eq major-mode (car tem))
                      (and (stringp (car tem))
                           (string-match (car tem) name)))
-                 (and (setq try (funcall (cdr tem) name))
+                 (and (setq try
+                            (condition-case nil
+                                (funcall (cdr tem) name)
+                              (error nil)))
                       (setq try (or
                                  (ffap-url-p try) ; not a file!
                                  (ffap-file-remote-p try)
                       (setq try (or
                                  (ffap-url-p try) ; not a file!
                                  (ffap-file-remote-p try)
@@ -1007,10 +1160,9 @@ which may actually result in an url rather than a filename."
                  (ffap-file-exists-string
                   (ffap-replace-path-component remote-dir name))))))
         )
                  (ffap-file-exists-string
                   (ffap-replace-path-component remote-dir name))))))
         )
-      (store-match-data data))))
-
+      (set-match-data data))))
 \f
 \f
-;;; ffap-read-file-or-url:
+;;; Prompting (`ffap-read-file-or-url'):
 ;;
 ;; We want to complete filenames as in read-file-name, but also url's
 ;; which read-file-name-internal would truncate at the "//" string.
 ;;
 ;; We want to complete filenames as in read-file-name, but also url's
 ;; which read-file-name-internal would truncate at the "//" string.
@@ -1027,17 +1179,19 @@ which may actually result in an url rather than a filename."
     (or (ffap-url-p guess)
        (progn
          (or (ffap-file-remote-p guess)
     (or (ffap-url-p guess)
        (progn
          (or (ffap-file-remote-p guess)
-             (setq guess (abbreviate-file-name (expand-file-name guess))))
+             (setq guess
+                   (abbreviate-file-name (expand-file-name guess))
+                   ))
          (setq dir (file-name-directory guess))))
          (setq dir (file-name-directory guess))))
-    (setq guess
-         (completing-read
-          prompt
-          'ffap-read-file-or-url-internal
-          dir
-          nil
-          (if dir (cons guess (length dir)) guess)
-          (list 'file-name-history)
-          ))
+    (let ((minibuffer-completing-file-name t))
+      (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.
     ;; 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.
@@ -1094,14 +1248,15 @@ which may actually result in an url rather than a filename."
        ad-do-it))))
 
 \f
        ad-do-it))))
 
 \f
-;;; Highlighting:
+;;; Highlighting (`ffap-highlight'):
 ;;
 ;; Based on overlay highlighting in Emacs 19.28 isearch.el.
 
 (defvar ffap-highlight (and window-system t)
   "If non-nil, ffap highlights the current buffer substring.")
 
 ;;
 ;; Based on overlay highlighting in Emacs 19.28 isearch.el.
 
 (defvar ffap-highlight (and window-system t)
   "If non-nil, ffap highlights the current buffer substring.")
 
-(defvar ffap-highlight-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 this buffer.
 
 (defun ffap-highlight (&optional remove)
   "If `ffap-highlight' is set, highlight the guess in this buffer.
@@ -1109,24 +1264,29 @@ 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, or else `highlight'."
   (cond
 Optional argument REMOVE means to remove any such highlighting.
 Uses the face `ffap' if it is defined, or else `highlight'."
   (cond
-   (remove (and ffap-highlight-overlay (delete-overlay ffap-highlight-overlay)))
+   (remove
+    (and ffap-highlight-overlay
+        (delete-overlay ffap-highlight-overlay))
+    )
    ((not ffap-highlight) nil)
    (ffap-highlight-overlay
    ((not ffap-highlight) nil)
    (ffap-highlight-overlay
-    (move-overlay ffap-highlight-overlay
-                 (car ffap-string-at-point-region)
-                 (nth 1 ffap-string-at-point-region)
-                 (current-buffer)))
+    (move-overlay
+     ffap-highlight-overlay
+     (car ffap-string-at-point-region)
+     (nth 1 ffap-string-at-point-region)
+     (current-buffer)))
    (t
    (t
-    (setq ffap-highlight-overlay (apply 'make-overlay ffap-string-at-point-region))
+    (setq ffap-highlight-overlay
+         (apply 'make-overlay ffap-string-at-point-region))
     (overlay-put ffap-highlight-overlay 'face
     (overlay-put ffap-highlight-overlay 'face
-                (if (internal-find-face 'ffap nil)
-                    'ffap 'highlight)))))
+                     (if (internal-find-face 'ffap)
+                         'ffap 'highlight)))))
 
 \f
 
 \f
-;;; The big enchilada:
+;;; Main Entrance (`find-file-at-point' == `ffap'):
 
 (defun ffap-guesser nil
 
 (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))))
   (or (and ffap-url-regexp
           (ffap-fixup-url (or (ffap-url-at-point)
                               (ffap-gopher-at-point))))
@@ -1137,21 +1297,25 @@ Uses the face `ffap' if it is defined, or else `highlight'."
   ;; Does guess and prompt step for find-file-at-point.
   ;; Extra complication for the temporary highlighting.
   (unwind-protect
   ;; Does guess and prompt step for find-file-at-point.
   ;; 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))
-        ))
+      ;; This catch will let ffap-alist entries do their own prompting
+      ;; and then maybe skip over this prompt (ff-paths, for example).
+      (catch 'ffap-prompter
+       (ffap-read-file-or-url
+        (if ffap-url-regexp "Find file or URL: " "Find file: ")
+        (prog1
+            (setq guess (or guess (ffap-guesser))) ; using ffap-alist here
+          (and guess (ffap-highlight))
+          )))
     (ffap-highlight t)))
 
 ;;;###autoload
 (defun find-file-at-point (&optional filename)
     (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'.
-With a prefix, this command behaves *exactly* like `ffap-file-finder'.
+  "Find FILENAME, guessing a default from text around point.
+If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
+With a prefix, this command behaves exactly like `ffap-file-finder'.
 If `ffap-require-prefix' is set, the prefix meaning is reversed.
 If `ffap-require-prefix' is set, the prefix meaning is reversed.
+See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
+and the functions `ffap-file-at-point' and `ffap-url-at-point'.
 
 See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
   (interactive)
 
 See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
   (interactive)
@@ -1181,32 +1345,29 @@ See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
                                "no such file or directory"
                                filename))))))
 
                                "no such file or directory"
                                filename))))))
 
-;; M-x shortcut:
-;;###autoload
+;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
+;; The defun is for autoload.el; the defalias takes over at load time.
+;;;###autoload
+(defun ffap (&optional filename)
+  "A short alias for the find-file-at-point command.")
 (defalias 'ffap 'find-file-at-point)
 
 \f
 (defalias 'ffap 'find-file-at-point)
 
 \f
-;;; Menu support:
-;;
-;; Bind ffap-menu to a key if you want, since it also works in tty mode.
-;; Or just use it through the ffap-at-mouse binding (next section).
+;;; Menu support (`ffap-menu'):
 
 (defvar ffap-menu-regexp nil
   "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
 Make this more restrictive for faster menu building.
 
 (defvar ffap-menu-regexp nil
   "*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.")
+For example, try \":/\" for URL (and some ftp) references.")
 
 (defvar ffap-menu-alist nil
   "Buffer local cache of menu presented by `ffap-menu'.")
 (make-variable-buffer-local 'ffap-menu-alist)
 
 (defvar ffap-menu-text-plist
 
 (defvar ffap-menu-alist nil
   "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>
-        ))
+  (cond
+   ((not window-system) nil)
+   (t '(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.")
 
   "Text properties applied to strings found by `ffap-menu-rescan'.
 These properties may be used to fontify the menu references.")
 
@@ -1248,70 +1409,74 @@ a rebuild.  Searches with `ffap-menu-regexp'."
 
 (defun ffap-menu-ask (title alist cont)
   "Prompt from a menu of choices, and then apply some action.
 
 (defun ffap-menu-ask (title alist cont)
   "Prompt from a menu of choices, and then apply some action.
-Arguments are TITLE, ALIST, and CONT (a continuation).
+Arguments are TITLE, ALIST, and CONT \(a continuation function\).
 This uses either a menu or the minibuffer depending on invocation.
 The TITLE string is used as either the prompt or menu title.
 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\) 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.
-  (let ((choice
-        (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
-             t
-             (list ""
-                   (cons title
-                         (mapcar
-                          (function (lambda (i) (cons (car i) i)))
-                          alist))))
-          ;; 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)))
-    (if choice (funcall cont choice) (message "No choice made!")))
-  nil)                                 ; return nothing
+Each \(string . data\) ALIST entry defines a choice.
+Function CONT is applied to the entry chosen by the user."
+  ;; Note: this function is used with a different continuation
+  ;; by the ffap-url add-on package.
+  ;; Could try rewriting to use easymenu.el or lmenu.el.
+  (let (choice)
+    (cond
+     ;; Emacs mouse:
+     ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
+      (setq choice
+           (x-popup-menu
+            t
+            (list "" (cons title
+                           (mapcar (function (lambda (i) (cons (car i) i)))
+                                   alist))))))
+     ;; minibuffer with completion buffer:
+     (t
+      (let ((minibuffer-setup-hook 'minibuffer-completion-help))
+       ;; Bug: prompting may assume unique strings, no "".
+       (setq choice
+             (completing-read
+              (format "%s (default %s): " title (car (car alist)))
+              alist nil t
+              ;; (cons (car (car alist)) 0)
+              nil)))
+      (sit-for 0)                      ; redraw original screen
+      ;; Convert string to its entry, or else the default:
+      (setq choice (or (assoc choice alist) (car alist))))
+     )
+    (if choice
+       (funcall cont choice)
+      (message "No choice made!")      ; possible with menus
+      nil)))
 
 (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))
 
 (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)))
+       (mod (buffer-modified-p))       ; was buffer modified?
        buffer-read-only                ; to set text-properties
        buffer-read-only                ; to set text-properties
+       item
        ;; Avoid repeated searches of the *mode-alist:
        (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
                        major-mode
        ;; Avoid repeated searches of the *mode-alist:
        (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
                        major-mode
-                     'file))
-       )
+                     'file)))
     (setq ffap-menu-alist nil)
     (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))))
+    (unwind-protect
+       (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)))
+      (or mod (set-buffer-modified-p nil))))
   (message "Scanning...done")
   ;; Remove duplicates.
   (setq ffap-menu-alist                        ; sort by item
        (sort ffap-menu-alist
              (function
               (lambda (a b) (string-lessp (car a) (car b))))))
   (message "Scanning...done")
   ;; Remove duplicates.
   (setq ffap-menu-alist                        ; sort by item
        (sort ffap-menu-alist
              (function
               (lambda (a b) (string-lessp (car a) (car b))))))
-  (let ((ptr ffap-menu-alist))
+  (let ((ptr ffap-menu-alist))         ; remove duplicates
     (while (cdr ptr)
       (if (equal (car (car ptr)) (car (car (cdr ptr))))
          (setcdr ptr (cdr (cdr ptr)))
     (while (cdr ptr)
       (if (equal (car (car ptr)) (car (car (cdr ptr))))
          (setcdr ptr (cdr (cdr ptr)))
@@ -1322,56 +1487,80 @@ Applies `ffap-menu-text-plist' text properties at all matches."
               (lambda (a b) (< (cdr a) (cdr b)))))))
 
 \f
               (lambda (a b) (< (cdr a) (cdr b)))))))
 
 \f
-;;; Mouse Support:
+;;; Mouse Support (`ffap-at-mouse'):
 ;;
 ;; See the suggested binding in ffap-bindings (near eof).
 
 ;;
 ;; 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 at click.
-A command symbol, or nil for nothing.")
+(defvar ffap-at-mouse-fallback nil     ; ffap-menu? too time-consuming
+  "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
+Ignored when `ffap-at-mouse' is called programmatically.")
 (put 'ffap-at-mouse-fallback 'risky-local-variable t)
 
 (put 'ffap-at-mouse-fallback 'risky-local-variable t)
 
+;;;###autoload
 (defun ffap-at-mouse (e)
 (defun ffap-at-mouse (e)
-  "Find file or url guessed from text around mouse point.
-If none is found, call `ffap-at-mouse-fallback'."
+  "Find file or url guessed from text around mouse click.
+Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
+Return value:
+  * if a guess string is found, return it (after finding it)
+  * if the fallback is called, return whatever it returns
+  * otherwise, nil"
   (interactive "e")
   (let ((guess
         ;; Maybe less surprising without the save-excursion?
         (save-excursion
           (mouse-set-point e)
   (interactive "e")
   (let ((guess
         ;; Maybe less surprising without the save-excursion?
         (save-excursion
           (mouse-set-point e)
-          ;; Would like to do nothing unless click was *on* text.  How?
-          ;; (cdr (posn-col-row (event-start e))) is always same as
-          ;; current column.  For posn-x-y, need pixel-width!
+          ;; Would prefer to do nothing unless click was *on* text.  How
+          ;; to tell that the click was beyond the end of current line?
           (ffap-guesser))))
     (cond
      (guess
           (ffap-guesser))))
     (cond
      (guess
+      (set-buffer (ffap-event-buffer e))
       (ffap-highlight)
       (unwind-protect
          (progn
            (sit-for 0)                 ; display
       (ffap-highlight)
       (unwind-protect
          (progn
            (sit-for 0)                 ; display
-           (message "Guessing `%s'" guess)
-           (find-file-at-point guess))
+           (message "Finding `%s'" guess)
+           (find-file-at-point guess)
+           guess)                      ; success: return non-nil
        (ffap-highlight t)))
        (ffap-highlight t)))
-     ((and (interactive-p)
-          ffap-at-mouse-fallback)
-      (call-interactively ffap-at-mouse-fallback))
-     ((message "No file or URL found at mouse click.")))))
+     ((interactive-p)
+      (if ffap-at-mouse-fallback
+         (call-interactively ffap-at-mouse-fallback)
+       (message "No file or url found at mouse click.")
+       nil))                           ; no fallback, return nil
+     ;; failure: return nil
+     )))
 
 \f
 
 \f
-;;; ffap-other-* commands
-;; Suggested by KPC.
+;;; ffap-other-* commands:
+;;
+;; Requested by KPC.
+
+;; There could be a real `ffap-noselect' function, but we would need
+;; at least two new user variables, and there is no w3-fetch-noselect.
+;; So instead, we just fake it with a slow save-window-excursion.
 
 (defun ffap-other-window nil
 
 (defun ffap-other-window nil
-  "Like `ffap', but put buffer in another window."
+  "Like `ffap', but put buffer in another window.
+Only intended for interactive use."
   (interactive)
   (switch-to-buffer-other-window
    (save-window-excursion (call-interactively 'ffap) (current-buffer))))
 
 (defun ffap-other-frame nil
   (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.
+Only intended for interactive use."
   (interactive)
   (interactive)
-  (switch-to-buffer-other-frame
-   (save-window-excursion (call-interactively 'ffap) (current-buffer))))
+  ;; Extra code works around dedicated windows (noted by JENS, 7/96):
+  (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
+    (unwind-protect
+       (progn
+         (set-window-dedicated-p win nil)
+         (switch-to-buffer-other-frame
+          (save-window-excursion
+            (call-interactively 'ffap)
+            (current-buffer))))
+      (set-window-dedicated-p win wdp))))
 
 \f
 ;;; Bug Reporter:
 
 \f
 ;;; Bug Reporter:
@@ -1386,7 +1575,7 @@ If none is found, call `ffap-at-mouse-fallback'."
   (let ((reporter-prompt-for-summary-p t))
     (reporter-submit-bug-report
      "Michelangelo Grigni <mic@mathcs.emory.edu>"
   (let ((reporter-prompt-for-summary-p t))
     (reporter-submit-bug-report
      "Michelangelo Grigni <mic@mathcs.emory.edu>"
-     "ffap 1.6"
+     "ffap"
      (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
 
 (fset 'ffap-submit-bug 'ffap-bug)      ; another likely name
      (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
 
 (fset 'ffap-submit-bug 'ffap-bug)      ; another likely name
@@ -1435,59 +1624,77 @@ If none is found, call `ffap-at-mouse-fallback'."
   (interactive) (ffap-gnus-wrapper '(ffap-menu)))
 
 \f
   (interactive) (ffap-gnus-wrapper '(ffap-menu)))
 
 \f
-;;; ffap-bindings: offer default global bindings
+(defcustom dired-at-point-require-prefix nil
+  "*If set, reverses the prefix argument to `dired-at-point'.
+This is nil so neophytes notice ffap.  Experts may prefer to disable
+ffap most of the time."
+  :type 'boolean
+  :group 'ffap
+  :version "20.3")
+
+;;;###autoload
+(defun dired-at-point (&optional filename)
+  "Start Dired, defaulting to file at point.  See `ffap'."
+  (interactive)
+  (if (and (interactive-p)
+          (if dired-at-point-require-prefix
+              (not current-prefix-arg)
+            current-prefix-arg))
+      (let (current-prefix-arg)                ; already interpreted
+       (call-interactively 'dired))
+    (or filename (setq filename (dired-at-point-prompter)))
+    (cond
+     ((ffap-url-p filename)
+      (funcall ffap-url-fetcher filename))
+     ((and ffap-dired-wildcards
+          (string-match ffap-dired-wildcards filename))
+      (dired filename))
+     ((file-exists-p filename)
+      (if (file-directory-p filename)
+         (dired (expand-file-name filename))
+       (dired (concat (expand-file-name filename) "*"))))
+     ((y-or-n-p "Directory does not exist, create it? ")
+      (make-directory filename)
+      (dired filename))
+     ((error "No such file or directory `%s'" filename)))))
+
+(defun dired-at-point-prompter (&optional guess)
+  ;; Does guess and prompt step for find-file-at-point.
+  ;; Extra complication for the temporary highlighting.
+  (unwind-protect
+      (ffap-read-file-or-url
+       (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
+       (prog1
+          (setq guess (or guess (ffap-guesser)))
+        (and guess (ffap-highlight))
+        ))
+    (ffap-highlight t)))
+\f
+;;; Offer default global bindings (`ffap-bindings'):
 
 (defvar ffap-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 [S-mouse-3] 'ffap-at-mouse)
+     (global-set-key [C-S-mouse-3] 'ffap-menu)
      (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)
      (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)
+     (global-set-key "\C-xd"    'dired-at-point)
      (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
      (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'.
+     )
+     "List of binding forms evaluated by function `ffap-bindings'.
 A reasonable ffap installation needs just these two lines:
   (require 'ffap)
   (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.")
+Of course if you do not like these bindings, just roll your own!")
 
 (defun ffap-bindings nil
   "Evaluate the forms in variable `ffap-bindings'."
   (eval (cons 'progn ffap-bindings)))
 
 
 (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))
-
-\f
-;;; 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"))
-
 \f
 ;;; ffap.el ends here
 \f
 ;;; ffap.el ends here