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