X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aeafca1f94ff8146308b89a8e1a5ff865f6fce76..d21fc79671899d088bd7de78a4c96a5193ff6def:/lisp/ffap.el diff --git a/lisp/ffap.el b/lisp/ffap.el index 671e0eddb6..e30b859a58 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,11 +1,12 @@ -;;; ffap.el --- find file or url at point +;;; ffap.el --- find file (or url) at point -;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1995, 96, 97, 2000, 2004 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni +;; Maintainer: Rajesh Vaidheeswarran ;; Created: 29 Mar 1993 -;; Keywords: files, hypermedia, matching, mouse -;; X-Latest: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ +;; Keywords: files, hypermedia, matching, mouse, convenience +;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ ;; This file is part of GNU Emacs. @@ -21,38 +22,49 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; Command find-file-at-point replaces find-file. With a prefix, it ;; behaves exactly like find-file. Without a prefix, it first tries -;; to guess a default file or url from the text around the point +;; to guess a default file or URL from the text around the point ;; (`ffap-require-prefix' swaps these behaviors). This is useful for ;; following references in situations such as mail or news buffers, ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with ;; M-x ffap-bug. ;; -;; For the default installation, byte-compile ffap.el somewhere in -;; your `load-path' and add these two lines to your .emacs file: +;; For the default installation, add this line to your .emacs file: ;; -;; (require 'ffap) ; load the package ;; (ffap-bindings) ; do default key bindings ;; ;; 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 +;; C-x C-f find-file-at-point (abbreviated as ffap) +;; C-x C-r ffap-read-only +;; C-x C-v ffap-alternate-file +;; +;; C-x d dired-at-point +;; C-x C-d ffap-list-directory +;; +;; C-x 4 f ffap-other-window +;; C-x 4 r ffap-read-only-other-window +;; C-x 4 d ffap-dired-other-window +;; +;; C-x 5 f ffap-other-frame +;; C-x 5 r ffap-read-only-other-frame +;; C-x 5 d ffap-dired-other-frame +;; ;; S-mouse-3 ffap-at-mouse +;; C-S-mouse-3 ffap-menu ;; ;; ffap-bindings also adds hooks to make the following local bindings ;; in vm, gnus, and rmail: ;; -;; M-l ffap-next, or ffap-gnus-next in gnus -;; M-m ffap-menu, or ffap-gnus-menu in gnus +;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link") +;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu") ;; ;; If you do not like these bindings, modify the variable ;; `ffap-bindings', or write your own. @@ -64,44 +76,56 @@ ;; ;; (setq ffap-alist nil) ; faster, dumber prompting ;; (setq ffap-machine-p-known 'accept) ; no pinging -;; (setq ffap-url-regexp nil) ; disable url features in ffap +;; (setq ffap-url-regexp nil) ; disable URL features in ffap +;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping ;; -;; ffap uses w3 (if found) or else browse-url to fetch url's. For -;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). +;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's. +;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify -;; the file and url references within a buffer. +;; the file and URL references within a buffer. + + +;;; Change Log: +;; +;; The History and Contributors moved to ffap.LOG (same ftp site), +;; which also has some old examples and commentary from ffap 1.5. + ;;; Todo list: -;; * recognize paths inside /usr/bin:/bin:/etc, ./ffap.el:80: -;; * let "/path/file#key" jump to key (offset or regexp) in /path/file +;; * use kpsewhich +;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/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 +;; * break long menus into multiple panes (like imenu?) +;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace) +;; * notice "machine.dom blah blah blah dir/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' -;; * support for custom.el -;; + handle "$(HOME)" in Makefiles? -;; + modify `font-lock-keywords' to do fontification +;; * handle "$(VAR)" in Makefiles +;; * use the font-lock machinery ;;; Code: (provide 'ffap) -;; Versions: This file is tested with Emacs 19.30. It mostly works -;; with XEmacs, but get ffap-xe.el for the popup menu. Emacs 18 is -;; now abandoned (get ffap-15.el instead). +;; Please do not delete this variable, it is checked in bug reports. +(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>" + "The version of ffap: \"Major.Minor-Build \"") + -(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t) - "Whether ffap thinks it is running under XEmacs.") +(defgroup ffap nil + "Find file or URL at point." + :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/") + :group 'matching + :group 'convenience) +;; The code is organized in pages, separated by formfeed characters. +;; See the next two pages for standard customization ideas. ;;; User Variables: -;; This function is used inside defvars: (defun ffap-soft-value (name &optional default) "Return value of symbol with NAME, if it is interned. Otherwise return nil (or the optional DEFAULT value)." @@ -109,39 +133,54 @@ Otherwise return nil (or the optional DEFAULT value)." (let ((sym (intern-soft name))) (if (and sym (boundp sym)) (symbol-value sym) default))) - -(defvar ffap-ftp-regexp - (and - (or (featurep 'ange-ftp) - (featurep 'efs) - (and (boundp 'file-name-handler-alist) ; v19 - (or (rassq 'ange-ftp-hook-function file-name-handler-alist) - (rassq 'efs-file-handler-function file-name-handler-alist)))) - ;; Apparently this is good enough for both ange-ftp and efs: - "\\`/[^/:]+:") - "*Treat paths matching this as remote ftp paths. Nil to disable. -Nil also disables the generation of such paths by ffap.") - -(defvar ffap-url-unwrap-local t - "*If non-nil, convert \"file:\" url to local path before prompting.") - -(defvar ffap-url-unwrap-remote t - "*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 - (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-host-to-path'. -Nil to rely on `efs-default-user' or `ange-ftp-default-user'.") - -(defvar ffap-rfs-regexp +(defcustom ffap-shell-prompt-regexp + ;; This used to test for some shell prompts that don't have a space + ;; after them. The common root shell prompt (#) is not listed since it + ;; also doubles up as a valid URL character. + "[$%><]*" + "Paths matching this regexp are stripped off the shell prompt +If nil, ffap doesn't do shell prompt stripping." + :type '(choice (const :tag "Disable" nil) + (const :tag "Standard" "[$%><]*") + regexp) + :group 'ffap) + +(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. + "\\`/[^/:]+:" + "*File names matching this regexp are treated as remote ffap. +If nil, ffap neither recognizes nor generates such names." + :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 file name before prompting." + :type 'boolean + :group 'ffap) + +(defcustom ffap-url-unwrap-remote t + "*If non-nil, convert `ftp:' URL to remote file name 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 file names 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/.") - "*Matching paths are treated as remote. Nil to disable.") + "*Matching file names are treated as remote. Use nil to disable." + :type 'regexp + :group 'ffap) (defvar ffap-url-regexp ;; Could just use `url-nonrelative-link' of w3, if loaded. @@ -150,17 +189,23 @@ Nil to rely on `efs-default-user' or `ange-ftp-default-user'.") "\\`\\(" "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok "\\|" - "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host + "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host "\\)." ; require one more character ) - "Regexp matching url's. Nil to disable url features in ffap.") - -(defvar ffap-foo-at-bar-prefix "mailto" - "*Presumed url prefix type of strings like \"\". -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 \"\". +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) -;;; 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 @@ -168,49 +213,96 @@ Sensible values are nil, \"news\", or \"mailto\".") ;; through this section for features that you like, put an appropriate ;; enabler in your .emacs file. -(defvar ffap-dired-wildcards nil ; "[*?][^/]*$" - ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still - ;; available by "C-x C-d ", and valid filenames may - ;; sometimes contain wildcard characters. +(defcustom ffap-dired-wildcards "[*?][^/]*\\'" "*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 +If `find-file-at-point' gets a filename matching this pattern, +and `ffap-pass-wildcards-to-dired' is nil, it passes it on to +`find-file' with non-nil WILDCARDS argument, which expands +wildcards and visits multiple files. To visit a file whose name +contains wildcard characters you can suppress wildcard expansion +by setting `find-file-wildcards'. If `find-file-at-point' gets a +filename matching this pattern and `ffap-pass-wildcards-to-dired' +is non-nil, it passes it on to `dired'. + +If `dired-at-point' gets a filename matching this pattern, +it passes it on to `dired'." + :type '(choice (const :tag "Disable" nil) + (const :tag "Enable" "[*?][^/]*\\'") + ;; regexp -- probably not useful + ) + :group 'ffap) + +(defcustom ffap-pass-wildcards-to-dired nil + "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired." + :type 'boolean + :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.") + "*Whether `find-file-at-point' prompts about a nonexistent file." + :type 'boolean + :group 'ffap) -(defvar ffap-require-prefix nil +(defcustom ffap-require-prefix nil ;; Suggestion from RHOGEE, 20 Oct 1994. "*If set, reverses the prefix argument to `find-file-at-point'. This is nil so neophytes notice ffap. Experts may prefer to disable -ffap most of the time.") - -(defvar ffap-file-finder 'find-file - "*The command called by `find-file-at-point' to find a file.") +ffap most of the time." + :type 'boolean + :group 'ffap) + +(defcustom ffap-file-finder 'find-file + "*The command called by `find-file-at-point' to find a file." + :type 'function + :group 'ffap) (put 'ffap-file-finder 'risky-local-variable t) -(defvar ffap-url-fetcher - (cond ((fboundp 'w3-fetch) 'w3-fetch) - ((fboundp 'browse-url-netscape) 'browse-url-netscape) - (t 'w3-fetch)) +(defcustom ffap-directory-finder 'dired + "*The command called by `dired-at-point' to find a directory." + :type 'function + :group 'ffap) +(put 'ffap-directory-finder 'risky-local-variable t) + +(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 `browse-url-netscape'. -For a fancier alternative, get ffap-url.el.") +Reasonable choices are `w3-fetch' or a `browse-url-*' function. +For a fancy alternative, get `ffap-url.el'." + :type '(choice (const w3-fetch) + (const browse-url) ; in recent versions of browse-url + (const browse-url-netscape) + (const browse-url-mosaic) + function) + :group 'ffap) (put 'ffap-url-fetcher 'risky-local-variable t) -;;; Command ffap-next: +;;; Compatibility: +;; +;; This version of ffap supports Emacs 20 only, see the ftp site +;; for a more general version. The following functions are necessary +;; "leftovers" from the more general version. + +(defun ffap-mouse-event nil ; current mouse event, or nil + (and (listp last-nonmenu-event) last-nonmenu-event)) +(defun ffap-event-buffer (event) + (window-buffer (car (event-start event)))) + + +;;; 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. -(defvar ffap-next-regexp +(defcustom ffap-next-regexp ;; If you want ffap-next to find URL's only, try this: ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) ;; (concat "\\<" (substring ffap-url-regexp 2)))) @@ -218,11 +310,18 @@ For a fancier alternative, get ffap-url.el.") ;; It pays to put a big fancy regexp here, since ffap-guesser is ;; much more time-consuming than regexp searching: "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\." - "*Regular expression governing movements of `ffap-next'.") + "*Regular expression governing movements of `ffap-next'." + :type 'regexp + :group 'ffap) + +(defvar ffap-next-guess nil + "Last value returned by `ffap-next-guess'.") + +(defvar ffap-string-at-point-region '(1 1) + "List (BEG END), last region returned by `ffap-string-at-point'.") -(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.") (defun ffap-next-guess (&optional back lim) - "Move point to next file or url, and return it as a string. + "Move point to next file or URL, and return it as a string. If nothing is found, leave point at limit and return nil. Optional BACK argument makes search backwards. Optional LIM argument limits the search. @@ -239,7 +338,7 @@ 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, @@ -259,7 +358,7 @@ Actual search is done by `ffap-next-guess'." (sit-for 0) ; display point movement (find-file-at-point (ffap-prompter guess))) (goto-char pt) ; restore point - (message "No %sfiles or URL's found." + (message "No %sfiles or URL's found" (if wrap "" "more "))))) (defun ffap-next-url (&optional back wrap) @@ -271,55 +370,41 @@ Actual search is done by `ffap-next-guess'." (ffap-next back wrap)))) -;;; Remote machines and paths: - -(defun ffap-replace-path-component (fullname name) - "In remote FULLNAME, replace path with NAME. May return nil." - ;; Use ange-ftp or efs if loaded, but do not load them otherwise. - (let (found) - (mapcar - (function (lambda (sym) (and (fboundp sym) (setq found sym)))) - '( - efs-replace-path-component - ange-ftp-replace-path-component - ange-ftp-replace-name-component - )) - (and found - (fset 'ffap-replace-path-component found) - (funcall found fullname name)))) -;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new") - -(defun ffap-file-exists-string (file) - ;; With certain packages (ange-ftp, jka-compr?) file-exists-p - ;; sometimes returns a nicer string than it is given. Otherwise, it - ;; just returns nil or t. - "Return FILE \(maybe modified\) if it exists, else nil." - (and file ; quietly reject nil - (let ((exists (file-exists-p file))) - (and exists (if (stringp exists) exists file))))) +;;; Machines (`ffap-machine-p'): ;; I cannot decide a "best" strategy here, so these are variables. In ;; particular, if `Pinging...' is broken or takes too long on your ;; machine, try setting these all to accept or reject. -(defvar ffap-machine-p-local 'reject ; this happens often - "*A symbol, one of: ping, accept, reject. -What `ffap-machine-p' does with hostnames that have no domain.") -(defvar ffap-machine-p-known 'ping ; 'accept for speed - "*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. -What `ffap-machine-p' does with hostnames that have an unknown domain -\(see mail-extr.el for the known domains\).") +(defcustom ffap-machine-p-local 'reject ; this happens often + "*What `ffap-machine-p' does with hostnames that have no domain. +Value should be a symbol, one of `ping', `accept', and `reject'." + :type '(choice (const ping) + (const accept) + (const reject)) + :group 'ffap) +(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed + "*What `ffap-machine-p' does with hostnames that have a known domain. +Value should be a symbol, one of `ping', `accept', and `reject'. +See `mail-extr.el' for the known domains." + :type '(choice (const ping) + (const accept) + (const reject)) + :group 'ffap) +(defcustom ffap-machine-p-unknown 'reject + "*What `ffap-machine-p' does with hostnames that have an unknown domain. +Value should be a symbol, one of `ping', `accept', and `reject'. +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) - (defvar mail-extr-all-top-level-domains - (ffap-soft-value "all-top-level-domains" obarray)) ; XEmacs, old Emacs - (get (intern-soft (downcase domain) mail-extr-all-top-level-domains) - 'domain-name)) + (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains") + (ffap-soft-value "all-top-level-domains")))) ; XEmacs + (and ob (get (intern-soft (downcase domain) ob) 'domain-name)))) (defun ffap-machine-p (host &optional service quiet strategy) "Decide whether HOST is the name of a real, reachable machine. @@ -355,6 +440,7 @@ Returned values: (cond ((eq strategy 'accept) 'accept) ((eq strategy 'reject) nil) + ((not (fboundp 'open-network-stream)) nil) ;; assume (eq strategy 'ping) (t (or quiet @@ -388,15 +474,66 @@ Returned values: ;; Could be "Unknown service": (t (signal (car error) (cdr error)))))))))))) + +;;; Possibly Remote Resources: + +(defun ffap-replace-file-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-file-component found) + (funcall found fullname name)))) +;; (ffap-replace-file-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 the file 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\)." + "If FILENAME looks remote, return it (maybe slightly improved)." ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") - ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path") + ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir") ;; (ffap-file-remote-p "/ffap.el:80") (or (and ffap-ftp-regexp (string-match ffap-ftp-regexp filename) - ;; Convert "/host.com://path" to "/host:/path", to handle a dieing - ;; practice of advertising ftp paths as "host.dom://path". + ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing + ;; practice of advertising ftp files as "host.dom://filename". (if (string-match "//" filename) ;; (replace-match "/" nil nil filename) (concat (substring filename 0 (1+ (match-beginning 0))) @@ -411,16 +548,20 @@ Returned values: (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:\". +(defsubst ffap-host-to-filename (host) + "Convert HOST to something like \"/USER@HOST:\" or \"/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 ":"))) + (if (equal host "localhost") + "" + (let ((user ffap-ftp-default-user)) + ;; Avoid including the user if it is same as default: + (if (or (equal user (ffap-soft-value "ange-ftp-default-user")) + (equal user (ffap-soft-value "efs-default-user"))) + (setq user nil)) + (concat "/" user (and user "@") host ":")))) (defun ffap-fixup-machine (mach) - ;; Convert a hostname into an url, an ftp path, or nil. + ;; Convert a hostname into an url, an ftp file name, or nil. (cond ((not (and ffap-url-regexp (stringp mach))) nil) ;; gopher.well.com @@ -430,9 +571,15 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) (concat "http://" mach "/")) ;; More cases? Maybe "telnet:" for archie? - (ffap-ftp-regexp (ffap-host-to-path mach)) + (ffap-ftp-regexp (ffap-host-to-filename mach)) )) +(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" + "Strings not matching this fail `ffap-newsgroup-p'.") +(defvar ffap-newsgroup-heads ; entirely inadequate + '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk") + "Used by `ffap-newsgroup-p' if gnus is not running.") + (defun ffap-newsgroup-p (string) "Return STRING if it looks like a newsgroup name, else nil." (and @@ -446,7 +593,8 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (progn ;; errs: htb symbol may be unbound, or not a hash-table. ;; gnus-gethash is just a macro for intern-soft. - (and (intern-soft string (symbol-value htb)) + (and (symbol-value htb) + (intern-soft string (symbol-value htb)) (setq ret string htbs nil)) ;; If we made it this far, gnus is running, so ignore "heads": (setq heads nil)) @@ -458,11 +606,6 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (setq ret string)))) ;; Is there ever a need to modify string as a newsgroup name? ret))) -(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" - "Strings not matching this fail `ffap-newsgroup-p'.") -(defvar ffap-newsgroup-heads ; entirely inadequate - '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk") - "Used by `ffap-newsgroup-p' if gnus is not running.") (defsubst ffap-url-p (string) "If STRING looks like an url, return it (maybe improved), else nil." @@ -480,7 +623,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." "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))) + (ffap-host-to-filename (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") @@ -491,34 +634,34 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) ((and ffap-url-unwrap-remote ffap-ftp-regexp (ffap-url-unwrap-remote url))) - ;; 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))) -;;; `ffap-alist': +;;; File Name Handling: ;; -;; Search actions depending on the major-mode or extensions of the -;; current name. Note all the little defun's could be broken out, at -;; some loss of locality. A good example of featuritis. - -;; First, some helpers for functions in `ffap-alist': - -(defvar path-separator ":") ; for XEmacs 19.13 +;; The upcoming ffap-alist actions need various utilities to prepare +;; and search 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 path envinronment variable ENV. -Optional EMPTY is default if (getenv ENV) is undefined, and is also -substituted for the first empty-string component, if there is one. -Uses `path-separator' to separate the path into directories." - ;; Derived from psg-list-env in RHOGEE's ff-paths and - ;; bib-cite packages. The `empty' argument is intended to mimic - ;; the semantics of TeX/BibTeX variables, it is substituted for - ;; any empty string entry. + "Return a list of strings parsed from environment variable ENV. +Optional EMPTY is the default list if \(getenv ENV\) is undefined, and +also is substituted for the first empty-string component, if there is one. +Uses `path-separator' to separate the path into substrings." + ;; We cannot use parse-colon-path (files.el), since it kills + ;; "//" entries using file-name-as-directory. + ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env + ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea. (if (or empty (getenv env)) ; should return something (let ((start 0) match dir ret) (setq env (concat (getenv env) path-separator)) @@ -528,7 +671,7 @@ Uses `path-separator' to separate the path into directories." (setq ret (cons dir ret))) (setq ret (nreverse ret)) (and empty (setq match (member "" ret)) - (progn + (progn ; allow string or list here (setcdr match (append (cdr-safe empty) (cdr match))) (setcar match (or (car-safe empty) empty)))) ret))) @@ -544,152 +687,119 @@ Uses `path-separator' to separate the path into directories." (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) +(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 override 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))) + (let ((suffixes-to-try + (cond + ((consp nosuffix) nosuffix) + (nosuffix '("")) + (t '(".elc" ".el" "")))) + suffixes try found) (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))) + (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)) + + +;;; 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) - (locate-library - 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) (locate-library 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)) - (locate-library name '(".el"))))) - '(finder-mode . ffap-el-mode) ; v19: {C-h p} - '(help-mode . ffap-el-mode) ; v19.29 - (cons 'c-mode - (progn - ;; Need better defaults here! - (defvar ffap-c-path '("/usr/include" "/usr/local/include")) - (defun ffap-c-mode (name) - (locate-library name t ffap-c-path)))) - '(c++-mode . ffap-c-mode) - '(cc-mode . ffap-c-mode) - '("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) - (cons 'tex-mode - ;; Complicated because auctex may not be loaded yet. - (progn - (defvar ffap-tex-path - t ; delayed initialization - "Path where `ffap-tex-mode' looks for tex files. -If t, `ffap-tex-init' will initialize this when needed.") - (defun ffap-tex-init nil - ;; Compute ffap-tex-path if it is now t. - (and (eq t ffap-tex-path) - (message "Initializing ffap-tex-path ...") - (setq ffap-tex-path - (ffap-reduce-path - (append - (list ".") - (ffap-list-env "TEXINPUTS") - ;; (ffap-list-env "BIBINPUTS") - (ffap-add-subdirs - (ffap-list-env "TEXINPUTS_SUBDIR" - (ffap-soft-value - "TeX-macro-global" - '("/usr/local/lib/tex/macros" - "/usr/local/lib/tex/inputs") - )))))))) - (defun ffap-tex-mode (name) - (ffap-tex-init) - (locate-library name '(".tex" "") ffap-tex-path)))) - (cons 'latex-mode - (defun ffap-latex-mode (name) - (ffap-tex-init) - ;; Any real need for "" here? - (locate-library name '(".cls" ".sty" ".tex" "") - ffap-tex-path))) - (cons "\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" - (defun ffap-tex (name) - (ffap-tex-init) - (locate-library name t ffap-tex-path))) - (cons "\\.bib\\'" - (defun ffap-bib (name) - (locate-library - 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))))) - (locate-library - name '(".m" "") (ffap-soft-value "Mathematica-search-path")))) - (cons "\\`\\." (defun ffap-home (name) (locate-library name t '("~")))) - (cons "\\`~/" - ;; Maybe a "Lisp Code Directory" reference: - (defun ffap-lcd (name) - (and - (or - ;; lisp-dir-apropos output buffer: - (string-match "Lisp Code Dir" (buffer-name)) - ;; Inside an LCD entry like |~/misc/ffap.el.Z|, - ;; or maybe the holy LCD-Datafile itself: - (member (ffap-string-around) '("||" "|\n"))) - (concat - ;; lispdir.el may not be loaded yet: - (ffap-host-to-path - (ffap-soft-value "elisp-archive-host" - "archive.cis.ohio-state.edu")) - (file-name-as-directory - (ffap-soft-value "elisp-archive-directory" - "/pub/gnu/emacs/elisp-archive/")) - (substring name 2))))) - (cons "^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ - (progn - (defvar ffap-rfc-path - (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt")) - (defun ffap-rfc (name) - (format ffap-rfc-path - (substring name (match-beginning 1) (match-end 1)))))) - (cons "\\`[^/]*\\'" - (defun ffap-dired (name) - (let ((pt (point)) dir try) - (save-excursion - (and (progn - (beginning-of-line) - (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] ")) - (re-search-backward "^ *$" nil t) - (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t) - (file-exists-p - (setq try - (expand-file-name - name - (buffer-substring - (match-beginning 1) (match-end 1))))) - try))))) - ) + '( + ("" . ffap-completable) ; completion, slow on some systems + ("\\.info\\'" . ffap-info) ; gzip.info + ("\\`info/" . ffap-info-2) ; info/emacs + ("\\`[-a-z]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses] + ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc + (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom + ;; (lisp-interaction-mode . ffap-el-mode) ; maybe + (finder-mode . ffap-el-mode) ; type {C-h p} and try it + (help-mode . ffap-el-mode) ; maybe useful + (c++-mode . ffap-c-mode) ; search ffap-c-path + (cc-mode . ffap-c-mode) ; same + ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h + (fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB + ("\\.[fF]\\'" . ffap-fortran-mode) + (tex-mode . ffap-tex-mode) ; search ffap-tex-path + (latex-mode . ffap-latex-mode) ; similar + ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex) + ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path + ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile + ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| + ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ + . ffap-rfc) ; "100% RFC2100 compliant" + (dired-mode . ffap-dired) ; maybe in a subdirectory + ) "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'. If string NAME at point (maybe \"\") is not a file or url, these pairs specify actions to try creating such a string. A pair matches if either @@ -700,6 +810,155 @@ 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)) + + +;;; 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-filename + (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-filename "ds.internic.net") "/rfc/rfc%s.txt")) + +(defun ffap-rfc (name) + (format ffap-rfc-path + (substring name (match-beginning 1) (match-end 1)))) + ;;; At-Point Functions: @@ -709,9 +968,9 @@ url, or nil. If nil, search the alist for further matches.") ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) - (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") + (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: - (url "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?") + (url "--:=&?$+@-Z_a-z~#,%;*" "^A-Za-z0-9" ":;.,!?") ;; Find a string that does *not* contain a colon: (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?") ;; A machine: @@ -720,25 +979,23 @@ url, or nil. If nil, search the alist for further matches.") (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:") ) "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\). +possibly a major-mode name, or one of the symbol +`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'.") - (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 mode) "Return a string of characters from around point. -MODE (defaults to `major-mode') is a symbol used to lookup string +MODE (defaults to value of `major-mode') is a symbol used to look up string syntax parameters in `ffap-string-at-point-mode-alist'. -If MODE is not found, we fall back on the symbol 'file. +If MODE is not found, we use `file' instead of MODE. +If the region is active, return a string from the region. Sets `ffap-string-at-point' and `ffap-string-at-point-region'." (let* ((args (cdr @@ -746,16 +1003,20 @@ Sets `ffap-string-at-point' and `ffap-string-at-point-region'." (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)) + (if (and transient-mark-mode mark-active) + (buffer-substring + (setcar ffap-string-at-point-region (region-beginning)) + (setcar (cdr ffap-string-at-point-region) (region-end))) + (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 @@ -788,28 +1049,24 @@ Assumes the buffer has not changed." ;; Could use w3's url-get-url-at-point instead. Both handle "URL:", ;; ignore non-relative links, trim punctuation. The other will ;; actually look back if point is in whitespace, but I would rather - ;; ffap be non-rabid in such situations. + ;; 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 'url))) - ;; (case-fold-search t), why? (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-at-bar-prefix'. + ;; Without "<>" it must be "mailto". Otherwise could be + ;; either, so consult `ffap-foo-at-bar-prefix'. (let ((prefix (if (and (equal (ffap-string-around) "<>") - ;; At least a couple of odd characters: + ;; Expect some odd characters: (string-match "[$.0-9].*[$.0-9].*@" name)) ;; Could be news: ffap-foo-at-bar-prefix @@ -868,7 +1125,7 @@ The two subexpressions are the KEY and VALUE.") ;; Icky regexp avoids: default: 123: foo::bar cs:pub ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end) "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)") - "Strings matching this are coerced to ftp paths by ffap. + "Strings matching this are coerced to ftp file names by ffap. That is, ffap just prepends \"/\". Set to nil to disable.") (defun ffap-file-at-point nil @@ -878,7 +1135,7 @@ 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 ;; filenames. On the other hand, it is responsible for converting - ;; a pseudo-url "site.com://path" to an ftp path + ;; a pseudo-url "site.com://dir" to an ftp file name (let* ((case-fold-search t) ; url prefixes are case-insensitive (data (match-data)) (string (ffap-string-at-point)) ; uses mode alist @@ -892,15 +1149,23 @@ which may actually result in an url rather than a filename." (default-directory default-directory)) (unwind-protect (cond - ;; Immediate rejects (/ and // are too common in C++): - ((member name '("" "/" "//")) nil) - ;; Immediately test local filenames. If default-directory is - ;; remote, you probably already have a connection. - ((and (not abs) (ffap-file-exists-string name))) + ;; Immediate rejects (/ and // and /* are too common in C/C++): + ((member name '("" "/" "//" "/*" ".")) nil) + ;; Immediately test local filenames. If default-directory is + ;; remote, you probably already have a connection. + ((and (not abs) (ffap-file-exists-string name))) + ;; Try stripping off line numbers; good for compilation/grep output. + ((and (not abs) (string-match ":[0-9]" name) + (ffap-file-exists-string (substring name 0 (match-beginning 0))))) + ;; Try stripping off prominent (non-root - #) shell prompts + ;; if the ffap-shell-prompt-regexp is non-nil. + ((and ffap-shell-prompt-regexp + (not abs) (string-match ffap-shell-prompt-regexp name) + (ffap-file-exists-string (substring name (match-end 0))))) ;; Accept remote names without actual checking (too slow): ((if abs (ffap-file-remote-p name) - ;; Try adding a leading "/" (common omission in ftp paths): + ;; Try adding a leading "/" (common omission in ftp file names): (and ffap-ftp-sans-slash-regexp (string-match ffap-ftp-sans-slash-regexp name) @@ -918,7 +1183,10 @@ which may actually result in an url rather than a filename." (if (or (eq major-mode (car tem)) (and (stringp (car tem)) (string-match (car tem) name))) - (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) @@ -926,7 +1194,7 @@ which may actually result in an url rather than a filename." try)) ;; Alist failed? Try to guess an active remote connection ;; from buffer variables, and try once more, both as an - ;; absolute and relative path on that remote host. + ;; absolute and relative file name on that remote host. ((let* (ffap-rfs-regexp ; suppress (remote-dir (cond @@ -944,15 +1212,28 @@ which may actually result in an url rather than a filename." (or (and (string-match "\\`\\(/?~?ftp\\)/" name) (ffap-file-exists-string - (ffap-replace-path-component + (ffap-replace-file-component remote-dir (substring name (match-end 1))))) (ffap-file-exists-string - (ffap-replace-path-component remote-dir name)))))) + (ffap-replace-file-component remote-dir name)))))) + ((and ffap-dired-wildcards + (string-match ffap-dired-wildcards name) + abs + (ffap-file-exists-string (file-name-directory + (directory-file-name name))) + name)) + ;; Try all parent directories by deleting the trailing directory + ;; name until existing directory is found or name stops changing + ((let ((dir name)) + (while (and dir + (not (ffap-file-exists-string dir)) + (not (equal dir (setq dir (file-name-directory + (directory-file-name dir))))))) + (ffap-file-exists-string dir))) ) - (store-match-data data)))) - + (set-match-data data)))) -;;; ffap-read-file-or-url: +;;; Prompting (`ffap-read-file-or-url'): ;; ;; We want to complete filenames as in read-file-name, but also url's ;; which read-file-name-internal would truncate at the "//" string. @@ -969,17 +1250,21 @@ which may actually result in an url rather than a filename." (or (ffap-url-p guess) (progn (or (ffap-file-remote-p guess) - (setq guess (abbreviate-file-name (expand-file-name guess)))) + (setq guess + (abbreviate-file-name (expand-file-name guess)) + )) (setq dir (file-name-directory guess)))) - (setq guess - (completing-read - prompt - 'ffap-read-file-or-url-internal - dir - nil - (if dir (cons guess (length dir)) guess) - (list 'file-name-history) - )) + (let ((minibuffer-completing-file-name t)) + (setq guess + (completing-read + prompt + 'ffap-read-file-or-url-internal + dir + nil + (if dir (cons guess (length dir)) guess) + (list 'file-name-history) + (and buffer-file-name + (abbreviate-file-name buffer-file-name))))) ;; 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. @@ -999,6 +1284,10 @@ which may actually result in an url rather than a filename." (t t)))) (defun ffap-read-file-or-url-internal (string dir action) + (unless dir + (setq dir default-directory)) + (unless string + (setq string default-directory)) (if (ffap-url-p string) (ffap-read-url-internal string dir action) (read-file-name-internal string dir action))) @@ -1007,9 +1296,7 @@ which may actually result in an url rather than a filename." ;; 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. +;; will do filename style completion. (defun ffap-complete-as-file-p nil ;; Will `minibuffer-completion-table' complete the minibuffer @@ -1017,33 +1304,24 @@ which may actually result in an url rather than a filename." ;; 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 minibuffer-completing-file-name '(t)))) ;list (and (featurep 'complete) (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)))) + (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p))) -;;; Highlighting: +;;; Highlighting (`ffap-highlight'): ;; ;; Based on overlay highlighting in Emacs 19.28 isearch.el. -(defvar ffap-highlight (and window-system t) +(defvar ffap-highlight t "If non-nil, ffap highlights the current buffer substring.") -(defvar ffap-highlight-overlay nil "Overlay used by `ffap-highlight'.") +(defvar ffap-highlight-overlay nil + "Overlay used by `ffap-highlight'.") (defun ffap-highlight (&optional remove) "If `ffap-highlight' is set, highlight the guess in this buffer. @@ -1051,24 +1329,28 @@ That is, the last buffer substring found by `ffap-string-at-point'. Optional argument REMOVE means to remove any such highlighting. Uses the face `ffap' if it is defined, or else `highlight'." (cond - (remove (and ffap-highlight-overlay (delete-overlay ffap-highlight-overlay))) + (remove + (and ffap-highlight-overlay + (delete-overlay ffap-highlight-overlay)) + ) ((not ffap-highlight) nil) (ffap-highlight-overlay - (move-overlay ffap-highlight-overlay - (car ffap-string-at-point-region) - (nth 1 ffap-string-at-point-region) - (current-buffer))) + (move-overlay + ffap-highlight-overlay + (car ffap-string-at-point-region) + (nth 1 ffap-string-at-point-region) + (current-buffer))) (t - (setq ffap-highlight-overlay (apply 'make-overlay ffap-string-at-point-region)) + (setq ffap-highlight-overlay + (apply 'make-overlay ffap-string-at-point-region)) (overlay-put ffap-highlight-overlay 'face - (if (internal-find-face 'ffap nil) - 'ffap 'highlight))))) + (if (facep 'ffap) 'ffap 'highlight))))) -;;; 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." + "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)))) @@ -1079,21 +1361,25 @@ Uses the face `ffap' if it is defined, or else `highlight'." ;; Does guess and prompt step for find-file-at-point. ;; Extra complication for the temporary highlighting. (unwind-protect - (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 for latest version." (interactive) @@ -1108,10 +1394,16 @@ See for latest version." ((ffap-url-p 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 + ((and ffap-pass-wildcards-to-dired + ffap-dired-wildcards (string-match ffap-dired-wildcards filename)) - (dired filename)) + (funcall ffap-directory-finder filename)) + ((and ffap-dired-wildcards + (string-match ffap-dired-wildcards filename) + find-file-wildcards + ;; Check if it's find-file that supports wildcards arg + (memq ffap-file-finder '(find-file find-alternate-file))) + (funcall ffap-file-finder (expand-file-name filename) t)) ((or (not ffap-newfile-prompt) (file-exists-p filename) (y-or-n-p "File does not exist, create buffer? ")) @@ -1123,32 +1415,26 @@ See for latest version." "no such file or directory" filename)))))) -;; M-x shortcut: -;;###autoload +;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. +;;;###autoload (defalias 'ffap 'find-file-at-point) -;;; Menu support: -;; -;; Bind ffap-menu to a key if you want, since it also works in tty mode. -;; Or just use it through the ffap-at-mouse binding (next section). +;;; Menu support (`ffap-menu'): (defvar ffap-menu-regexp nil "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'. Make this more restrictive for faster menu building. -For example, try \":/\" for url (and some ftp) references.") +For example, try \":/\" for URL (and some ftp) references.") (defvar ffap-menu-alist nil "Buffer local cache of menu presented by `ffap-menu'.") (make-variable-buffer-local 'ffap-menu-alist) (defvar ffap-menu-text-plist - (and window-system - ;; These choices emulate goto-addr: - (if ffap-xemacs - '(face bold highlight t) ; keymap - '(face bold mouse-face highlight) ; keymap - )) + (cond + ((display-mouse-p) '(face bold mouse-face highlight)) ; keymap + (t nil)) "Text properties applied to strings found by `ffap-menu-rescan'. These properties may be used to fontify the menu references.") @@ -1190,70 +1476,74 @@ a rebuild. Searches with `ffap-menu-regexp'." (defun ffap-menu-ask (title alist cont) "Prompt from a menu of choices, and then apply some action. -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\) ALIST entry defines a choice \(data is ignored\). -Once the user makes a choice, function CONT is applied to the entry. -Always returns nil." - ;; Bug: minibuffer prompting assumes the strings are unique. - (let ((choice - (if (and (fboundp 'x-popup-menu) ; Emacs 19 or XEmacs 19.13 - (boundp 'last-nonmenu-event) ; not in XEmacs 19.13 - (listp last-nonmenu-event)) - (x-popup-menu - t - (list "" - (cons title - (mapcar - (function (lambda (i) (cons (car i) i))) - alist)))) - ;; Immediately popup completion buffer: - (prog1 - (let ((minibuffer-setup-hook 'minibuffer-completion-help)) - ;; BUG: this code assumes that "" is not a valid choice - (completing-read - (format "%s (default %s): " title (car (car alist))) - alist nil t - ;; (cons (car (car alist)) 0) - nil - )) - ;; Redraw original screen: - (sit-for 0))))) - ;; Defaulting: convert "" to (car (car alist)) - (and (equal choice "") (setq choice (car (car alist)))) - (and (stringp choice) (setq choice (assoc choice alist))) - (if choice (funcall cont choice) (message "No choice made!"))) - nil) ; return nothing +Each ALIST entry looks like (STRING . DATA) and defines one 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)) - ) + '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)))) + (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))) @@ -1264,56 +1554,125 @@ Applies `ffap-menu-text-plist' text properties at all matches." (lambda (a b) (< (cdr a) (cdr b))))))) -;;; Mouse Support: +;;; Mouse Support (`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 at click. -A command symbol, or nil for nothing.") +(defvar ffap-at-mouse-fallback nil ; ffap-menu? too time-consuming + "Command invoked by `ffap-at-mouse' if nothing found at click, or nil. +Ignored when `ffap-at-mouse' is called programmatically.") (put 'ffap-at-mouse-fallback 'risky-local-variable t) +;;;###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 + ))) -;;; ffap-other-* commands -;; Suggested by KPC. +;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands: + +;; 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)))) + (let (value) + (switch-to-buffer-other-window + (save-window-excursion + (setq value (call-interactively 'ffap)) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) + (current-buffer))) + value)) (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) + ;; Extra code works around dedicated windows (noted by JENS, 7/96): + (let* ((win (selected-window)) + (wdp (window-dedicated-p win)) + value) + (unwind-protect + (progn + (set-window-dedicated-p win nil) + (switch-to-buffer-other-frame + (save-window-excursion + (setq value (call-interactively 'ffap)) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) + (current-buffer)))) + (set-window-dedicated-p win wdp)) + value)) + +(defun ffap-read-only () + "Like `ffap', but mark buffer as read-only. +Only intended for interactive use." + (interactive) + (let ((value (call-interactively 'ffap))) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-read-only-other-window () + "Like `ffap', but put buffer in another window and mark as read-only. +Only intended for interactive use." + (interactive) + (let ((value (ffap-other-window))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-read-only-other-frame () + "Like `ffap', but put buffer in another frame and mark as read-only. +Only intended for interactive use." (interactive) - (switch-to-buffer-other-frame - (save-window-excursion (call-interactively 'ffap) (current-buffer)))) + (let ((value (ffap-other-frame))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-alternate-file () + "Like `ffap' and `find-alternate-file'. +Only intended for interactive use." + (interactive) + (let ((ffap-file-finder 'find-alternate-file)) + (call-interactively 'ffap))) ;;; Bug Reporter: @@ -1328,7 +1687,7 @@ If none is found, call `ffap-at-mouse-fallback'." (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report "Michelangelo Grigni " - "ffap 1.6" + "ffap" (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) (fset 'ffap-submit-bug 'ffap-bug) ; another likely name @@ -1377,59 +1736,150 @@ If none is found, call `ffap-at-mouse-fallback'." (interactive) (ffap-gnus-wrapper '(ffap-menu))) -;;; ffap-bindings: offer default global bindings +(defcustom dired-at-point-require-prefix nil + "*If set, reverses the prefix argument to `dired-at-point'. +This is nil so neophytes notice ffap. Experts may prefer to disable +ffap most of the time." + :type 'boolean + :group 'ffap + :version "20.3") + +;;;###autoload +(defun dired-at-point (&optional filename) + "Start Dired, defaulting to file at point. See `ffap'." + (interactive) + (if (and (interactive-p) + (if dired-at-point-require-prefix + (not current-prefix-arg) + current-prefix-arg)) + (let (current-prefix-arg) ; already interpreted + (call-interactively ffap-directory-finder)) + (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)) + (funcall ffap-directory-finder filename)) + ((file-exists-p filename) + (if (file-directory-p filename) + (funcall ffap-directory-finder + (expand-file-name filename)) + (funcall ffap-directory-finder + (concat (expand-file-name filename) "*")))) + ((and (file-writable-p + (or (file-name-directory (directory-file-name filename)) + filename)) + (y-or-n-p "Directory does not exist, create it? ")) + (make-directory filename) + (funcall ffap-directory-finder 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 + (let ((guess (ffap-guesser))) + (if (or (not guess) + (ffap-url-p guess) + (ffap-file-remote-p guess)) + guess + (setq guess (abbreviate-file-name + (expand-file-name guess))) + (cond + ;; Interpret local directory as a directory. + ((file-directory-p guess) + (file-name-as-directory guess)) + ;; Get directory component from local files. + ((file-regular-p guess) + (file-name-directory guess)) + (guess)))) + )) + (and guess (ffap-highlight)))) + (ffap-highlight t))) + +;;; ffap-dired-other-*, ffap-list-directory commands: + +(defun ffap-dired-other-window () + "Like `dired-at-point', but put buffer in another window. +Only intended for interactive use." + (interactive) + (let (value) + (switch-to-buffer-other-window + (save-window-excursion + (setq value (call-interactively 'dired-at-point)) + (current-buffer))) + value)) + +(defun ffap-dired-other-frame () + "Like `dired-at-point', but put buffer in another frame. +Only intended for interactive use." + (interactive) + ;; Extra code works around dedicated windows (noted by JENS, 7/96): + (let* ((win (selected-window)) + (wdp (window-dedicated-p win)) + value) + (unwind-protect + (progn + (set-window-dedicated-p win nil) + (switch-to-buffer-other-frame + (save-window-excursion + (setq value (call-interactively 'dired-at-point)) + (current-buffer)))) + (set-window-dedicated-p win wdp)) + value)) + +(defun ffap-list-directory () + "Like `dired-at-point' and `list-directory'. +Only intended for interactive use." + (interactive) + (let ((ffap-directory-finder 'list-directory)) + (call-interactively 'dired-at-point))) + + +;;; Offer default global bindings (`ffap-bindings'): (defvar ffap-bindings - (nconc - (cond - ((not (eq window-system 'x)) - nil) - ;; GNU coding standards say packages should not bind S-mouse-*. - ;; Is it ok to simply suggest such a binding to the user? - (ffap-xemacs - '((global-set-key '(shift button3) 'ffap-at-mouse))) - (t - '((global-set-key [S-down-mouse-3] 'ffap-at-mouse)))) '( + (global-set-key [S-mouse-3] 'ffap-at-mouse) + (global-set-key [C-S-mouse-3] 'ffap-menu) + (global-set-key "\C-x\C-f" 'find-file-at-point) + (global-set-key "\C-x\C-r" 'ffap-read-only) + (global-set-key "\C-x\C-v" 'ffap-alternate-file) + (global-set-key "\C-x4f" 'ffap-other-window) (global-set-key "\C-x5f" 'ffap-other-frame) + (global-set-key "\C-x4r" 'ffap-read-only-other-window) + (global-set-key "\C-x5r" 'ffap-read-only-other-frame) + + (global-set-key "\C-xd" 'dired-at-point) + (global-set-key "\C-x4d" 'ffap-dired-other-window) + (global-set-key "\C-x5d" 'ffap-dired-other-frame) + (global-set-key "\C-x\C-d" 'ffap-list-directory) + (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) + ) + "List of binding forms evaluated by function `ffap-bindings'. +A reasonable ffap installation needs just this one line: (ffap-bindings) -These are only suggestions, they may be modified or ignored.") +Of course if you do not like these bindings, just roll your own!") +;;;###autoload (defun ffap-bindings nil "Evaluate the forms in variable `ffap-bindings'." + (interactive) (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")) - +;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc ;;; ffap.el ends here