;;; ffap.el --- find file (or url) at point
-;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Maintainer: FSF
;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
;; M-x ffap-bug.
;;
-;; For the default installation, add this line to your .emacs file:
+;; For the default installation, add this line to your init file:
;;
;; (ffap-bindings) ; do default key bindings
;;
\f
;;; Code:
+(require 'url-parse)
+(require 'thingatpt)
+
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
(defgroup ffap nil
;; after them. The common root shell prompt (#) is not listed since it
;; also doubles up as a valid URL character.
"[$%><]*"
- "Paths matching this regexp are stripped off the shell prompt
+ "Paths matching this regexp are stripped off the shell prompt.
If nil, ffap doesn't do shell prompt stripping."
:type '(choice (const :tag "Disable" nil)
(const :tag "Standard" "[$%><]*")
regexp)
:group 'ffap)
-(defcustom ffap-ftp-regexp
- ;; This used to test for ange-ftp or efs being present, but it should be
- ;; harmless (and simpler) to give it this value unconditionally.
- "\\`/[^/:]+:"
+(defcustom ffap-ftp-regexp "\\`/[^/:]+:"
"File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names."
:type '(choice (const :tag "Disable" nil)
:group 'ffap)
(defcustom ffap-url-unwrap-local t
- "If non-nil, convert `file:' URL to local file name before prompting."
+ "If non-nil, convert some URLs to local file names before prompting.
+Only \"file:\" and \"ftp:\" URLs are converted, and only if they
+do not specify a host, or the host is either \"localhost\" or
+equal to `system-name'."
:type 'boolean
:group 'ffap)
-(defcustom ffap-url-unwrap-remote t
- "If non-nil, convert `ftp:' URL to remote file name before prompting.
-This is ignored if `ffap-ftp-regexp' is nil."
- :type 'boolean
- :group 'ffap)
+(defcustom ffap-url-unwrap-remote '("ftp")
+ "If non-nil, convert URLs to remote file names before prompting.
+If the value is a list of strings, that specifies a list of URL
+schemes (e.g. \"ftp\"); in that case, only convert those URLs."
+ :type '(choice (repeat string) boolean)
+ :group 'ffap
+ :version "24.3")
(defcustom ffap-ftp-default-user "anonymous"
"User name in ftp file names generated by `ffap-host-to-path'.
:group 'ffap)
(defvar ffap-url-regexp
- ;; Could just use `url-nonrelative-link' of w3, if loaded.
- ;; This regexp is not exhaustive, it just matches common cases.
(concat
- "\\`\\("
+ "\\("
"news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
"\\|"
"\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
- "\\)." ; require one more character
- )
- "Regexp matching URL's. nil to disable URL features in ffap.")
+ "\\)")
+ "Regexp matching the beginning of a URI, for FFAP.
+If the value is nil, disable URL-matching features in ffap.")
(defcustom ffap-foo-at-bar-prefix "mailto"
"Presumed URL prefix type of strings like \"<foo.9z@bar>\".
;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them. Read
;; through this section for features that you like, put an appropriate
-;; enabler in your .emacs file.
+;; enabler in your init file.
(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
"A regexp matching filename wildcard characters, or nil.
(defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file."
:type 'function
- :group 'ffap)
-(put 'ffap-file-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-directory-finder 'dired
"The command called by `dired-at-point' to find a directory."
:type 'function
- :group 'ffap)
-(put 'ffap-directory-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-url-fetcher
(if (fboundp 'browse-url)
(const browse-url-netscape)
(const browse-url-mosaic)
function)
+ :group 'ffap
+ :risky t)
+
+(defcustom ffap-next-regexp
+ ;; If you want ffap-next to find URL's only, try this:
+ ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
+ ;; (concat "\\<" (substring ffap-url-regexp 2))))
+ ;;
+ ;; It pays to put a big fancy regexp here, since ffap-guesser is
+ ;; much more time-consuming than regexp searching:
+ "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
+ "Regular expression governing movements of `ffap-next'."
+ :type 'regexp
:group 'ffap)
-(put 'ffap-url-fetcher 'risky-local-variable t)
+
+(defcustom dired-at-point-require-prefix nil
+ "If non-nil, reverse the prefix argument to `dired-at-point'.
+This is nil so neophytes notice FFAP. Experts may prefer to
+disable FFAP most of the time."
+ :type 'boolean
+ :group 'ffap
+ :version "20.3")
\f
;;; Compatibility:
;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command). It now work on files as well as url's.
-(defcustom ffap-next-regexp
- ;; If you want ffap-next to find URL's only, try this:
- ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
- ;; (concat "\\<" (substring ffap-url-regexp 2))))
- ;;
- ;; It pays to put a big fancy regexp here, since ffap-guesser is
- ;; much more time-consuming than regexp searching:
- "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
- "Regular expression governing movements of `ffap-next'."
- :type 'regexp
- :group 'ffap)
-
(defvar ffap-next-guess nil
"Last value returned by `ffap-next-guess'.")
(defvar ffap-string-at-point-region '(1 1)
- "List (BEG END), last region returned by `ffap-string-at-point'.")
+ "List (BEG END), last region returned by the function `ffap-string-at-point'.")
(defun ffap-next-guess (&optional back lim)
"Move point to next file or URL, and return it as a string.
Optional argument WRAP says to try wrapping around if necessary.
Interactively: use a single prefix to search backwards,
double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by `ffap-next-guess'."
+Actual search is done by the function `ffap-next-guess'."
(interactive
(cdr (assq (prefix-numeric-value current-prefix-arg)
'((1) (4 t) (16 nil t) (64 t t)))))
(let ((mesg (car (cdr error))))
(cond
;; v18:
- ((string-match "^Unknown host" mesg) nil)
+ ((string-match "\\(^Unknown host\\|Name or service not known$\\)"
+ mesg) nil)
((string-match "not responding$" mesg) mesg)
;; v19:
;; (file-error "connection failed" "permission denied"
(defun ffap-replace-file-component (fullname name)
"In remote FULLNAME, replace path with NAME. May return nil."
- ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
- (let (found)
- (mapc
- (function (lambda (sym) (and (fboundp sym) (setq found sym))))
- '(
- efs-replace-path-component
- ange-ftp-replace-path-component
- ange-ftp-replace-name-component
- ))
- (and found
- (fset 'ffap-replace-file-component found)
- (funcall found fullname name))))
+ ;; 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")
(defun ffap-file-suffix (file)
;; (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 dieing
+ ;; Convert "/host.com://dir" to "/host:/dir", to handle a dying
;; practice of advertising ftp files as "host.dom://filename".
(if (string-match "//" filename)
;; (replace-match "/" nil nil filename)
(ffap-ftp-regexp (ffap-host-to-filename mach))
))
-(defvar ffap-newsgroup-regexp "^[[:lower:]]+\\.[-+[:lower:]_0-9.]+$"
- "Strings not matching this fail `ffap-newsgroup-p'.")
-(defvar ffap-newsgroup-heads ; entirely inadequate
- '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
- "Used by `ffap-newsgroup-p' if gnus is not running.")
-
-(defun ffap-newsgroup-p (string)
- "Return STRING if it looks like a newsgroup name, else nil."
- (and
- (string-match ffap-newsgroup-regexp string)
- (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
- (heads ffap-newsgroup-heads)
- htb ret)
- (while htbs
- (setq htb (car htbs) htbs (cdr htbs))
- (condition-case nil
- (progn
- ;; errs: htb symbol may be unbound, or not a hash-table.
- ;; gnus-gethash is just a macro for intern-soft.
- (and (symbol-value htb)
- (intern-soft string (symbol-value htb))
- (setq ret string htbs nil))
- ;; If we made it this far, gnus is running, so ignore "heads":
- (setq heads nil))
- (error nil)))
- (or ret (not heads)
- (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string)))
- (and head (setq head (substring string 0 (match-end 1)))
- (member head heads)
- (setq ret string))))
- ;; Is there ever a need to modify string as a newsgroup name?
- ret)))
+(defvaralias 'ffap-newsgroup-regexp 'thing-at-point-newsgroup-regexp)
+(defvaralias 'ffap-newsgroup-heads 'thing-at-point-newsgroup-heads)
+(defalias 'ffap-newsgroup-p 'thing-at-point-newsgroup-p)
(defsubst ffap-url-p (string)
- "If STRING looks like an url, return it (maybe improved), else nil."
- (let ((case-fold-search t))
- (and ffap-url-regexp (string-match ffap-url-regexp string)
- ;; I lied, no improvement:
- string)))
+ "If STRING looks like an URL, return it (maybe improved), else nil."
+ (when (and (stringp string) ffap-url-regexp)
+ (let* ((case-fold-search t)
+ (match (string-match ffap-url-regexp string)))
+ (cond ((eq match 0) string)
+ (match (substring string match))))))
;; Broke these out of ffap-fixup-url, for use of ffap-url package.
-(defsubst ffap-url-unwrap-local (url)
- "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
- (substring url (1+ (match-end 1)))))
-(defsubst ffap-url-unwrap-remote (url)
- "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
- (concat
- (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
- (substring url (match-beginning 3) (match-end 3)))))
-;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
+(defun ffap-url-unwrap-local (url)
+ "Return URL as a local file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (host (url-host obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member (url-type obj) '("ftp" "file"))
+ (member host `("" "localhost" ,(system-name))))
+ ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ (string-match "\\`/[a-zA-Z]:" filename))
+ (substring filename 1)
+ filename))))
+
+(defun ffap-url-unwrap-remote (url)
+ "Return URL as a remote file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (scheme (url-type obj))
+ (valid-schemes (if (listp ffap-url-unwrap-remote)
+ ffap-url-unwrap-remote
+ '("ftp")))
+ (host (url-host obj))
+ (port (url-port-if-non-default obj))
+ (user (url-user obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member scheme valid-schemes)
+ (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme)
+ (not (equal host "")))
+ (concat "/" scheme ":"
+ (if user (concat user "@"))
+ host
+ (if port (concat "#" (number-to-string port)))
+ ":" filename))))
(defun ffap-fixup-url (url)
"Clean up URL and return it, maybe as a file name."
(cond
((not (stringp url)) nil)
- ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
- ((and ffap-url-unwrap-remote ffap-ftp-regexp
- (ffap-url-unwrap-remote url)))
- ;; All this seems to do is remove any trailing "#anchor" part (Bug#898).
-;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
-;;; (url-normalize-url url))
+ ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
+ ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
(url)))
\f
(nreverse ret)))
(defun ffap-all-subdirs (dir &optional depth)
- "Return list all subdirectories under DIR, starting with itself.
+ "Return list of 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."
;; (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
+ (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
(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
+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
KEY is a symbol, and it equals `major-mode', or
- KEY is a string, it should matches NAME as a regexp.
+ KEY is a string, it should match NAME as a regexp.
On a match, \(FUNCTION NAME\) is called and should return a file, an
-url, or nil. If nil, search the alist for further matches.")
+URL, or nil. If nil, search the alist for further matches.")
(put 'ffap-alist 'risky-local-variable t)
(and (not (string-match "\\.el\\'" name))
(ffap-locate-file name '(".el") load-path)))
+;; FIXME this duplicates the logic of Man-header-file-path.
+;; There should be a single central variable or function for this.
+;; See also (bug#10702):
+;; cc-search-directories, semantic-c-dependency-system-include-path,
+;; semantic-gcc-setup
(defvar ffap-c-path
- ;; Need smarter defaults here! Suggestions welcome.
- '("/usr/include" "/usr/local/include"))
+ (let ((arch (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "gcc" nil '(t nil) nil
+ "-print-multiarch")))
+ (goto-char (point-min))
+ (buffer-substring (point) (line-end-position)))))
+ (base '("/usr/include" "/usr/local/include")))
+ (if (zerop (length arch))
+ base
+ (append base (list (expand-file-name arch "/usr/include")))))
+ "List of directories to search for include files.")
+
(defun ffap-c-mode (name)
(ffap-locate-file name t ffap-c-path))
+(defvar ffap-c++-path
+ (let ((c++-include-dir (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "g++" nil t nil "-v")))
+ (goto-char (point-min))
+ (if (re-search-forward "--with-gxx-include-dir=\
+\\([^[:space:]]+\\)"
+ nil 'noerror)
+ (match-string 1)
+ (when (re-search-forward "gcc version \
+\\([[:digit:]]+.[[:digit:]]+.[[:digit:]]+\\)"
+ nil 'noerror)
+ (expand-file-name (match-string 1)
+ "/usr/include/c++/")))))))
+ (if c++-include-dir
+ (cons c++-include-dir ffap-c-path)
+ ffap-c-path))
+ "List of directories to search for include files.")
+
+(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)
(defvar ffap-tex-path
t ; delayed initialization
- "Path where `ffap-tex-mode' looks for tex files.
+ "Path where `ffap-tex-mode' looks for TeX files.
If t, `ffap-tex-init' will initialize this when needed.")
(defun ffap-tex-init ()
;; * no commas (good for latex)
(file "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
;; An url, or maybe a email/news message-id:
- (url "--:=&?$+@-Z_[:alpha:]~#,%;*" "^[:alnum:]" ":;.,!?")
+ (url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
;; Find a string that does *not* contain a colon:
(nocolon "--9$+<>@-Z_[:alpha:]~" "<@" "@>;.,!?")
;; A machine:
"Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
possibly a major-mode name, or one of the symbol
`file', `url', `machine', and `nocolon'.
-`ffap-string-at-point' uses the data fields as follows:
+Function `ffap-string-at-point' uses the data fields as follows:
1. find a maximal string of CHARS around point,
2. strip BEG chars before point from the beginning,
-3. Strip END chars after point from the end.")
+3. strip END chars after point from the end.")
(defvar ffap-string-at-point nil
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
- "Last string returned by `ffap-string-at-point'.")
+ "Last string returned by the function `ffap-string-at-point'.")
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
syntax parameters in `ffap-string-at-point-mode-alist'.
If MODE is not found, we use `file' instead of MODE.
If the region is active, return a string from the region.
-Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
+Sets the variable `ffap-string-at-point' and the variable
+`ffap-string-at-point-region'."
(let* ((args
(cdr
(or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
(assq 'file ffap-string-at-point-mode-alist))))
(pt (point))
- (str
- (if (and transient-mark-mode mark-active)
- (buffer-substring
- (setcar ffap-string-at-point-region (region-beginning))
- (setcar (cdr ffap-string-at-point-region) (region-end)))
- (buffer-substring
- (save-excursion
- (skip-chars-backward (car args))
- (skip-chars-forward (nth 1 args) pt)
- (setcar ffap-string-at-point-region (point)))
- (save-excursion
- (skip-chars-forward (car args))
- (skip-chars-backward (nth 2 args) pt)
- (setcar (cdr ffap-string-at-point-region) (point)))))))
- (set-text-properties 0 (length str) nil str)
- (setq ffap-string-at-point str)))
+ (beg (if (use-region-p)
+ (region-beginning)
+ (save-excursion
+ (skip-chars-backward (car args))
+ (skip-chars-forward (nth 1 args) pt)
+ (point))))
+ (end (if (use-region-p)
+ (region-end)
+ (save-excursion
+ (skip-chars-forward (car args))
+ (skip-chars-backward (nth 2 args) pt)
+ (point)))))
+ (setq ffap-string-at-point
+ (buffer-substring-no-properties
+ (setcar ffap-string-at-point-region beg)
+ (setcar (cdr ffap-string-at-point-region) end)))))
(defun ffap-string-around ()
;; Sometimes useful to decide how to treat a string.
- "Return string of two chars around last `ffap-string-at-point'.
+ "Return string of two chars around last result of function
+`ffap-string-at-point'.
Assumes the buffer has not changed."
(save-excursion
(format "%c%c"
(defun ffap-copy-string-as-kill (&optional mode)
;; Requested by MCOOK. Useful?
- "Call `ffap-string-at-point', and copy result to `kill-ring'."
+ "Call function `ffap-string-at-point', and copy result to `kill-ring'."
(interactive)
(let ((str (ffap-string-at-point mode)))
(if (equal "" str)
(declare-function w3-view-this-url "ext:w3" (&optional no-show))
(defun ffap-url-at-point ()
- "Return url from around point if it exists, or 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 less aggressive in such situations.
- (and
- ffap-url-regexp
- (or
- ;; 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)))
- (cond
- ((string-match "^url:" name) (setq name (substring name 4)))
- ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
- ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
- ;; Without "<>" it must be "mailto". Otherwise could be
- ;; either, so consult `ffap-foo-at-bar-prefix'.
- (let ((prefix (if (and (equal (ffap-string-around) "<>")
- ;; Expect some odd characters:
- (string-match "[$.0-9].*[$.0-9].*@" name))
- ;; Could be news:
- ffap-foo-at-bar-prefix
- "mailto")))
- (and prefix (setq name (concat prefix ":" name))))))
- ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
- ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
- (equal (ffap-string-around) "<>")
- ;; (ffap-user-p name):
- (not (string-match "~" (expand-file-name (concat "~" name))))
- )
- (setq name (concat "mailto:" name)))
- )
- (and (ffap-url-p name) name)
- ))))
+ "Return URL from around point if it exists, or nil."
+ (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))
+ (thing-at-point-url-at-point t
+ (if (use-region-p)
+ (cons (region-beginning)
+ (region-end))))))))
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
- "Regexp Matching a line in a gopher bookmark (maybe indented).
+ "Regexp matching a line in a gopher bookmark (maybe indented).
The two subexpressions are the KEY and VALUE.")
(defun ffap-gopher-at-point ()
- "If point is inside a gopher bookmark block, return its url."
+ "If point is inside a gopher bookmark block, return its URL."
;; `gopher-parse-bookmark' from gopher.el is not so robust
(save-excursion
(beginning-of-line)
"Return filename from around point if it exists, or nil.
Existence test is skipped for names that look remote.
If the filename is not obvious, it also tries `ffap-alist',
-which may actually result in an url rather than a filename."
+which may actually result in an URL rather than a filename."
;; Note: this function does not need to look for url's, just
;; filenames. On the other hand, it is responsible for converting
;; a pseudo-url "site.com://dir" to an ftp file name
;; contents before attempting to complete filenames.
(defun ffap-read-file-or-url (prompt guess)
- "Read file or url from minibuffer, with PROMPT and initial GUESS."
+ "Read file or URL from minibuffer, with PROMPT and initial GUESS."
(or guess (setq guess default-directory))
(let (dir)
;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
;; or "w3/" or "../el/ffap.el" or "../../../"
- (or (ffap-url-p guess)
- (progn
- (or (ffap-file-remote-p guess)
- (setq guess
- (abbreviate-file-name (expand-file-name guess))
- ))
- (setq dir (file-name-directory guess))))
+ (unless (ffap-url-p guess)
+ (unless (ffap-file-remote-p guess)
+ (setq guess
+ (abbreviate-file-name (expand-file-name guess))))
+ (setq dir (file-name-directory guess)))
(let ((minibuffer-completing-file-name t)
(completion-ignore-case read-file-name-completion-ignore-case)
(fnh-elem (cons ffap-url-regexp 'url-file-handler)))
;; other modifications to be lost (e.g. when Tramp gets loaded
;; during the completing-read call).
(setq file-name-handler-alist (delq fnh-elem file-name-handler-alist))))
- ;; Do file substitution like (interactive "F"), suggested by MCOOK.
- (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
- ;; Should not do it on url's, where $ is a common (VMS?) character.
- ;; Note: upcoming url.el package ought to handle this automatically.
- guess))
+ (or (ffap-url-p guess)
+ (substitute-in-file-name guess))))
(defun ffap-read-url-internal (string pred action)
- "Complete url's from history, treating given string as valid."
+ "Complete URLs from history, treating given string as valid."
(let ((hist (ffap-symbol-value 'url-global-history-hash-table)))
(cond
((not action)
(t t))))
(defun ffap-read-file-or-url-internal (string pred action)
- (unless string ;Why would this ever happen?
- (setq string default-directory))
- (if (ffap-url-p string)
- (ffap-read-url-internal string pred action)
- (read-file-name-internal string pred action)))
+ (let ((url (ffap-url-p string)))
+ (if url
+ (ffap-read-url-internal url pred action)
+ (read-file-name-internal (or string default-directory) pred action))))
;; 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.
-(defun ffap-complete-as-file-p ()
- ;; Will `minibuffer-completion-table' complete the minibuffer
- ;; contents as a filename? Assumes the minibuffer is current.
- ;; Note: t and non-nil mean somewhat different reasons.
- (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
- (not (ffap-url-p (buffer-string))) ; t
- (and minibuffer-completing-file-name '(t)))) ;list
-
-(and
- (featurep 'complete)
- (if (boundp 'PC-completion-as-file-name-predicate)
- ;; modern version of complete.el, just set the variable:
- (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))
-
\f
;;; Highlighting (`ffap-highlight'):
-;;
-;; Based on overlay highlighting in Emacs 19.28 isearch.el.
(defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.")
:version "22.1")
(defvar ffap-highlight-overlay nil
- "Overlay used by `ffap-highlight'.")
+ "Overlay used by function `ffap-highlight'.")
(defun ffap-highlight (&optional remove)
"If `ffap-highlight' is set, highlight the guess in this buffer.
(let (current-prefix-arg) ; we already interpreted it
(call-interactively ffap-file-finder))
(or filename (setq filename (ffap-prompter)))
- (cond
- ((ffap-url-p filename)
- (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
- (funcall ffap-url-fetcher filename)))
- ((and ffap-pass-wildcards-to-dired
- ffap-dired-wildcards
- (string-match ffap-dired-wildcards filename))
- (funcall ffap-directory-finder filename))
- ((and ffap-dired-wildcards
- (string-match ffap-dired-wildcards filename)
- find-file-wildcards
- ;; Check if it's find-file that supports wildcards arg
- (memq ffap-file-finder '(find-file find-alternate-file)))
- (funcall ffap-file-finder (expand-file-name filename) t))
- ((or (not ffap-newfile-prompt)
- (file-exists-p filename)
- (y-or-n-p "File does not exist, create buffer? "))
- (funcall ffap-file-finder
- ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
- (expand-file-name filename)))
- ;; User does not want to find a non-existent file:
- ((signal 'file-error (list "Opening file buffer"
- "no such file or directory"
- filename))))))
+ (let ((url (ffap-url-p filename)))
+ (cond
+ (url
+ (let (current-prefix-arg)
+ (funcall ffap-url-fetcher url)))
+ ((and ffap-pass-wildcards-to-dired
+ ffap-dired-wildcards
+ (string-match ffap-dired-wildcards filename))
+ (funcall ffap-directory-finder filename))
+ ((and ffap-dired-wildcards
+ (string-match ffap-dired-wildcards filename)
+ find-file-wildcards
+ ;; Check if it's find-file that supports wildcards arg
+ (memq ffap-file-finder '(find-file find-alternate-file)))
+ (funcall ffap-file-finder (expand-file-name filename) t))
+ ((or (not ffap-newfile-prompt)
+ (file-exists-p filename)
+ (y-or-n-p "File does not exist, create buffer? "))
+ (funcall ffap-file-finder
+ ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
+ (expand-file-name filename)))
+ ;; User does not want to find a non-existent file:
+ ((signal 'file-error (list "Opening file buffer"
+ "no such file or directory"
+ filename)))))))
;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
;;;###autoload
\f
;;; Menu support (`ffap-menu'):
-(defvar ffap-menu-regexp nil
- "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
+(defcustom ffap-menu-regexp nil
+ "If non-nil, regexp overriding `ffap-next-regexp' in `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."
+ :type '(choice (const nil) regexp)
+ :group 'ffap)
(defvar ffap-menu-alist nil
"Buffer local cache of menu presented by `ffap-menu'.")
;;;###autoload
(defun ffap-menu (&optional rescan)
- "Put up a menu of files and urls mentioned in this buffer.
+ "Put up a menu of files and URLs mentioned in this buffer.
Then set mark, jump to choice, and try to fetch it. The menu is
cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
The optional RESCAN argument \(a prefix, interactively\) forces
;;;###autoload
(defun ffap-at-mouse (e)
- "Find file or url guessed from text around mouse click.
+ "Find file or URL guessed from text around mouse click.
Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
Return value:
* if a guess string is found, return it (after finding it)
((called-interactively-p 'interactive)
(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
)))
(set-window-dedicated-p win wdp))
value))
+(defun ffap--toggle-read-only (buffer-or-list)
+ (dolist (buffer (if (listp buffer-or-list)
+ buffer-or-list
+ (list buffer-or-list)))
+ (with-current-buffer buffer
+ (read-only-mode 1))))
+
(defun ffap-read-only ()
"Like `ffap', but mark buffer as read-only.
Only intended for interactive use."
(let ((value (call-interactively 'ffap)))
(unless (or (bufferp value) (bufferp (car-safe value)))
(setq value (current-buffer)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-window ()
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-window)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-frame ()
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-frame)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-alternate-file ()
(call-interactively 'ffap)))
(defun ffap-literally ()
- "Like `ffap' and `find-file-literally'.
+ "Like `ffap' and command `find-file-literally'.
Only intended for interactive use."
(interactive)
(let ((ffap-file-finder 'find-file-literally))
(defun ffap-ro-mode-hook ()
"Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
(local-set-key "\M-l" 'ffap-next)
- (local-set-key "\M-m" 'ffap-menu)
- )
+ (local-set-key "\M-m" 'ffap-menu))
(defun ffap-gnus-hook ()
"Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
- (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
+ ;; message-id's
+ (setq-local thing-at-point-default-mail-uri-scheme "news")
;; Note "l", "L", "m", "M" are taken:
(local-set-key "\M-l" 'ffap-gnus-next)
(local-set-key "\M-m" 'ffap-gnus-menu))
;; Preserve selected buffer, but do not do save-window-excursion,
;; since we want to see any window created by the form. Temporarily
;; select the article buffer, so we can see any point movement.
- (let ((sb (window-buffer (selected-window))))
+ (let ((sb (window-buffer)))
(gnus-configure-windows 'article)
(pop-to-buffer gnus-article-buffer)
(widen)
(interactive) (ffap-gnus-wrapper '(ffap-menu)))
\f
-(defcustom dired-at-point-require-prefix nil
- "If set, reverses the prefix argument to `dired-at-point'.
-This is nil so neophytes notice ffap. Experts may prefer to disable
-ffap most of the time."
- :type 'boolean
- :group 'ffap
- :version "20.3")
;;;###autoload
(defun dired-at-point (&optional filename)
- "Start Dired, defaulting to file at point. See `ffap'."
+ "Start Dired, defaulting to file at point. See `ffap'.
+If `dired-at-point-require-prefix' is set, the prefix meaning is reversed."
(interactive)
(if (and (called-interactively-p 'interactive)
(if dired-at-point-require-prefix
(let (current-prefix-arg) ; already interpreted
(call-interactively ffap-directory-finder))
(or filename (setq filename (dired-at-point-prompter)))
- (cond
- ((ffap-url-p filename)
- (funcall ffap-url-fetcher filename))
- ((and ffap-dired-wildcards
- (string-match ffap-dired-wildcards filename))
- (funcall ffap-directory-finder filename))
- ((file-exists-p filename)
- (if (file-directory-p filename)
+ (let ((url (ffap-url-p filename)))
+ (cond
+ (url
+ (funcall ffap-url-fetcher url))
+ ((and ffap-dired-wildcards
+ (string-match ffap-dired-wildcards filename))
+ (funcall ffap-directory-finder filename))
+ ((file-exists-p filename)
+ (if (file-directory-p filename)
+ (funcall ffap-directory-finder
+ (expand-file-name filename))
(funcall ffap-directory-finder
- (expand-file-name filename))
- (funcall ffap-directory-finder
- (concat (expand-file-name filename) "*"))))
- ((and (file-writable-p
- (or (file-name-directory (directory-file-name filename))
- filename))
- (y-or-n-p "Directory does not exist, create it? "))
- (make-directory filename)
- (funcall ffap-directory-finder filename))
- ((error "No such file or directory `%s'" filename)))))
+ (concat (expand-file-name filename) "*"))))
+ ((and (file-writable-p
+ (or (file-name-directory (directory-file-name filename))
+ filename))
+ (y-or-n-p "Directory does not exist, create it? "))
+ (make-directory filename)
+ (funcall ffap-directory-finder filename))
+ ((error "No such file or directory `%s'" filename))))))
(defun dired-at-point-prompter (&optional guess)
;; Does guess and prompt step for find-file-at-point.
(ffap-url-regexp "Dired file or URL: ")
(t "Dired file: "))
(prog1
- (setq guess (or guess
- (let ((guess (ffap-guesser)))
- (if (or (not guess)
- (ffap-url-p guess)
- (ffap-file-remote-p guess))
- guess
- (setq guess (abbreviate-file-name
- (expand-file-name guess)))
- (cond
- ;; Interpret local directory as a directory.
- ((file-directory-p guess)
- (file-name-as-directory guess))
- ;; Get directory component from local files.
- ((file-regular-p guess)
- (file-name-directory guess))
- (guess))))
- ))
+ (setq guess
+ (let ((guess (or guess (ffap-guesser))))
+ (cond
+ ((null guess) nil)
+ ((ffap-url-p guess))
+ ((ffap-file-remote-p guess)
+ guess)
+ ((progn
+ (setq guess (abbreviate-file-name
+ (expand-file-name guess)))
+ ;; Interpret local directory as a directory.
+ (file-directory-p guess))
+ (file-name-as-directory guess))
+ ;; Get directory component from local files.
+ ((file-regular-p guess)
+ (file-name-directory guess))
+ (guess))))
(and guess (ffap-highlight))))
(ffap-highlight t)))
\f
;;; Hooks to put in `file-name-at-point-functions':
;;;###autoload
-(progn (defun ffap-guess-file-name-at-point ()
+(defun ffap-guess-file-name-at-point ()
"Try to get a file name at point.
This hook is intended to be put in `file-name-at-point-functions'."
- (when (fboundp 'ffap-guesser)
- ;; Logic from `ffap-read-file-or-url' and `dired-at-point-prompter'.
- (let ((guess (ffap-guesser)))
- (setq guess
- (if (or (not guess)
- (and (fboundp 'ffap-url-p)
- (ffap-url-p guess))
- (and (fboundp 'ffap-file-remote-p)
- (ffap-file-remote-p guess)))
- guess
- (abbreviate-file-name (expand-file-name guess))))
- (when guess
- (if (file-directory-p guess)
- (file-name-as-directory guess)
- guess))))))
-
+ (let ((guess (ffap-guesser)))
+ (when (stringp guess)
+ (let ((url (ffap-url-p guess)))
+ (or url
+ (progn
+ (unless (ffap-file-remote-p guess)
+ (setq guess
+ (abbreviate-file-name (expand-file-name guess))))
+ (if (file-directory-p guess)
+ (file-name-as-directory guess)
+ guess)))))))
\f
;;; Offer default global bindings (`ffap-bindings'):
(defvar ffap-bindings
- '(
- (global-set-key [S-mouse-3] 'ffap-at-mouse)
+ '((global-set-key [S-mouse-3] 'ffap-at-mouse)
(global-set-key [C-S-mouse-3] 'ffap-menu)
(global-set-key "\C-x\C-f" 'find-file-at-point)
(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
- )
+ (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook))
"List of binding forms evaluated by function `ffap-bindings'.
A reasonable ffap installation needs just this one line:
(ffap-bindings)
\f
(provide 'ffap)
-;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc
;;; ffap.el ends here