-;;; ffap.el --- find file or URL at point
-
+;;; ffap.el --- find file (or url) at point
+;;
;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-
+;;
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse
-;; X-Latest: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
+;; X-URL: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
;; This file is part of GNU Emacs.
;; C-x 4 f ffap-other-window
;; C-x 5 f ffap-other-frame
;; S-mouse-3 ffap-at-mouse
+;; C-S-mouse-3 ffap-menu
;;
;; 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.
;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
;; the file and URL references within a buffer.
+\f
+;;; 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.
+
+\f
;;; 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 "/path/file#key" jump to key (tag or regexp) in /path/file
;; * find file of symbol if TAGS is loaded (like above)
-;; * break up long menus into multiple panes (like imenu?)
-;; * notice node in "(dired)Virtual Dired" (handle the space?)
+;; * break long menus into multiple panes (like imenu?)
+;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
;; * notice "machine.dom blah blah blah path/file" (how?)
-;; * if w3 becomes standard, could rewrite to use its functions
+;; * 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
\f
;;; Code:
(provide 'ffap)
-;; Versions: This file is tested with Emacs 19.30. It mostly works
-;; with XEmacs, but get ffap-xe.el for the popup menu. Emacs 18 is
-;; now abandoned (get ffap-15.el instead).
-
-(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t)
- "Whether ffap thinks it is running under XEmacs.")
-
+;; The code is organized in pages, separated by formfeed characters.
+;; See the next two pages for standard customization ideas.
\f
;;; User Variables:
:group 'matching)
-;; This function is used inside defvars:
-(defmacro ffap-soft-value (name &optional default)
+(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)."
;; Bug: (ffap-soft-value "nil" 5) --> 5
(let ((sym (intern-soft name)))
- (if (and sym (boundp sym))
- sym
- `(quote ,default))))
-
+ (if (and sym (boundp sym)) (symbol-value sym) default)))
(defcustom 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."
+ ;; This used to test for ange-ftp or efs being present, but it should be
+ ;; harmless (and simpler) to give it this value unconditionally.
+ "\\`/[^/:]+:"
+ "*Paths matching this regexp are treated as remote ftp paths by ffap.
+If nil, ffap neither recognizes nor generates such paths."
:type '(choice (const :tag "Disable" nil)
+ (const :tag "Standard" "\\`/[^/:]+:")
regexp)
:group 'ffap)
(defcustom ffap-url-unwrap-local t
- "*If non-nil, convert \"file:\" URL to local path before prompting."
+ "*If non-nil, convert \"file:\" url to local path before prompting."
:type 'boolean
:group 'ffap)
(defcustom ffap-url-unwrap-remote t
- "*If non-nil, convert \"ftp:\" URL to remote path before prompting.
+ "*If non-nil, convert \"ftp:\" url to remote path before prompting.
This is ignored if `ffap-ftp-regexp' is nil."
:type 'boolean
:group 'ffap)
-(defcustom ffap-ftp-default-user
- "anonymous"
+(defcustom ffap-ftp-default-user "anonymous"
"*User name in ftp paths generated by `ffap-host-to-path'.
-nil to rely on `efs-default-user' or `ange-ftp-default-user'."
- :type '(choice (const :tag "Default" nil)
- string)
+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
(defcustom ffap-foo-at-bar-prefix "mailto"
"*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
Sensible values are nil, \"news\", or \"mailto\"."
- :type 'string
+ :type '(choice (const "mailto")
+ (const "news")
+ (const :tag "Disable" nil)
+ ;; string -- possible, but not really useful
+ )
:group 'ffap)
\f
-;;; Peanut Gallery:
+;;; Peanut Gallery (More User Variables):
;;
;; Users of ffap occasionally suggest new features. If I consider
;; those features interesting but not clear winners (a matter of
;; through this section for features that you like, put an appropriate
;; enabler in your .emacs file.
-(defcustom ffap-dired-wildcards nil ; "[*?][^/]*$"
+(defcustom ffap-dired-wildcards nil
;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still
;; available by "C-x C-d <pattern>", and valid filenames may
;; sometimes contain wildcard characters.
"*A regexp matching filename wildcard characters, or nil.
If `find-file-at-point' gets a filename matching this pattern,
it passes it on to `dired' instead of `find-file'."
- :type '(choice (const :tag "off" nil)
- regexp)
+ :type '(choice (const :tag "Disable" nil)
+ (const :tag "Enable" "[*?][^/]*\\'")
+ ;; regexp -- probably not useful
+ )
:group 'ffap)
-(defcustom ffap-newfile-prompt nil ; t
+(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."
"*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."
- :type 'function
+ :type '(choice (const w3-fetch)
+ (const browse-url-netscape)
+ (const browse-url-mosaic)
+ function)
:group 'ffap)
(put 'ffap-url-fetcher 'risky-local-variable t)
\f
-;;; Command ffap-next:
+;;; Compatibility (XEmacs code suppressed in this 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))))
+ )
+
+\f
+;;; Find Next Thing in buffer (`ffap-next'):
;;
;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
;; then, broke it up into ffap-next-guess (noninteractive) and
(ffap-next back wrap))))
\f
-;;; 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.
(defcustom ffap-machine-p-local 'reject ; this happens often
- "*A symbol, one of: ping, accept, reject.
+ "*A symbol, one of: `ping', `accept', `reject'.
What `ffap-machine-p' does with hostnames that have no domain."
:type '(choice (const ping)
(const accept)
;; Could be "Unknown service":
(t (signal (car error) (cdr error))))))))))))
+\f
+;;; Possibly Remote Resources:
+
+(defun ffap-replace-path-component (fullname name)
+ "In remote FULLNAME, replace path with NAME. May return nil."
+ ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
+ (let (found)
+ (mapcar
+ (function (lambda (sym) (and (fboundp sym) (setq found sym))))
+ '(
+ efs-replace-path-component
+ ange-ftp-replace-path-component
+ ange-ftp-replace-name-component
+ ))
+ (and found
+ (fset 'ffap-replace-path-component found)
+ (funcall found fullname name))))
+;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
+
+(defun ffap-file-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-remote-p (filename)
"If FILENAME looks remote, return it \(maybe slightly improved\)."
;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
(and (ffap-machine-p mach) mach)))
(defsubst ffap-host-to-path (host)
- "Convert HOST to something like \"/anonymous@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.
((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:
+ ;; 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:
url)))))
\f
-;;; `ffap-alist':
+;;; Path Handling:
;;
-;; Search actions depending on the major-mode or extensions of the
-;; current name. Note all the little defun's could be broken out, at
-;; some loss of locality. A good example of featuritis.
-
-;; First, some helpers for functions in `ffap-alist':
+;; The upcoming ffap-alist actions need various utilities to prepare
+;; and search paths of directories. Too many features here.
+
+;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
+;; (defun ffap-splice (func inlist)
+;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
+;; (let* ((head (cons 17 nil)) (last head))
+;; (while inlist
+;; (setcdr last (funcall func (car inlist)))
+;; (setq last (ffap-last last) inlist (cdr inlist)))
+;; (cdr head)))
(defun ffap-list-env (env &optional empty)
- ;; Replace this with parse-colon-path (lisp/files.el)?
- "Directory list parsed from 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))
(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)))
(progn (setcdr tem ret) (setq ret tem))))
(nreverse ret)))
-(defun ffap-add-subdirs (path)
- "Return PATH augmented with its immediate subdirectories."
- ;; (ffap-add-subdirs '("/notexist" "~"))
- (let (ret subs)
- (while path
- (mapcar
- (function
- (lambda (f) (and (file-directory-p f) (setq ret (cons f ret)))))
- (condition-case nil
- (directory-files (car path) t "[^.]")
- (error nil)))
- (setq ret (cons (car path) ret)
- path (cdr path)))
- (nreverse ret)))
+(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)))
+
+(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.
+ "A generic path-searching function, mimics `load' by default.
+Returns path to file that \(load FILE\) would load, or nil.
+Optional NOSUFFIX, if nil or t, is like the fourth argument
+for load: whether to try the suffixes (\".elc\" \".el\" \"\").
+If a nonempty list, it is a list of suffixes to try instead.
+Optional PATH is a list of directories instead of `load-path'."
+ (or path (setq path load-path))
+ (if (file-name-absolute-p file)
+ (setq path (list (file-name-directory file))
+ file (file-name-nondirectory file)))
+ (let ((suffixes-to-try
+ (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)))
+
+\f
+;;; Action List (`ffap-alist'):
+;;
+;; These search actions depend on the major-mode or regexps matching
+;; the current name. The little functions and their variables are
+;; deferred to the next section, at some loss of "code locality". A
+;; good example of featuritis. Trim this list for speed.
(defvar ffap-alist
- ;; A big mess! Parts are probably useless.
'(
- ("\\.info\\'" . ffap-info)
- ;; Since so many info files do not have .info extension, also do this:
- ("\\`info/" . ffap-info-2)
- ("\\`[-a-z]+\\'" . ffap-info-3)
- ("\\.elc?\\'" . ffap-el)
- (emacs-lisp-mode . ffap-el-mode)
- (finder-mode . ffap-el-mode) ; v19: {C-h p}
- (help-mode . ffap-el-mode) ; v19.29
- (c++-mode . ffap-c-mode)
- (cc-mode . ffap-c-mode)
- ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode)
- (tex-mode . ffap-tex-mode)
- (latex-mode . ffap-latex-mode)
+ ("" . 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
+ (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)
- ("\\`\\." . ffap-home)
- ("\\`~/" . ffap-lcd)
+ ("\\.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)
- ("\\`[^/]*\\'" . ffap-dired))
+ . 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
url, or nil. If nil, search the alist for further matches.")
(put 'ffap-alist 'risky-local-variable t)
+
\f
-(defun ffap-home (name) (locate-library name t '("~")))
+;;; 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)
- (locate-library
+ (ffap-locate-file
name '("" ".info")
(or (ffap-soft-value "Info-directory-list")
(ffap-soft-value "Info-default-directory-list")
- ;; v18:
- (list (ffap-soft-value "Info-directory" "~/info/")))))
+ )))
(defun ffap-info-2 (name) (ffap-info (substring name 5)))
-;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
(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) (locate-library name t))
-
-;; 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))
+(defun ffap-el (name) (ffap-locate-file name t))
(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?)
+ ;; 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))
- (locate-library name '(".el"))))
+ (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))
-;; Complicated because auctex may not be loaded yet.
(defvar ffap-tex-path
t ; delayed initialization
"Path where `ffap-tex-mode' looks for tex files.
(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
- (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")
- ))))))))
+ (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)
- (locate-library name '(".tex" "") ffap-tex-path))
+ (ffap-locate-file name '(".tex" "") ffap-tex-path))
(defun ffap-latex-mode (name)
(ffap-tex-init)
- ;; Any real need for "" here?
- (locate-library name '(".cls" ".sty" ".tex" "")
- ffap-tex-path))
+ ;; only rare need for ""
+ (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
(defun ffap-tex (name)
(ffap-tex-init)
- (locate-library name t ffap-tex-path))
+ (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)
- (locate-library
- name t
- (ffap-list-env "BIBINPUTS" '("/usr/local/lib/tex/macros/bib"))))
+ (ffap-locate-file name t ffap-bib-path))
(defun ffap-dired (name)
(let ((pt (point)) dir try)
(defun ffap-rfc (name)
(format ffap-rfc-path
(substring name (match-beginning 1) (match-end 1))))
+
\f
;;; At-Point Functions:
;; * no commas (good for latex)
(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:
(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))
+ (set-text-properties 0 (length str) nil str)
(setq ffap-string-at-point str)))
(defun ffap-string-around nil
;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
;; ignore non-relative links, trim punctuation. The other will
;; actually look back if point is in whitespace, but I would rather
- ;; ffap be non-rabid in such situations.
+ ;; 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
(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)
(store-match-data data))))
\f
-;;; 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.
ad-do-it))))
\f
-;;; Highlighting:
+;;; Highlighting (`ffap-highlight'):
;;
;; Based on overlay highlighting in Emacs 19.28 isearch.el.
(defvar ffap-highlight (and window-system t)
"If non-nil, ffap highlights the current buffer substring.")
-(defvar ffap-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.
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
+ (ffap-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)))
+ (ffap-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))
- (overlay-put ffap-highlight-overlay 'face
- (if (internal-find-face 'ffap nil)
- 'ffap 'highlight)))))
+ (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)
+ 'ffap 'highlight)))))
\f
-;;; The big enchilada:
+;;; The big cheese (`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))))
;;;###autoload
(defun find-file-at-point (&optional filename)
- "Find FILENAME (or url), guessing default from text around point.
-If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired.
-See also the functions `ffap-file-at-point', `ffap-url-at-point'.
-With a prefix, this command behaves *exactly* like `ffap-file-finder'.
+ "Find FILENAME, guessing a default from text around point.
+If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
+With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
+See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
+and the functions `ffap-file-at-point' and `ffap-url-at-point'.
See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
(interactive)
"no such file or directory"
filename))))))
-;; M-x shortcut:
-;;###autoload
+;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
+;; The defun is for autoload.el; the defalias takes over at load time.
+;;;###autoload
+(defun ffap (&optional filename)
+ "A short alias for the find-file-at-point command.")
(defalias 'ffap 'find-file-at-point)
\f
-;;; Menu support:
-;;
-;; Bind ffap-menu to a key if you want, since it also works in tty mode.
-;; Or just use it through the ffap-at-mouse binding (next section).
+;;; Menu support (`ffap-menu'):
(defvar ffap-menu-regexp nil
"*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
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'.")
(defvar ffap-menu-text-plist
(and window-system
- ;; These choices emulate goto-addr:
- (if ffap-xemacs
- '(face bold highlight t) ; keymap <map>
- '(face bold mouse-face highlight) ; keymap <mousy-map>
- ))
+ '(face bold mouse-face highlight) ; keymap <mousy-map>
+ )
"Text properties applied to strings found by `ffap-menu-rescan'.
These properties may be used to fontify the menu references.")
(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 \(string . data\) ALIST entry defines a choice.
+Function CONT is applied to the entry chosen by the user."
+ ;; Note: this function is used with a different continuation
+ ;; by the ffap-url add-on package.
+ ;; Could try rewriting to use easymenu.el or lmenu.el.
+ (let (choice)
+ (cond
+ ;; Emacs mouse:
+ ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
+ (setq choice
+ (x-popup-menu
+ t
+ (list "" (cons title
+ (mapcar (function (lambda (i) (cons (car i) i)))
+ alist))))))
+ ;; minibuffer with completion buffer:
+ (t
+ (let ((minibuffer-setup-hook 'minibuffer-completion-help))
+ ;; Bug: prompting may assume unique strings, no "".
+ (setq choice
+ (completing-read
+ (format "%s (default %s): " title (car (car alist)))
+ alist nil t
+ ;; (cons (car (car alist)) 0)
+ nil)))
+ (sit-for 0) ; redraw original screen
+ ;; Convert string to its entry, or else the default:
+ (setq choice (or (assoc choice alist) (car alist))))
+ )
+ (if choice
+ (funcall cont choice)
+ (message "No choice made!") ; possible with menus
+ nil)))
(defun ffap-menu-rescan nil
"Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
Applies `ffap-menu-text-plist' text properties at all matches."
(interactive)
(let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
- (range (- (point-max) (point-min))) item
+ (range (- (point-max) (point-min)))
+ (mod (buffer-modified-p)) ; was buffer modified?
buffer-read-only ; to set text-properties
+ item
;; Avoid repeated searches of the *mode-alist:
(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
major-mode
- 'file))
- )
+ '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)))
(lambda (a b) (< (cdr a) (cdr b)))))))
\f
-;;; 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 nothing is found.
+Returns t or nil to indicate success."
(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)
+ t) ; 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.")))
+ ;; failure: return nil
+ )))
\f
-;;; ffap-other-* commands
-;; Suggested by KPC.
+;;; ffap-other-* commands:
+;;
+;; Requested by KPC.
+
+;; There could be a real `ffap-noselect' function, but we would need
+;; at least two new user variables, and there is no w3-fetch-noselect.
+;; So instead, we just fake it with a slow save-window-excursion.
(defun ffap-other-window nil
- "Like `ffap', but put buffer in another window."
+ "Like `ffap', but put buffer in another window.
+Only intended for interactive use."
(interactive)
(switch-to-buffer-other-window
(save-window-excursion (call-interactively 'ffap) (current-buffer))))
(defun ffap-other-frame nil
- "Like `ffap', but put buffer in another frame."
+ "Like `ffap', but put buffer in another frame.
+Only intended for interactive use."
(interactive)
- (switch-to-buffer-other-frame
- (save-window-excursion (call-interactively 'ffap) (current-buffer))))
+ ;; Extra code works around dedicated windows (noted by JENS, 7/96):
+ (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
+ (unwind-protect
+ (progn
+ (set-window-dedicated-p win nil)
+ (switch-to-buffer-other-frame
+ (save-window-excursion
+ (call-interactively 'ffap)
+ (current-buffer))))
+ (set-window-dedicated-p win wdp))))
\f
;;; Bug Reporter:
(let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
"Michelangelo Grigni <mic@mathcs.emory.edu>"
- "ffap 1.6"
+ "ffap" ; version? just rely on Emacs version
(mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
(fset 'ffap-submit-bug 'ffap-bug) ; another likely name
(interactive) (ffap-gnus-wrapper '(ffap-menu)))
\f
-;;; ffap-bindings: offer default global bindings
+;;; 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 "\C-x\C-f" 'find-file-at-point)
- (global-set-key "\C-x4f" 'ffap-other-window)
- (global-set-key "\C-x5f" 'ffap-other-frame)
- (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
- (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
- (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
- (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
- ;; (setq dired-x-hands-off-my-keys t) ; the default
- ))
- "List of forms evaluated by function `ffap-bindings'.
+ '(
+ (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)
-These are only suggestions, they may be modified or ignored.")
+Of course if you do not like these bindings, just roll your own!")
(defun ffap-bindings nil
"Evaluate the forms in variable `ffap-bindings'."
;;
;; (setq ffap-alist ; add something to `ffap-alist'
;; (cons
-;; (cons "^[Yy][Ss][Nn][0-9]+$"
+;; (cons "^YSN[0-9]+$"
;; (defun ffap-ysn (name)
;; (concat
-;; "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
+;; "http://www.physics.uiuc.edu/"
+;; "ysn/httpd/htdocs/ysnarchive/issuefiles/"
;; (substring name 3) ".html")))
;; ffap-alist))
-\f
-;;; 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"))
-
\f
;;; ffap.el ends here
projects / emacs.git / commitdiff