diff options
Diffstat (limited to 'lisp/ffap.el')
| -rw-r--r-- | lisp/ffap.el | 219 |
1 files changed, 87 insertions, 132 deletions
diff --git a/lisp/ffap.el b/lisp/ffap.el index d7544bb5a49..e4017595916 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,6 +1,6 @@ ;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*- -;; Copyright (C) 1995-1997, 2000-2022 Free Software Foundation, Inc. +;; Copyright (C) 1995-2022 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> ;; Maintainer: emacs-devel@gnu.org @@ -24,14 +24,14 @@ ;;; 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 + +;; Command `find-file-at-point' replaces `find-file'. With a prefix, +;; it behaves exactly like find-file. Without a prefix, it first +;; tries to guess a default file or URL from the text around the point ;; (`ffap-require-prefix' swaps these behaviors). This is useful for ;; following references in situations such as mail or news buffers, ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with -;; M-x report-emacs-bug. +;; `M-x report-emacs-bug'. ;; ;; For the default installation, add this line to your init file: ;; @@ -68,44 +68,38 @@ ;; If you do not like these bindings, modify the variable ;; `ffap-bindings', or write your own. ;; -;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best -;; to load or autoload them before ffap. If you use ff-paths, load it -;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many -;; option variables. In particular, if ffap is slow, try these: +;; If you use ange-ftp, it is best to load or autoload it before ffap. +;; If you use ff-paths, load it afterwards. Try apropos `C-h a ffap +;; RET' to get a list of the many option variables. In particular, if +;; ffap is slow, try these: ;; ;; (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-shell-prompt-regexp nil) ; disable shell prompt stripping ;; (setq ffap-gopher-regexp nil) ; disable gopher bookmark matching ;; -;; 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). +;; ffap uses `browse-url' to fetch URLs. ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify ;; the file and URL references within a buffer. +;;; Code: + ;;; 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. +;; The History and Contributors moved to ffap.LOG, which also has some +;; old examples and commentary from ffap 1.5. - ;;; Todo list: ;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file ;; * find file of symbol if TAGS is loaded (like above) ;; * 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' +;; * could replace `ffap-locate-file' with a quieter `locate-library' ;; * handle "$(VAR)" in Makefiles ;; * use the font-lock machinery - -;;; Code: - (eval-when-compile (require 'cl-lib)) (require 'url-parse) (require 'thingatpt) @@ -115,9 +109,6 @@ :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: @@ -174,7 +165,7 @@ well-formed, such as \"user@host\" or \"<user@host>\"." (defcustom ffap-ftp-default-user "anonymous" "User name in FTP file names generated by `ffap-host-to-filename'. Note this name may be omitted if it equals the default -\(either `efs-default-user' or `ange-ftp-default-user')." +(`ange-ftp-default-user')." :type 'string :group 'ffap) @@ -191,7 +182,7 @@ Note this name may be omitted if it equals the default "\\(" "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok "\\|" - "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host + "\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://" ; needs host "\\)") "Regexp matching the beginning of a URI, for ffap. If the value is nil, disable URL-matching features in ffap.") @@ -246,14 +237,12 @@ it passes it on to `dired'." :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-functions'. "Whether `find-file-at-point' prompts about a nonexistent file." :type 'boolean :group 'ffap) +(make-obsolete-variable 'ffap-newfile-prompt 'find-file-not-found-functions "29.1") (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." @@ -261,28 +250,27 @@ ffap most of the time." :group 'ffap) ;;;###autoload -(defcustom ffap-file-finder 'find-file +(defcustom ffap-file-finder #'find-file "The command called by `find-file-at-point' to find a file." :type 'function :group 'ffap :risky t) -(defcustom ffap-directory-finder 'dired +(defcustom ffap-directory-finder #'dired "The command called by `dired-at-point' to find a directory." :type 'function :group 'ffap :risky t) -(defcustom ffap-url-fetcher 'browse-url - "A function of one argument, called by ffap to fetch an URL. -For a fancy alternative, get `ffap-url.el'." +(defcustom ffap-url-fetcher #'browse-url + "A function of one argument, called by ffap to fetch an URL." :type '(choice (const browse-url) function) :group 'ffap :risky t) (defcustom ffap-next-regexp - ;; If you want ffap-next to find URL's only, try this: + ;; If you want ffap-next to find URLs only, try this: ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) ;; (concat "\\<" (substring ffap-url-regexp 2)))) ;; @@ -314,10 +302,6 @@ disable ffap most of the time." ;;; 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-guess nil "Last value returned by `ffap-next-guess'.") @@ -363,7 +347,7 @@ Actual search is done by the function `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 URLs found" (if wrap "" "more "))))) (defun ffap-next-url (&optional back wrap) @@ -377,6 +361,12 @@ Actual search is done by the function `ffap-next-guess'." ;;; Machines (`ffap-machine-p'): +(defun ffap-accept-or-reject-p (symbol) + "Return non-nil if SYMBOL is `accept' or `reject'. +Otherwise, return nil. This is intended for use as the +predicate in the `:safe' property of user options." + (memq symbol '(accept reject))) + ;; 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. @@ -385,16 +375,21 @@ Actual search is done by the function `ffap-next-guess'." Value should be a symbol, one of `ping', `accept', and `reject'." :type '(choice (const ping) (const accept) - (const reject)) + (const reject)) + :safe #'ffap-accept-or-reject-p :group 'ffap) -(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed + +(defcustom ffap-machine-p-known 'accept "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) + (const reject)) + :safe #'ffap-accept-or-reject-p + :group 'ffap + :version "29.1") + (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'. @@ -402,6 +397,7 @@ See `mail-extr.el' for the known domains." :type '(choice (const ping) (const accept) (const reject)) + :safe #'ffap-accept-or-reject-p :group 'ffap) (defun ffap-what-domain (domain) @@ -422,13 +418,6 @@ Returned values: t means that HOST answered. `accept' means the relevant variable told us to accept. \"mesg\" means HOST exists, but does not respond for some reason." - ;; Try some (Emory local): - ;; (ffap-machine-p "ftp" nil nil 'ping) - ;; (ffap-machine-p "nonesuch" nil nil 'ping) - ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping) - ;; (ffap-machine-p "mathcs" 5678 nil 'ping) - ;; (ffap-machine-p "foo.bonk" nil nil 'ping) - ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping) (if (or (string-match "[^-[:alnum:].]" host) ; Invalid chars (?) (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject nil @@ -484,16 +473,13 @@ Returned values: (defun ffap-replace-file-component (fullname name) "In remote FULLNAME, replace path with NAME. May return nil." - ;; Use efs if loaded, but do not load it otherwise. - (if (fboundp 'efs-replace-path-component) - (funcall 'efs-replace-path-component fullname name) - (and (stringp fullname) - (stringp name) - (concat (file-remote-p fullname) name)))) -;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new") + (and (stringp fullname) + (stringp name) + (concat (file-remote-p fullname) name))) (defun ffap-file-suffix (file) "Return trailing `.foo' suffix of FILE, or nil if none." + (declare (obsolete file-name-extension "29.1")) (let ((pos (string-match "\\.[^./]*\\'" file))) (and pos (substring file pos nil)))) @@ -517,7 +503,7 @@ The optional NOMODIFY argument suppresses the extra search." ;; 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) + ((member (file-name-extension file t) ffap-compression-suffixes) nil) (t ; ok, do the search (let ((list ffap-compression-suffixes) try ret) (while list @@ -528,9 +514,6 @@ The optional NOMODIFY argument suppresses the extra search." (defun ffap-file-remote-p (filename) "If FILENAME looks remote, return it (maybe slightly improved)." - ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") - ;; (ffap-file-remote-p "/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://dir" to "/host:/dir", to handle a dying @@ -544,6 +527,7 @@ The optional NOMODIFY argument suppresses the extra search." (string-match ffap-rfs-regexp filename) filename))) +;;;###autoload (defun ffap-machine-at-point () "Return machine name at point if it exists, or nil." (let ((mach (ffap-string-at-point 'machine))) @@ -556,9 +540,8 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." "" (let ((user ffap-ftp-default-user)) ;; Avoid including the user if it is same as default: - (if (or (equal user (ffap-symbol-value 'ange-ftp-default-user)) - (equal user (ffap-symbol-value 'efs-default-user))) - (setq user nil)) + (when (equal user (ffap-symbol-value 'ange-ftp-default-user)) + (setq user nil)) (concat "/" user (and user "@") host ":")))) (defun ffap-fixup-machine (mach) @@ -571,7 +554,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ;; www.ncsa.uiuc.edu ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) (concat "http://" mach "/")) - ;; More cases? Maybe "telnet:" for archie? + ;; More cases? (ffap-ftp-regexp (ffap-host-to-filename mach)) )) @@ -631,18 +614,6 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ;;; File Name Handling: -;; -;; 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) "Return a list of strings parsed from environment variable ENV. @@ -651,7 +622,7 @@ 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 + ;; Similar: 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) @@ -757,8 +728,7 @@ This uses `ffap-file-exists-string', which may try adding suffixes from ;; ;; 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. +;; deferred to the next section, at some loss of "code locality". (defvar ffap-alist '( @@ -769,19 +739,18 @@ This uses `ffap-file-exists-string', which may try adding suffixes from ("\\.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 + (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 + (fortran-mode . ffap-fortran-mode) ("\\.[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| ;; This used to have a blank, but ffap-string-at-point doesn't ;; handle blanks. ;; https://lists.gnu.org/r/emacs-devel/2008-01/msg01058.html @@ -1027,9 +996,8 @@ out of NAME." (match-beginning 1) (match-end 1))))) try)))) -;; Maybe a "Lisp Code Directory" reference: (defun ffap-lcd (name) - ;; FIXME: Is this still in use? + (declare (obsolete nil "29.1")) (and (or ;; lisp-dir-apropos output buffer: @@ -1098,8 +1066,7 @@ Function `ffap-string-at-point' uses the data fields as follows: The arguments CHARS, BEG and END are handled as described in `skip-chars-forward'.") -(defvar ffap-string-at-point nil - ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. +(defvar ffap-string-at-point nil ; for ff-paths "Last string returned by the function `ffap-string-at-point'.") (defcustom ffap-file-name-with-spaces nil @@ -1229,13 +1196,13 @@ If the region is active, return a string from the region. If the point is in a comment, ensure that the returned string does not contain the comment start characters (especially for major modes that -have '//' as comment start characters). +have \"//\" as comment start characters). Set the variables `ffap-string-at-point' and `ffap-string-at-point-region'. When the region is active and larger than `ffap-max-region-length', -return an empty string, and set `ffap-string-at-point-region' to '(1 1)." +return an empty string, and set `ffap-string-at-point-region' to `(1 1)'." (let* (dir-separator (args (cdr @@ -1326,29 +1293,25 @@ Assumes the buffer has not changed." ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region) (message "Copied to kill ring: %s" str)))) -;; External. -(declare-function w3-view-this-url "ext:w3" (&optional no-show)) - +;;;###autoload (defun ffap-url-at-point () "Return URL from around point if it exists, or nil. Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any." (when ffap-url-regexp - (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button? - (w3-view-this-url t)) - (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) - (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix) - val) - (setq val (thing-at-point-url-at-point ffap-lax-url - (if (use-region-p) - (cons (region-beginning) - (region-end))))) - (if val - (let ((bounds (thing-at-point-bounds-of-url-at-point - ffap-lax-url))) - (setq ffap-string-at-point-region - (list (car bounds) (cdr bounds))))) - val)))) + (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) + (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix) + val) + (setq val (thing-at-point-url-at-point ffap-lax-url + (if (use-region-p) + (cons (region-beginning) + (region-end))))) + (if val + (let ((bounds (thing-at-point-bounds-of-url-at-point + ffap-lax-url))) + (setq ffap-string-at-point-region + (list (car bounds) (cdr bounds))))) + val))) (defvar ffap-gopher-regexp "\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *" @@ -1449,10 +1412,13 @@ which may actually result in an URL rather than a filename." (ffap-file-exists-string (substring name 0 (match-beginning 0))))) ;; If it contains a colon, get rid of it (and return if exists) ((and (string-match path-separator name) - (setq name (ffap-string-at-point 'nocolon)) - (> (length name) 0) - (ffap-file-exists-string name))) - ;; File does not exist, try the alist: + (let ((this-name (ffap-string-at-point 'nocolon))) + ;; But don't interpret the first part if ":/bin" as + ;; the empty string. + (when (> (length this-name) 0) + (setq name this-name) + (ffap-file-exists-string name))))) + ;; File does not exist, try the alist: ((let ((alist ffap-alist) tem try case-fold-search) (while (and alist (not try)) (setq tem (car alist) alist (cdr alist)) @@ -1486,12 +1452,7 @@ which may actually result in an URL rather than a filename." ((and (eq major-mode 'internal-ange-ftp-mode) (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$" (buffer-name))) - (concat "/" (substring (buffer-name) 5 -1) ":")) - ;; This is too often a bad idea: - ;;((and (eq major-mode 'w3-mode) - ;; (stringp url-current-server)) - ;; (host-to-ange-path url-current-server)) - ))) + (concat "/" (substring (buffer-name) 5 -1) ":"))))) (and remote-dir (or (and (string-match "\\`\\(/?~?ftp\\)/" name) @@ -1557,12 +1518,6 @@ which may actually result in an URL rather than a filename." ;; during the completing-read call). (setq file-name-handler-alist (delq elem file-name-handler-alist))))) -;; The rest of this page is just to work with package complete.el. -;; This code assumes that you load ffap.el after complete.el. -;; -;; We must inform complete about whether our completion function -;; will do filename style completion. - ;;; Highlighting (`ffap-highlight'): @@ -1638,7 +1593,7 @@ Uses the face `ffap' if it is defined, or else `highlight'." 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', +See also the variables `ffap-dired-wildcards', `ffap-url-unwrap-local', `ffap-url-unwrap-remote', `ffap-file-name-with-spaces', and the functions `ffap-file-at-point' and `ffap-url-at-point'." @@ -1669,14 +1624,14 @@ and `ffap-url-at-point'." (file-exists-p filename) (y-or-n-p "File does not exist, create buffer? ")) (find-file - ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. + ;; expand-file-name fixes "~/~/.emacs" bug (expand-file-name filename))) ;; User does not want to find a non-existent file: ((signal 'file-missing (list "Opening file buffer" "No such file or directory" filename))))))) -;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. +;; Shortcut: allow `M-x ffap' rather than `M-x find-file-at-point'. ;;;###autoload (defalias 'ffap 'find-file-at-point) @@ -1819,7 +1774,7 @@ Applies `ffap-menu-text-plist' text properties at all matches." ;;; Mouse Support (`ffap-at-mouse'): ;; -;; See the suggested binding in ffap-bindings (near eof). +;; See the suggested binding in `ffap-bindings' (near eof). (defvar ffap-at-mouse-fallback nil ; ffap-menu? too time-consuming "Command invoked by `ffap-at-mouse' if nothing found at click, or nil. @@ -1865,7 +1820,7 @@ Return value: ;;; 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. +;; at least two new user variables. ;; So instead, we just fake it with a slow save-window-excursion. (defun ffap-other-window (filename) @@ -1880,7 +1835,7 @@ Only intended for interactive use." "Like `ffap', but put buffer in another frame. Only intended for interactive use." (interactive (list (ffap-prompter nil " other frame"))) - ;; Extra code works around dedicated windows (noted by JENS, 7/96): + ;; Extra code works around dedicated windows: (let* ((win (selected-window)) (wdp (window-dedicated-p win)) value) @@ -2107,7 +2062,7 @@ Only intended for interactive use." "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): + ;; Extra code works around dedicated windows: (let* ((win (selected-window)) (wdp (window-dedicated-p win)) value) |