-;;; ffap.el -- find-file-at-point,
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
+;;; 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
+;; Keywords: files, hypermedia, matching, mouse, convenience
+;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, 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/)
-\f
-;;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
\f
-;;; 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
+;;; Commentary:
;;
-;; After loading ffap:
+;; 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.
;;
-;; (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
+;; For the default installation, byte-compile ffap.el somewhere in
+;; your `load-path' and add these two lines to your .emacs file:
;;
-;; (setq ffap-alist ; remove something in `ffap-alist'
-;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
+;; (require 'ffap) ; load the package
+;; (ffap-bindings) ; do default key bindings
;;
-;; (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))
+;; ffap-bindings makes the following global key bindings:
;;
+;; 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
+;; C-S-mouse-3 ffap-menu
;;
-;; Before or after loading ffap:
+;; ffap-bindings also adds hooks to make the following local bindings
+;; in vm, gnus, and rmail:
;;
-;; (setq ffap-alist nil) ; disable all `ffap-alist' actions
+;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link")
+;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
;;
-;; (setq ffap-require-prefix t) ; without prefix, ffap == find-file
+;; If you do not like these bindings, modify the variable
+;; `ffap-bindings', or write your own.
;;
-;; (setq ffap-machine-p-known 'accept) ; to avoid pinging
+;; 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:
;;
-;; ;; 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))))
+;; (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
;;
-;; ;; 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).
-;;
-;; ;; 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)
+;; 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
+;; the file and URL references within a buffer.
\f
-;;; Related packages:
-;;
-;; 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.
+;;; Change Log:
;;
-;; 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.
+;; The History and Contributors moved to ffap.LOG (same ftp site),
+;; which also has some old examples and commentary from ffap 1.5.
\f
-;;; Examples:
-;;
-;; Try M-x find-file-at-point (maybe {C-x C-f}) on these examples.
-;; These local file examples use ordinary find-file:
-;;
-;; 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'
-;;
-;; These remote file examples work if you have ange-ftp or efs:
-;;
-;; 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'
-;;
-;; These URL examples use `ffap-url-fetcher' (default w3-fetch):
-;;
-;; 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
+;;; Todo list:
+;; * 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)
+;; * 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?)
+;; * 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'
+;; * handle "$(VAR)" in Makefiles
+;; * use the font-lock machinery
\f
;;; Code:
(provide 'ffap)
+;; 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>\"")
+
+
+(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:
-;; 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)))
-
-(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 set, convert local \"file:\" URL to path before prompting.")
-
-(defvar ffap-url-unwrap-remote t
- "*Convert remote \"file:\" or \"ftp:\" URL to path before prompting.
-This is ignored if `ffap-ftp-regexp' is nil.")
-
-(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")
- "*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'.")
-
-(defvar ffap-rfs-regexp
+(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.
+This is ignored if `ffap-ftp-regexp' is nil."
+ :type 'boolean
+ :group 'ffap)
+
+(defcustom ffap-ftp-default-user "anonymous"
+ "*User name in ftp paths generated by `ffap-host-to-path'.
+Note this name may be omitted if it equals the default
+\(either `efs-default-user' or `ange-ftp-default-user'\)."
+ :type 'string
+ :group 'ffap)
+
+(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/.")
- "*Paths matching this are remote file-system paths. 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.
"\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
"\\)." ; require one more character
)
- "Regexp matching URL's, or nil to disable.")
-
-(defvar ffap-foo@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
-;;; 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
;; 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.
+(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,
-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.")
-
-(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.")
+If `find-file-at-point' gets a filename matching this pattern,
+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'.
+ "*Whether `find-file-at-point' prompts about a nonexistent file."
+ :type 'boolean
+ :group 'ffap)
+
+(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
+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)
-(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\)
-
-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:
+(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.
+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
-;;; Command ffap-next:
+;;; Compatibility:
;;
-;; 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.
+;; 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))))
-(defvar ffap-next-regexp
+\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.
+
+(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))))
;; 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'."
+ :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)
- "Move point to next file or url, and return it as a string.
-If nothing found, leaves point at limit and returns nil.
+ "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.
Only considers strings that match `ffap-next-regexp'."
;;;###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,
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)))))
(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)
- "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)
(ffap-next back wrap))))
\f
-;;; 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)))
-
-\f
-;;; 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-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))))
+;;; 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.
-(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.")
-(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\).")
-(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\"\).
+(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
+\(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
+\(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)
+ (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.
+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
((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))))))))))))
+\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")
- ;; (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 dieing
+ ;; 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 \"/USER@HOST:\" or \"/HOST:\".
+Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
+ (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 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 ":"))))
+(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."
;; 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)
(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.")
-(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-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)))
((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
-;;; `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. I have had a vote for eliminating this
-;; from ffap (featuritis)
-
-;; First, some helpers for functions in `ffap-alist':
+;; 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)
- ;; Replace this with parse-colon-path (lisp/files.el)?
- "Directory list parsed from \":\"-separated ENVinronment variable.
-Optional EMPTY is default if (getenv ENV) is undefined, and is also
-substituted for the first empty-string component, if there is one."
- ;; 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) ":")) ; note undefined --> ":"
- (while (setq match (string-match ":" env start))
+ (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)) ...)
(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)))
(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))))
(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 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\").")
-
-(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'."
+(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.
+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 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)))
(cond
((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:
- (or (listp ffap-locate-jka-suffixes)
- (setq ffap-locate-jka-suffixes
- (and (featurep 'jka-compr) ; an early version was jka-compr19
- (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:
- '(".gz" ".Z"))))
- (if ffap-locate-jka-suffixes
- (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
- ;; 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 default 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
- (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.")
- (defun ffap-tex-mode (name)
- (ffap-locate-file name '(".tex" "") ffap-tex-path))))
- (cons 'latex-mode
- (defun ffap-latex-mode (name)
- ;; Any real need for "" here?
- (ffap-locate-file name '(".sty" ".tex" "") ffap-tex-path)))
- (cons "\\.\\(tex\\|sty\\|doc\\)\\'"
- (defun ffap-tex (name)
- (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))))))
- )
- "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.")
+ '(
+ ("" . 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
+ 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)
+;; 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:
(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.")
-
-(defvar ffap-string-at-point-region '(1 1)
- "List (BEG END), last region returned by ffap-string-at-point.")
+ "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 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))))))
+ (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
(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 less aggressive in such situations.
(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
- ;; Allow leading digits for email/news id's:
- "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")))
- ;; (case-fold-search t), why?
+ (let ((name (ffap-string-at-point 'url)))
(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).
- ;; If not adorned with "<>", it must be "mailto".
- ;; Otherwise could be either, so consult `ffap-foo@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) "<>")
- ;; At least a couple of odd characters:
+ ;; Expect some 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)))
(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)
(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.")
"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
(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))
(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)
(ffap-file-exists-string
(ffap-replace-path-component remote-dir name))))))
)
- (store-match-data data))))
-
+ (set-match-data data))))
\f
-;;; ffap-read-file-or-url:
+;;; Prompting (`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 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
+ (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.
+ ;; 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))))
\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.")
-(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
- (car ffap-string-at-point-region)
- (nth 1 ffap-string-at-point-region)
- (current-buffer)))
+ (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
- (if (internal-find-face 'ffap nil)
- 'ffap 'highlight)))))
+ (setq ffap-highlight-overlay
+ (apply 'make-overlay ffap-string-at-point-region))
+ (overlay-put ffap-highlight-overlay 'face
+ (if (internal-find-face 'ffap)
+ 'ffap 'highlight)))))
+
\f
-;;; The big enchilada:
+;;; Main Entrance (`find-file-at-point' == `ffap'):
(defun ffap-guesser nil
"Return file or URL or nil, guessed from text around point."
(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))))
+ ;; 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)
- "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.
+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 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)
"no such file or directory"
filename))))))
-;; M-x shortcut:
-(fset 'ffap 'find-file-at-point)
+;; 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
-;;; 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.
+ "*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 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
+ (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.")
+
;;;###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
(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.
-Each (string . data) entry in ALIST 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
- (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))))
- ;; 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
- )))))
- ;; 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))
- (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
+ item
+ ;; 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))
- (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))))))
- (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)))
(lambda (a b) (< (cdr a) (cdr b)))))))
\f
-;;; Mouse Support:
+;;; Mouse Support (`ffap-at-mouse'):
;;
-;; 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.
-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)
+;;;###autoload
(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)
- ;; 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
+ (set-buffer (ffap-event-buffer e))
(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)))
- ((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
-;;; ffap-other-* commands
-;; Suggested by KPC. Possible bindings for C-x 4 C-f, C-x 5 C-f.
+;;; 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
- "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
- "Like ffap, but put buffer in another frame."
+ "Like `ffap', but put buffer in another frame.
+Only intended for interactive use."
(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
-;;; 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"
+ (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
+
(fset 'ffap-submit-bug 'ffap-bug) ; another likely name
\f
-;;; Todo, End.
+;;; Hooks for Gnus, VM, Rmail:
;;
-;; * 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)
-;;
-;; 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.
+
+(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))))
-;; Local Variables?
-;; foo: bar
-;; End:
+(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)))
+\f
+(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
+ '(
+ (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-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
+ )
+ "List of binding forms evaluated by function `ffap-bindings'.
+A reasonable ffap installation needs just these two lines:
+ (require 'ffap)
+ (ffap-bindings)
+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)))
+
+\f
;;; ffap.el ends here