Mercurial > emacs
comparison lisp/ffap.el @ 18486:83ff1ecdb0e3
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.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Sat, 28 Jun 1997 21:27:18 +0000 |
parents | 130a48e6cc13 |
children | 5df2a690a85f |
comparison
equal
deleted
inserted
replaced
18485:d6e8b92585e9 | 18486:83ff1ecdb0e3 |
---|---|
3 ;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. |
4 ;; | 4 ;; |
5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> | 5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> |
6 ;; Created: 29 Mar 1993 | 6 ;; Created: 29 Mar 1993 |
7 ;; Keywords: files, hypermedia, matching, mouse | 7 ;; Keywords: files, hypermedia, matching, mouse |
8 ;; X-URL: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/ | 8 ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ |
9 ;; X-Source: this file is generated from ffap.epp | |
9 | 10 |
10 ;; This file is part of GNU Emacs. | 11 ;; This file is part of GNU Emacs. |
11 | 12 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | 14 ;; it under the terms of the GNU General Public License as published by |
65 ;; | 66 ;; |
66 ;; (setq ffap-alist nil) ; faster, dumber prompting | 67 ;; (setq ffap-alist nil) ; faster, dumber prompting |
67 ;; (setq ffap-machine-p-known 'accept) ; no pinging | 68 ;; (setq ffap-machine-p-known 'accept) ; no pinging |
68 ;; (setq ffap-url-regexp nil) ; disable URL features in ffap | 69 ;; (setq ffap-url-regexp nil) ; disable URL features in ffap |
69 ;; | 70 ;; |
70 ;; ffap uses w3 (if found) or else browse-url to fetch URL's. For | 71 ;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's. |
71 ;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). | 72 ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). |
72 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify | 73 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify |
73 ;; the file and URL references within a buffer. | 74 ;; the file and URL references within a buffer. |
74 | 75 |
75 | 76 |
76 ;;; Change Log: | 77 ;;; Change Log: |
77 ;; | 78 ;; |
78 ;; The History and Contributors moved to ffap.LOG (same ftp site), | 79 ;; The History and Contributors moved to ffap.LOG (same ftp site), |
95 | 96 |
96 ;;; Code: | 97 ;;; Code: |
97 | 98 |
98 (provide 'ffap) | 99 (provide 'ffap) |
99 | 100 |
101 ;; Please do not delete this variable, it is checked in bug reports. | |
102 (defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>" | |
103 "The version of ffap: \"Major.Minor-Build <Timestamp>\"") | |
104 | |
105 | |
106 (defgroup ffap nil | |
107 "Find file or URL at point." | |
108 :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/") | |
109 :group 'matching) | |
110 | |
100 ;; The code is organized in pages, separated by formfeed characters. | 111 ;; The code is organized in pages, separated by formfeed characters. |
101 ;; See the next two pages for standard customization ideas. | 112 ;; See the next two pages for standard customization ideas. |
102 | 113 |
103 | 114 |
104 ;;; User Variables: | 115 ;;; User Variables: |
105 | |
106 (defgroup ffap nil | |
107 "Find file or URL at point." | |
108 :group 'matching) | |
109 | |
110 | 116 |
111 (defun ffap-soft-value (name &optional default) | 117 (defun ffap-soft-value (name &optional default) |
112 "Return value of symbol with NAME, if it is interned. | 118 "Return value of symbol with NAME, if it is interned. |
113 Otherwise return nil (or the optional DEFAULT value)." | 119 Otherwise return nil (or the optional DEFAULT value)." |
114 ;; Bug: (ffap-soft-value "nil" 5) --> 5 | 120 ;; Bug: (ffap-soft-value "nil" 5) --> 5 |
216 :type 'function | 222 :type 'function |
217 :group 'ffap) | 223 :group 'ffap) |
218 (put 'ffap-file-finder 'risky-local-variable t) | 224 (put 'ffap-file-finder 'risky-local-variable t) |
219 | 225 |
220 (defcustom ffap-url-fetcher | 226 (defcustom ffap-url-fetcher |
221 (cond ((fboundp 'w3-fetch) 'w3-fetch) | 227 (if (fboundp 'browse-url) |
222 ((fboundp 'browse-url-netscape) 'browse-url-netscape) | 228 'browse-url ; rely on browse-url-browser-function |
223 (t 'w3-fetch)) | 229 'w3-fetch) |
224 ;; Remote control references: | 230 ;; Remote control references: |
225 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html | 231 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html |
226 ;; http://home.netscape.com/newsref/std/x-remote.html | 232 ;; http://home.netscape.com/newsref/std/x-remote.html |
227 "*A function of one argument, called by ffap to fetch an URL. | 233 "*A function of one argument, called by ffap to fetch an URL. |
228 Reasonable choices are `w3-fetch' or `browse-url-netscape'. | 234 Reasonable choices are `w3-fetch' or a `browse-url-*' function. |
229 For a fancier alternative, get ffap-url.el." | 235 For a fancy alternative, get ffap-url.el." |
230 :type '(choice (const w3-fetch) | 236 :type '(choice (const w3-fetch) |
237 (const browse-url) ; in recent versions of browse-url | |
231 (const browse-url-netscape) | 238 (const browse-url-netscape) |
232 (const browse-url-mosaic) | 239 (const browse-url-mosaic) |
233 function) | 240 function) |
234 :group 'ffap) | 241 :group 'ffap) |
235 (put 'ffap-url-fetcher 'risky-local-variable t) | 242 (put 'ffap-url-fetcher 'risky-local-variable t) |
236 | 243 |
237 | 244 |
238 ;;; Compatibility (XEmacs code suppressed in this version): | 245 ;;; Compatibility: |
239 | 246 ;; |
240 (progn | 247 ;; This version of ffap supports Emacs 20 only, see the ftp site |
241 (defalias 'ffap-make-overlay 'make-overlay) | 248 ;; for a more general version. The following functions are necessary |
242 (defalias 'ffap-delete-overlay 'delete-overlay) ; reusable | 249 ;; "leftovers" from the more general version. |
243 (defalias 'ffap-move-overlay 'move-overlay) | 250 |
244 (defalias 'ffap-overlay-put 'overlay-put) ; 'face | 251 (defun ffap-mouse-event nil ; current mouse event, or nil |
245 (defalias 'ffap-find-face 'internal-find-face) | 252 (and (listp last-nonmenu-event) last-nonmenu-event)) |
246 (defun ffap-mouse-event nil ; current mouse event, or nil | 253 (defun ffap-event-buffer (event) |
247 (and (listp last-nonmenu-event) last-nonmenu-event)) | 254 (window-buffer (car (event-start event)))) |
248 (defun ffap-event-buffer (event) (window-buffer (car (event-start event)))) | |
249 ) | |
250 | 255 |
251 | 256 |
252 ;;; Find Next Thing in buffer (`ffap-next'): | 257 ;;; Find Next Thing in buffer (`ffap-next'): |
253 ;; | 258 ;; |
254 ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since | 259 ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since |
353 :group 'ffap) | 358 :group 'ffap) |
354 | 359 |
355 (defun ffap-what-domain (domain) | 360 (defun ffap-what-domain (domain) |
356 ;; Like what-domain in mail-extr.el, returns string or nil. | 361 ;; Like what-domain in mail-extr.el, returns string or nil. |
357 (require 'mail-extr) | 362 (require 'mail-extr) |
358 (get (intern-soft (downcase domain) mail-extr-all-top-level-domains) | 363 (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains") |
359 'domain-name)) | 364 (ffap-soft-value "all-top-level-domains")))) ; XEmacs |
365 (and ob (get (intern-soft (downcase domain) ob) 'domain-name)))) | |
360 | 366 |
361 (defun ffap-machine-p (host &optional service quiet strategy) | 367 (defun ffap-machine-p (host &optional service quiet strategy) |
362 "Decide whether HOST is the name of a real, reachable machine. | 368 "Decide whether HOST is the name of a real, reachable machine. |
363 Depending on the domain (none, known, or unknown), follow the strategy | 369 Depending on the domain (none, known, or unknown), follow the strategy |
364 named by the variable `ffap-machine-p-local', `ffap-machine-p-known', | 370 named by the variable `ffap-machine-p-local', `ffap-machine-p-known', |
442 (and found | 448 (and found |
443 (fset 'ffap-replace-path-component found) | 449 (fset 'ffap-replace-path-component found) |
444 (funcall found fullname name)))) | 450 (funcall found fullname name)))) |
445 ;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new") | 451 ;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new") |
446 | 452 |
447 (defun ffap-file-exists-string (file) | 453 (defun ffap-file-suffix (file) |
448 ;; With certain packages (ange-ftp, jka-compr?) file-exists-p | 454 "Return trailing \".foo\" suffix of FILE, or nil if none." |
449 ;; sometimes returns a nicer string than it is given. Otherwise, it | 455 (let ((pos (string-match "\\.[^./]*\\'" file))) |
450 ;; just returns nil or t. | 456 (and pos (substring file pos nil)))) |
451 "Return FILE \(maybe modified\) if it exists, else nil." | 457 |
452 (and file ; quietly reject nil | 458 (defvar ffap-compression-suffixes '(".gz" ".Z") ; .z is mostly dead |
453 (let ((exists (file-exists-p file))) | 459 "List of suffixes tried by `ffap-file-exists-string'.") |
454 (and exists (if (stringp exists) exists file))))) | 460 |
455 | 461 (defun ffap-file-exists-string (file &optional nomodify) |
462 ;; Early jka-compr versions modified file-exists-p to return the | |
463 ;; filename, maybe modified by adding a suffix like ".gz". That | |
464 ;; broke the interface of file-exists-p, so it was later dropped. | |
465 ;; Here we document and simulate the old behavior. | |
466 "Return FILE \(maybe modified\) if it exists, else nil. | |
467 When using jka-compr (a.k.a. `auto-compression-mode'), the returned | |
468 name may have a suffix added from `ffap-compression-suffixes'. | |
469 The optional NOMODIFY argument suppresses the extra search." | |
470 (cond | |
471 ((not file) nil) ; quietly reject nil | |
472 ((file-exists-p file) file) ; try unmodified first | |
473 ;; three reasons to suppress search: | |
474 (nomodify nil) | |
475 ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil) | |
476 ((member (ffap-file-suffix file) ffap-compression-suffixes) nil) | |
477 (t ; ok, do the search | |
478 (let ((list ffap-compression-suffixes) try ret) | |
479 (while list | |
480 (if (file-exists-p (setq try (concat file (car list)))) | |
481 (setq ret try list nil) | |
482 (setq list (cdr list)))) | |
483 ret)))) | |
456 | 484 |
457 (defun ffap-file-remote-p (filename) | 485 (defun ffap-file-remote-p (filename) |
458 "If FILENAME looks remote, return it \(maybe slightly improved\)." | 486 "If FILENAME looks remote, return it \(maybe slightly improved\)." |
459 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") | 487 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") |
460 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path") | 488 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path") |
560 (cond | 588 (cond |
561 ((not (stringp url)) nil) | 589 ((not (stringp url)) nil) |
562 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) | 590 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) |
563 ((and ffap-url-unwrap-remote ffap-ftp-regexp | 591 ((and ffap-url-unwrap-remote ffap-ftp-regexp |
564 (ffap-url-unwrap-remote url))) | 592 (ffap-url-unwrap-remote url))) |
565 ;; This might autoload the url package, oh well: | 593 ((fboundp 'url-normalize-url) ; may autoload url (part of w3) |
566 (t (let ((normal (and (fboundp 'url-normalize-url) | 594 (url-normalize-url url)) |
567 (url-normalize-url url)))) | 595 (url))) |
568 ;; In case url-normalize-url is confused: | |
569 (or (and normal (not (zerop (length normal))) normal) | |
570 url))))) | |
571 | 596 |
572 | 597 |
573 ;;; Path Handling: | 598 ;;; Path Handling: |
574 ;; | 599 ;; |
575 ;; The upcoming ffap-alist actions need various utilities to prepare | 600 ;; The upcoming ffap-alist actions need various utilities to prepare |
657 (if (string-match "[^/]//\\'" dir) | 682 (if (string-match "[^/]//\\'" dir) |
658 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) | 683 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) |
659 (list dir)))) | 684 (list dir)))) |
660 path))) | 685 path))) |
661 | 686 |
662 (defvar ffap-locate-jka-suffixes t | 687 (defun ffap-locate-file (file &optional nosuffix path dir-ok) |
663 "List of compression suffixes tried by `ffap-locate-file'. | 688 ;; The Emacs 20 version of locate-library could almost replace this, |
664 | 689 ;; except it does not let us overrride the suffix list. The |
665 If not a list, it will be initialized by `ffap-locate-file', depending | 690 ;; compression-suffixes search moved to ffap-file-exists-string. |
666 on whether you use jka-compr (a.k.a. `auto-compression-mode'). | |
667 Typical values are nil or '(\".gz\" \".Z\").") ; .z is dead | |
668 | |
669 (defun ffap-locate-file (file &optional nosuffix path) | |
670 ;; Note the Emacs 20 version of locate-library could almost | |
671 ;; replace this function, except that it does not let us overrride | |
672 ;; the list of suffixes. | |
673 "A generic path-searching function, mimics `load' by default. | 691 "A generic path-searching function, mimics `load' by default. |
674 Returns path to file that \(load FILE\) would load, or nil. | 692 Returns path to file that \(load FILE\) would load, or nil. |
675 Optional NOSUFFIX, if nil or t, is like the fourth argument | 693 Optional NOSUFFIX, if nil or t, is like the fourth argument |
676 for load: whether to try the suffixes (\".elc\" \".el\" \"\"). | 694 for load: whether to try the suffixes (\".elc\" \".el\" \"\"). |
677 If a nonempty list, it is a list of suffixes to try instead. | 695 If a nonempty list, it is a list of suffixes to try instead. |
678 Optional PATH is a list of directories instead of `load-path'." | 696 Optional PATH is a list of directories instead of `load-path'. |
697 Optional DIR-OK means that returning a directory is allowed, | |
698 DIR-OK is already implicit if FILE looks like a directory. | |
699 | |
700 This uses ffap-file-exists-string, which may try adding suffixes from | |
701 `ffap-compression-suffixes'." | |
679 (or path (setq path load-path)) | 702 (or path (setq path load-path)) |
703 (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file)))) | |
680 (if (file-name-absolute-p file) | 704 (if (file-name-absolute-p file) |
681 (setq path (list (file-name-directory file)) | 705 (setq path (list (file-name-directory file)) |
682 file (file-name-nondirectory file))) | 706 file (file-name-nondirectory file))) |
683 (let ((suffixes-to-try | 707 (let ((suffixes-to-try |
684 (cond | 708 (cond |
685 ((consp nosuffix) nosuffix) | 709 ((consp nosuffix) nosuffix) |
686 (nosuffix '("")) | 710 (nosuffix '("")) |
687 (t '(".elc" ".el" ""))))) | 711 (t '(".elc" ".el" "")))) |
688 ;; Note we no longer check for old versions of jka-compr, that | 712 suffixes try found) |
689 ;; would aggressively try to convert any foo to foo.gz. | 713 (while path |
690 (or (listp ffap-locate-jka-suffixes) | 714 (setq suffixes suffixes-to-try) |
691 (setq ffap-locate-jka-suffixes | 715 (while suffixes |
692 (and (rassq 'jka-compr-handler file-name-handler-alist) | 716 (setq try (ffap-file-exists-string |
693 '(".gz" ".Z")))) ; ".z" is dead, "" is implicit | 717 (expand-file-name |
694 (if ffap-locate-jka-suffixes ; | 718 (concat file (car suffixes)) (car path)))) |
695 (setq suffixes-to-try | 719 (if (and try (or dir-ok (not (file-directory-p try)))) |
696 (apply 'nconc | 720 (setq found try suffixes nil path nil) |
697 (mapcar | 721 (setq suffixes (cdr suffixes)))) |
698 (function | 722 (setq path (cdr path))) |
699 (lambda (suf) | 723 found)) |
700 (cons suf | |
701 (mapcar | |
702 (function (lambda (x) (concat suf x))) | |
703 ffap-locate-jka-suffixes)))) | |
704 suffixes-to-try)))) | |
705 (let (found suffixes) | |
706 (while (and path (not found)) | |
707 (setq suffixes suffixes-to-try) | |
708 (while (and suffixes (not found)) | |
709 (let ((try (expand-file-name | |
710 (concat file (car suffixes)) | |
711 (car path)))) | |
712 (if (and (file-exists-p try) (not (file-directory-p try))) | |
713 (setq found try))) | |
714 (setq suffixes (cdr suffixes))) | |
715 (setq path (cdr path))) | |
716 found))) | |
717 | 724 |
718 | 725 |
719 ;;; Action List (`ffap-alist'): | 726 ;;; Action List (`ffap-alist'): |
720 ;; | 727 ;; |
721 ;; These search actions depend on the major-mode or regexps matching | 728 ;; These search actions depend on the major-mode or regexps matching |
729 ("\\.info\\'" . ffap-info) ; gzip.info | 736 ("\\.info\\'" . ffap-info) ; gzip.info |
730 ("\\`info/" . ffap-info-2) ; info/emacs | 737 ("\\`info/" . ffap-info-2) ; info/emacs |
731 ("\\`[-a-z]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses] | 738 ("\\`[-a-z]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses] |
732 ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc | 739 ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc |
733 (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom | 740 (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom |
741 ;; (lisp-interaction-mode . ffap-el-mode) ; maybe | |
734 (finder-mode . ffap-el-mode) ; type {C-h p} and try it | 742 (finder-mode . ffap-el-mode) ; type {C-h p} and try it |
735 (help-mode . ffap-el-mode) ; maybe useful | 743 (help-mode . ffap-el-mode) ; maybe useful |
736 (c++-mode . ffap-c-mode) ; search ffap-c-path | 744 (c++-mode . ffap-c-mode) ; search ffap-c-path |
737 (cc-mode . ffap-c-mode) ; same | 745 (cc-mode . ffap-c-mode) ; same |
738 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h | 746 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h |
755 KEY is a string, it should matches NAME as a regexp. | 763 KEY is a string, it should matches NAME as a regexp. |
756 On a match, \(FUNCTION NAME\) is called and should return a file, an | 764 On a match, \(FUNCTION NAME\) is called and should return a file, an |
757 url, or nil. If nil, search the alist for further matches.") | 765 url, or nil. If nil, search the alist for further matches.") |
758 | 766 |
759 (put 'ffap-alist 'risky-local-variable t) | 767 (put 'ffap-alist 'risky-local-variable t) |
768 | |
769 ;; Example `ffap-alist' modifications: | |
770 ;; | |
771 ;; (setq ffap-alist ; remove a feature in `ffap-alist' | |
772 ;; (delete (assoc 'c-mode ffap-alist) ffap-alist)) | |
773 ;; | |
774 ;; (setq ffap-alist ; add something to `ffap-alist' | |
775 ;; (cons | |
776 ;; (cons "^YSN[0-9]+$" | |
777 ;; (defun ffap-ysn (name) | |
778 ;; (concat | |
779 ;; "http://www.physics.uiuc.edu/" | |
780 ;; "ysn/httpd/htdocs/ysnarchive/issuefiles/" | |
781 ;; (substring name 3) ".html"))) | |
782 ;; ffap-alist)) | |
760 | 783 |
761 | 784 |
762 ;;; Action Definitions: | 785 ;;; Action Definitions: |
763 ;; | 786 ;; |
764 ;; Define various default members of `ffap-alist'. | 787 ;; Define various default members of `ffap-alist'. |
1155 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" | 1178 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" |
1156 ;; or "w3/" or "../el/ffap.el" or "../../../" | 1179 ;; or "w3/" or "../el/ffap.el" or "../../../" |
1157 (or (ffap-url-p guess) | 1180 (or (ffap-url-p guess) |
1158 (progn | 1181 (progn |
1159 (or (ffap-file-remote-p guess) | 1182 (or (ffap-file-remote-p guess) |
1160 (setq guess (abbreviate-file-name (expand-file-name guess)))) | 1183 (setq guess |
1184 (abbreviate-file-name (expand-file-name guess)) | |
1185 )) | |
1161 (setq dir (file-name-directory guess)))) | 1186 (setq dir (file-name-directory guess)))) |
1162 (setq guess | 1187 (setq guess |
1163 (completing-read | 1188 (completing-read |
1164 prompt | 1189 prompt |
1165 'ffap-read-file-or-url-internal | 1190 'ffap-read-file-or-url-internal |
1240 Optional argument REMOVE means to remove any such highlighting. | 1265 Optional argument REMOVE means to remove any such highlighting. |
1241 Uses the face `ffap' if it is defined, or else `highlight'." | 1266 Uses the face `ffap' if it is defined, or else `highlight'." |
1242 (cond | 1267 (cond |
1243 (remove | 1268 (remove |
1244 (and ffap-highlight-overlay | 1269 (and ffap-highlight-overlay |
1245 (ffap-delete-overlay ffap-highlight-overlay))) | 1270 (delete-overlay ffap-highlight-overlay)) |
1271 ) | |
1246 ((not ffap-highlight) nil) | 1272 ((not ffap-highlight) nil) |
1247 (ffap-highlight-overlay | 1273 (ffap-highlight-overlay |
1248 (ffap-move-overlay ffap-highlight-overlay | 1274 (move-overlay |
1249 (car ffap-string-at-point-region) | 1275 ffap-highlight-overlay |
1250 (nth 1 ffap-string-at-point-region) | 1276 (car ffap-string-at-point-region) |
1251 (current-buffer))) | 1277 (nth 1 ffap-string-at-point-region) |
1278 (current-buffer))) | |
1252 (t | 1279 (t |
1253 (setq ffap-highlight-overlay | 1280 (setq ffap-highlight-overlay |
1254 (apply 'ffap-make-overlay ffap-string-at-point-region)) | 1281 (apply 'make-overlay ffap-string-at-point-region)) |
1255 (ffap-overlay-put ffap-highlight-overlay 'face | 1282 (overlay-put ffap-highlight-overlay 'face |
1256 (if (ffap-find-face 'ffap) | 1283 (if (internal-find-face 'ffap) |
1257 'ffap 'highlight))))) | 1284 'ffap 'highlight))))) |
1258 | 1285 |
1259 | 1286 |
1260 ;;; The big cheese (`ffap'): | 1287 ;;; Main Entrance (`find-file-at-point' == `ffap'): |
1261 | 1288 |
1262 (defun ffap-guesser nil | 1289 (defun ffap-guesser nil |
1263 "Return file or URL or nil, guessed from text around point." | 1290 "Return file or URL or nil, guessed from text around point." |
1264 (or (and ffap-url-regexp | 1291 (or (and ffap-url-regexp |
1265 (ffap-fixup-url (or (ffap-url-at-point) | 1292 (ffap-fixup-url (or (ffap-url-at-point) |
1269 | 1296 |
1270 (defun ffap-prompter (&optional guess) | 1297 (defun ffap-prompter (&optional guess) |
1271 ;; Does guess and prompt step for find-file-at-point. | 1298 ;; Does guess and prompt step for find-file-at-point. |
1272 ;; Extra complication for the temporary highlighting. | 1299 ;; Extra complication for the temporary highlighting. |
1273 (unwind-protect | 1300 (unwind-protect |
1274 (ffap-read-file-or-url | 1301 ;; This catch will let ffap-alist entries do their own prompting |
1275 (if ffap-url-regexp "Find file or URL: " "Find file: ") | 1302 ;; and then maybe skip over this prompt (ff-paths, for example). |
1276 (prog1 | 1303 (catch 'ffap-prompter |
1277 (setq guess (or guess (ffap-guesser))) | 1304 (ffap-read-file-or-url |
1278 (and guess (ffap-highlight)) | 1305 (if ffap-url-regexp "Find file or URL: " "Find file: ") |
1279 )) | 1306 (prog1 |
1307 (setq guess (or guess (ffap-guesser))) ; using ffap-alist here | |
1308 (and guess (ffap-highlight)) | |
1309 ))) | |
1280 (ffap-highlight t))) | 1310 (ffap-highlight t))) |
1281 | 1311 |
1282 ;;;###autoload | 1312 ;;;###autoload |
1283 (defun find-file-at-point (&optional filename) | 1313 (defun find-file-at-point (&optional filename) |
1284 "Find FILENAME, guessing a default from text around point. | 1314 "Find FILENAME, guessing a default from text around point. |
1334 (defvar ffap-menu-alist nil | 1364 (defvar ffap-menu-alist nil |
1335 "Buffer local cache of menu presented by `ffap-menu'.") | 1365 "Buffer local cache of menu presented by `ffap-menu'.") |
1336 (make-variable-buffer-local 'ffap-menu-alist) | 1366 (make-variable-buffer-local 'ffap-menu-alist) |
1337 | 1367 |
1338 (defvar ffap-menu-text-plist | 1368 (defvar ffap-menu-text-plist |
1339 (and window-system | 1369 (cond |
1340 '(face bold mouse-face highlight) ; keymap <mousy-map> | 1370 ((not window-system) nil) |
1341 ) | 1371 (t '(face bold mouse-face highlight))) ; keymap <mousy-map> |
1342 "Text properties applied to strings found by `ffap-menu-rescan'. | 1372 "Text properties applied to strings found by `ffap-menu-rescan'. |
1343 These properties may be used to fontify the menu references.") | 1373 These properties may be used to fontify the menu references.") |
1344 | 1374 |
1345 ;;;###autoload | 1375 ;;;###autoload |
1346 (defun ffap-menu (&optional rescan) | 1376 (defun ffap-menu (&optional rescan) |
1468 (put 'ffap-at-mouse-fallback 'risky-local-variable t) | 1498 (put 'ffap-at-mouse-fallback 'risky-local-variable t) |
1469 | 1499 |
1470 ;;;###autoload | 1500 ;;;###autoload |
1471 (defun ffap-at-mouse (e) | 1501 (defun ffap-at-mouse (e) |
1472 "Find file or url guessed from text around mouse click. | 1502 "Find file or url guessed from text around mouse click. |
1473 Interactively, calls `ffap-at-mouse-fallback' if nothing is found. | 1503 Interactively, calls `ffap-at-mouse-fallback' if no guess is found. |
1474 Returns t or nil to indicate success." | 1504 Return value: |
1505 * if a guess string is found, return it (after finding it) | |
1506 * if the fallback is called, return whatever it returns | |
1507 * otherwise, nil" | |
1475 (interactive "e") | 1508 (interactive "e") |
1476 (let ((guess | 1509 (let ((guess |
1477 ;; Maybe less surprising without the save-excursion? | 1510 ;; Maybe less surprising without the save-excursion? |
1478 (save-excursion | 1511 (save-excursion |
1479 (mouse-set-point e) | 1512 (mouse-set-point e) |
1487 (unwind-protect | 1520 (unwind-protect |
1488 (progn | 1521 (progn |
1489 (sit-for 0) ; display | 1522 (sit-for 0) ; display |
1490 (message "Finding `%s'" guess) | 1523 (message "Finding `%s'" guess) |
1491 (find-file-at-point guess) | 1524 (find-file-at-point guess) |
1492 t) ; success: return non-nil | 1525 guess) ; success: return non-nil |
1493 (ffap-highlight t))) | 1526 (ffap-highlight t))) |
1494 ((interactive-p) | 1527 ((interactive-p) |
1495 (if ffap-at-mouse-fallback | 1528 (if ffap-at-mouse-fallback |
1496 (call-interactively ffap-at-mouse-fallback) | 1529 (call-interactively ffap-at-mouse-fallback) |
1497 (message "No file or url found at mouse click."))) | 1530 (message "No file or url found at mouse click.") |
1531 nil)) ; no fallback, return nil | |
1498 ;; failure: return nil | 1532 ;; failure: return nil |
1499 ))) | 1533 ))) |
1500 | 1534 |
1501 | 1535 |
1502 ;;; ffap-other-* commands: | 1536 ;;; ffap-other-* commands: |
1540 (interactive) | 1574 (interactive) |
1541 (require 'reporter) | 1575 (require 'reporter) |
1542 (let ((reporter-prompt-for-summary-p t)) | 1576 (let ((reporter-prompt-for-summary-p t)) |
1543 (reporter-submit-bug-report | 1577 (reporter-submit-bug-report |
1544 "Michelangelo Grigni <mic@mathcs.emory.edu>" | 1578 "Michelangelo Grigni <mic@mathcs.emory.edu>" |
1545 "ffap" ; version? just rely on Emacs version | 1579 "ffap" |
1546 (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) | 1580 (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) |
1547 | 1581 |
1548 (fset 'ffap-submit-bug 'ffap-bug) ; another likely name | 1582 (fset 'ffap-submit-bug 'ffap-bug) ; another likely name |
1549 | 1583 |
1550 | 1584 |
1592 | 1626 |
1593 | 1627 |
1594 ;;; Offer default global bindings (`ffap-bindings'): | 1628 ;;; Offer default global bindings (`ffap-bindings'): |
1595 | 1629 |
1596 (defvar ffap-bindings | 1630 (defvar ffap-bindings |
1597 '( | 1631 '( |
1598 (global-set-key [S-mouse-3] 'ffap-at-mouse) | 1632 (global-set-key [S-mouse-3] 'ffap-at-mouse) |
1599 (global-set-key [C-S-mouse-3] 'ffap-menu) | 1633 (global-set-key [C-S-mouse-3] 'ffap-menu) |
1600 (global-set-key "\C-x\C-f" 'find-file-at-point) | 1634 (global-set-key "\C-x\C-f" 'find-file-at-point) |
1601 (global-set-key "\C-x4f" 'ffap-other-window) | 1635 (global-set-key "\C-x4f" 'ffap-other-window) |
1602 (global-set-key "\C-x5f" 'ffap-other-frame) | 1636 (global-set-key "\C-x5f" 'ffap-other-frame) |
1603 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) | 1637 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) |
1604 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) | 1638 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) |
1605 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) | 1639 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) |
1606 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) | 1640 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) |
1607 ;; (setq dired-x-hands-off-my-keys t) ; the default | 1641 ;; (setq dired-x-hands-off-my-keys t) ; the default |
1608 ) | 1642 ) |
1609 "List of binding forms evaluated by function `ffap-bindings'. | 1643 "List of binding forms evaluated by function `ffap-bindings'. |
1610 A reasonable ffap installation needs just these two lines: | 1644 A reasonable ffap installation needs just these two lines: |
1611 (require 'ffap) | 1645 (require 'ffap) |
1612 (ffap-bindings) | 1646 (ffap-bindings) |
1613 Of course if you do not like these bindings, just roll your own!") | 1647 Of course if you do not like these bindings, just roll your own!") |
1614 | 1648 |
1615 (defun ffap-bindings nil | 1649 (defun ffap-bindings nil |
1616 "Evaluate the forms in variable `ffap-bindings'." | 1650 "Evaluate the forms in variable `ffap-bindings'." |
1617 (eval (cons 'progn ffap-bindings))) | 1651 (eval (cons 'progn ffap-bindings))) |
1618 | 1652 |
1619 ;; Example modifications: | |
1620 ;; | |
1621 ;; (setq ffap-alist ; remove a feature in `ffap-alist' | |
1622 ;; (delete (assoc 'c-mode ffap-alist) ffap-alist)) | |
1623 ;; | |
1624 ;; (setq ffap-alist ; add something to `ffap-alist' | |
1625 ;; (cons | |
1626 ;; (cons "^YSN[0-9]+$" | |
1627 ;; (defun ffap-ysn (name) | |
1628 ;; (concat | |
1629 ;; "http://www.physics.uiuc.edu/" | |
1630 ;; "ysn/httpd/htdocs/ysnarchive/issuefiles/" | |
1631 ;; (substring name 3) ".html"))) | |
1632 ;; ffap-alist)) | |
1633 | |
1634 | 1653 |
1635 ;;; ffap.el ends here | 1654 ;;; ffap.el ends here |