diff options
Diffstat (limited to 'lisp/ffap.el')
| -rw-r--r-- | lisp/ffap.el | 232 |
1 files changed, 118 insertions, 114 deletions
diff --git a/lisp/ffap.el b/lisp/ffap.el index 52ffc9905ed..a8455189cb9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -105,6 +105,8 @@ ;;; Code: +(require 'url-parse) + (define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2") (defgroup ffap nil @@ -136,10 +138,7 @@ If nil, ffap doesn't do shell prompt stripping." 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) @@ -148,15 +147,20 @@ If nil, ffap neither recognizes nor generates such names." :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.2") (defcustom ffap-ftp-default-user "anonymous" "User name in ftp file names generated by `ffap-host-to-path'. @@ -247,14 +251,14 @@ ffap most of the time." (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) @@ -271,8 +275,28 @@ For a fancy alternative, get `ffap-url.el'." (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") ;;; Compatibility: @@ -293,18 +317,6 @@ For a fancy alternative, get `ffap-url.el'." ;; 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'.") @@ -606,28 +618,45 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." string))) ;; 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))) @@ -1076,38 +1105,33 @@ Assumes the buffer has not changed." ;; 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)) + ;; 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)))) + + (if (ffap-url-p name) + name))))) (defvar ffap-gopher-regexp "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" @@ -1340,24 +1364,8 @@ which may actually result in an URL rather than a filename." ;; 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))) - ;;; 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.") @@ -1471,10 +1479,12 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'." ;;; 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'.") @@ -1688,6 +1698,11 @@ Only intended for interactive use." (set-window-dedicated-p win wdp)) value)) +(defun ffap--toggle-read-only (buffer) + (with-current-buffer buffer + (with-no-warnings + (toggle-read-only 1)))) + (defun ffap-read-only () "Like `ffap', but mark buffer as read-only. Only intended for interactive use." @@ -1695,7 +1710,7 @@ 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))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1704,7 +1719,7 @@ Only intended for interactive use." Only intended for interactive use." (interactive) (let ((value (ffap-other-window))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1713,7 +1728,7 @@ Only intended for interactive use." Only intended for interactive use." (interactive) (let ((value (ffap-other-frame))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1755,8 +1770,7 @@ Only intended for interactive use." (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." @@ -1800,13 +1814,6 @@ Only intended for interactive use." (interactive) (ffap-gnus-wrapper '(ffap-menu))) -(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) @@ -1913,7 +1920,7 @@ Only intended for interactive use." ;;; 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) @@ -1930,14 +1937,13 @@ This hook is intended to be put in `file-name-at-point-functions'." (when guess (if (file-directory-p guess) (file-name-as-directory guess) - guess)))))) + guess))))) ;;; 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) @@ -1957,9 +1963,7 @@ This hook is intended to be put in `file-name-at-point-functions'." (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) |