# HG changeset patch # User Karl Heuer # Date 867533238 0 # Node ID 83ff1ecdb0e3d807fbbe0e8f832c872bcbd5e302 # Parent d6e8b92585e9fb161bd9210e7f45efc5eff93b12 XEmacs compatibility hacks cleaned up. (ffap-url-fetcher): If `browse-url' is bound, use that. (ffap-locate-file): New optional arg dir-ok. (ffap-at-mouse): Fix return value. diff -r d6e8b92585e9 -r 83ff1ecdb0e3 lisp/ffap.el --- a/lisp/ffap.el Sat Jun 28 07:56:29 1997 +0000 +++ b/lisp/ffap.el Sat Jun 28 21:27:18 1997 +0000 @@ -5,7 +5,8 @@ ;; Author: Michelangelo Grigni ;; Created: 29 Mar 1993 ;; Keywords: files, hypermedia, matching, mouse -;; X-URL: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ +;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ +;; X-Source: this file is generated from ffap.epp ;; This file is part of GNU Emacs. @@ -67,10 +68,10 @@ ;; (setq ffap-machine-p-known 'accept) ; no pinging ;; (setq ffap-url-regexp nil) ; disable URL features in ffap ;; -;; ffap uses w3 (if found) or else browse-url to fetch URL's. For -;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). +;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's. +;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify -;; the file and URL references within a buffer. +;; the file and URL references within a buffer. ;;; Change Log: @@ -97,17 +98,22 @@ (provide 'ffap) +;; Please do not delete this variable, it is checked in bug reports. +(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>" + "The version of ffap: \"Major.Minor-Build \"") + + +(defgroup ffap nil + "Find file or URL at point." + :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/") + :group 'matching) + ;; The code is organized in pages, separated by formfeed characters. ;; See the next two pages for standard customization ideas. ;;; User Variables: -(defgroup ffap nil - "Find file or URL at point." - :group 'matching) - - (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)." @@ -218,16 +224,17 @@ (put 'ffap-file-finder 'risky-local-variable t) (defcustom ffap-url-fetcher - (cond ((fboundp 'w3-fetch) 'w3-fetch) - ((fboundp 'browse-url-netscape) 'browse-url-netscape) - (t 'w3-fetch)) + (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) @@ -235,18 +242,16 @@ (put 'ffap-url-fetcher 'risky-local-variable t) -;;; Compatibility (XEmacs code suppressed in this version): +;;; 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. -(progn - (defalias 'ffap-make-overlay 'make-overlay) - (defalias 'ffap-delete-overlay 'delete-overlay) ; reusable - (defalias 'ffap-move-overlay 'move-overlay) - (defalias 'ffap-overlay-put 'overlay-put) ; 'face - (defalias 'ffap-find-face 'internal-find-face) - (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)))) - ) +(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'): @@ -355,8 +360,9 @@ (defun ffap-what-domain (domain) ;; Like what-domain in mail-extr.el, returns string or nil. (require 'mail-extr) - (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. @@ -444,15 +450,37 @@ (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))))) +(defun ffap-file-suffix (file) + "Return trailing \".foo\" suffix of FILE, or nil if none." + (let ((pos (string-match "\\.[^./]*\\'" file))) + (and pos (substring file pos nil)))) + +(defvar ffap-compression-suffixes '(".gz" ".Z") ; .z is mostly dead + "List of suffixes tried by `ffap-file-exists-string'.") +(defun ffap-file-exists-string (file &optional nomodify) + ;; Early jka-compr versions modified file-exists-p to return the + ;; filename, maybe modified by adding a suffix like ".gz". That + ;; broke the interface of file-exists-p, so it was later dropped. + ;; Here we document and simulate the old behavior. + "Return FILE \(maybe modified\) if it exists, else nil. +When using jka-compr (a.k.a. `auto-compression-mode'), the returned +name may have a suffix added from `ffap-compression-suffixes'. +The optional NOMODIFY argument suppresses the extra search." + (cond + ((not file) nil) ; quietly reject nil + ((file-exists-p file) file) ; try unmodified first + ;; three reasons to suppress search: + (nomodify nil) + ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil) + ((member (ffap-file-suffix file) ffap-compression-suffixes) nil) + (t ; ok, do the search + (let ((list ffap-compression-suffixes) try ret) + (while list + (if (file-exists-p (setq try (concat file (car list)))) + (setq ret try list nil) + (setq list (cdr list)))) + ret)))) (defun ffap-file-remote-p (filename) "If FILENAME looks remote, return it \(maybe slightly improved\)." @@ -562,12 +590,9 @@ ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) ((and ffap-url-unwrap-remote ffap-ftp-regexp (ffap-url-unwrap-remote url))) - ;; This might autoload the url package, oh well: - (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))) ;;; Path Handling: @@ -659,24 +684,23 @@ (list dir)))) path))) -(defvar ffap-locate-jka-suffixes t - "List of compression suffixes tried by `ffap-locate-file'. - -If not a list, it will be initialized by `ffap-locate-file', depending -on whether you use jka-compr (a.k.a. `auto-compression-mode'). -Typical values are nil or '(\".gz\" \".Z\").") ; .z is dead - -(defun ffap-locate-file (file &optional nosuffix path) - ;; Note the Emacs 20 version of locate-library could almost - ;; replace this function, except that it does not let us overrride - ;; the list of suffixes. +(defun ffap-locate-file (file &optional nosuffix path dir-ok) + ;; The Emacs 20 version of locate-library could almost replace this, + ;; except it does not let us overrride the suffix list. The + ;; compression-suffixes search moved to ffap-file-exists-string. "A generic path-searching function, mimics `load' by default. Returns path to file that \(load FILE\) would load, or nil. Optional NOSUFFIX, if nil or t, is like the fourth argument for load: whether to try the suffixes (\".elc\" \".el\" \"\"). If a nonempty list, it is a list of suffixes to try instead. -Optional PATH is a list of directories instead of `load-path'." +Optional 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))) @@ -684,36 +708,19 @@ (cond ((consp nosuffix) nosuffix) (nosuffix '("")) - (t '(".elc" ".el" ""))))) - ;; Note we no longer check for old versions of jka-compr, that - ;; would aggressively try to convert any foo to foo.gz. - (or (listp ffap-locate-jka-suffixes) - (setq ffap-locate-jka-suffixes - (and (rassq 'jka-compr-handler file-name-handler-alist) - '(".gz" ".Z")))) ; ".z" is dead, "" is implicit - (if ffap-locate-jka-suffixes ; - (setq suffixes-to-try - (apply 'nconc - (mapcar - (function - (lambda (suf) - (cons suf - (mapcar - (function (lambda (x) (concat suf x))) - ffap-locate-jka-suffixes)))) - suffixes-to-try)))) - (let (found suffixes) - (while (and path (not found)) - (setq suffixes suffixes-to-try) - (while (and suffixes (not found)) - (let ((try (expand-file-name - (concat file (car suffixes)) - (car path)))) - (if (and (file-exists-p try) (not (file-directory-p try))) - (setq found try))) - (setq suffixes (cdr suffixes))) - (setq path (cdr path))) - found))) + (t '(".elc" ".el" "")))) + suffixes try found) + (while path + (setq suffixes suffixes-to-try) + (while suffixes + (setq try (ffap-file-exists-string + (expand-file-name + (concat file (car suffixes)) (car path)))) + (if (and try (or dir-ok (not (file-directory-p try)))) + (setq found try suffixes nil path nil) + (setq suffixes (cdr suffixes)))) + (setq path (cdr path))) + found)) ;;; Action List (`ffap-alist'): @@ -731,6 +738,7 @@ ("\\`[-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 @@ -758,6 +766,21 @@ (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: ;; @@ -1157,7 +1180,9 @@ (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 @@ -1242,22 +1267,24 @@ (cond (remove (and ffap-highlight-overlay - (ffap-delete-overlay ffap-highlight-overlay))) + (delete-overlay ffap-highlight-overlay)) + ) ((not ffap-highlight) nil) (ffap-highlight-overlay - (ffap-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 'ffap-make-overlay ffap-string-at-point-region)) - (ffap-overlay-put ffap-highlight-overlay 'face - (if (ffap-find-face 'ffap) + (apply 'make-overlay ffap-string-at-point-region)) + (overlay-put ffap-highlight-overlay 'face + (if (internal-find-face 'ffap) 'ffap 'highlight))))) -;;; The big cheese (`ffap'): +;;; Main Entrance (`find-file-at-point' == `ffap'): (defun ffap-guesser nil "Return file or URL or nil, guessed from text around point." @@ -1271,12 +1298,15 @@ ;; 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 @@ -1336,9 +1366,9 @@ (make-variable-buffer-local 'ffap-menu-alist) (defvar ffap-menu-text-plist - (and window-system - '(face bold mouse-face highlight) ; keymap - ) + (cond + ((not window-system) nil) + (t '(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.") @@ -1470,8 +1500,11 @@ ;;;###autoload (defun ffap-at-mouse (e) "Find file or url guessed from text around mouse click. -Interactively, calls `ffap-at-mouse-fallback' if nothing is found. -Returns t or nil to indicate success." +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? @@ -1489,12 +1522,13 @@ (sit-for 0) ; display (message "Finding `%s'" guess) (find-file-at-point guess) - t) ; success: return non-nil + guess) ; success: return non-nil (ffap-highlight t))) ((interactive-p) (if ffap-at-mouse-fallback (call-interactively ffap-at-mouse-fallback) - (message "No file or url found at mouse click."))) + (message "No file or url found at mouse click.") + nil)) ; no fallback, return nil ;; failure: return nil ))) @@ -1542,7 +1576,7 @@ (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report "Michelangelo Grigni " - "ffap" ; version? just rely on Emacs version + "ffap" (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) (fset 'ffap-submit-bug 'ffap-bug) ; another likely name @@ -1594,19 +1628,19 @@ ;;; Offer default global bindings (`ffap-bindings'): (defvar ffap-bindings - '( - (global-set-key [S-mouse-3] 'ffap-at-mouse) - (global-set-key [C-S-mouse-3] 'ffap-menu) - (global-set-key "\C-x\C-f" 'find-file-at-point) - (global-set-key "\C-x4f" 'ffap-other-window) - (global-set-key "\C-x5f" 'ffap-other-frame) - (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) - (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) - (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) - (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) - ;; (setq dired-x-hands-off-my-keys t) ; the default - ) - "List of binding forms evaluated by function `ffap-bindings'. + '( + (global-set-key [S-mouse-3] 'ffap-at-mouse) + (global-set-key [C-S-mouse-3] 'ffap-menu) + (global-set-key "\C-x\C-f" 'find-file-at-point) + (global-set-key "\C-x4f" 'ffap-other-window) + (global-set-key "\C-x5f" 'ffap-other-frame) + (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) + (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) + (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) + (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) + ;; (setq dired-x-hands-off-my-keys t) ; the default + ) + "List of binding forms evaluated by function `ffap-bindings'. A reasonable ffap installation needs just these two lines: (require 'ffap) (ffap-bindings) @@ -1616,20 +1650,5 @@ "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 "^YSN[0-9]+$" -;; (defun ffap-ysn (name) -;; (concat -;; "http://www.physics.uiuc.edu/" -;; "ysn/httpd/htdocs/ysnarchive/issuefiles/" -;; (substring name 3) ".html"))) -;; ffap-alist)) - ;;; ffap.el ends here