;;; ffap.el --- find file (or url) at point
-;; Copyright (C) 1995-1997, 2000-2012 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
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 URLs. Use 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)))))
(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-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)))
+ (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
;; * 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)
(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)
- ))))
+ (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-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\\) *= *\\(.*\\) *$"
(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 URLs from history, treating given string as valid."
(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'.")
(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))
(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)
(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)