;;; ffap.el --- find file (or url) at point
-;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2014 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
;;; Code:
(require 'url-parse)
+(require 'thingatpt)
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
:group 'ffap
:version "24.3")
+(defcustom ffap-lax-url nil
+ "If non-nil, allow lax URL matching."
+ :type 'boolean
+ :group 'ffap
+ :version "24.5")
+
(defcustom ffap-ftp-default-user "anonymous"
- "User name in ftp file names generated by `ffap-host-to-path'.
+ "User name in FTP file names generated by `ffap-host-to-path'.
Note this name may be omitted if it equals the default
-\(either `efs-default-user' or `ange-ftp-default-user'\)."
+\(either `efs-default-user' or `ange-ftp-default-user')."
:type 'string
:group 'ffap)
: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>\".
:group 'ffap)
(defcustom ffap-pass-wildcards-to-dired nil
- "If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
+ "If non-nil, pass filenames matching `ffap-dired-wildcards' to Dired."
:type 'boolean
:group 'ffap)
(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."
+This is nil so neophytes notice ffap. Experts may prefer to
+disable ffap most of the time."
:type 'boolean
:group 'ffap
:version "20.3")
"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.
"Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
+Interactively: use a single prefix \\[universal-argument] 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)))))
Depending on the domain (none, known, or unknown), follow the strategy
named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
-Optional SERVICE specifies the port used \(default \"discard\"\).
+Optional SERVICE specifies the port used (default \"discard\").
Optional QUIET flag suppresses the \"Pinging...\" message.
Optional STRATEGY overrides the three variables above.
Returned values:
(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"
(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."
(defun ffap-list-env (env &optional empty)
"Return a list of strings parsed from environment variable ENV.
-Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
+Optional EMPTY is the default list if (getenv ENV) is undefined, and
also is substituted for the first empty-string component, if there is one.
Uses `path-separator' to separate the path into substrings."
;; We cannot use parse-colon-path (files.el), since it kills
;; (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
. ffap-rfc) ; "100% RFC2100 compliant"
(dired-mode . ffap-dired) ; maybe in a subdirectory
)
- "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
+ "Alist of (KEY . FUNCTION) pairs parsed by `ffap-file-at-point'.
If string NAME at point (maybe \"\") is not a file or URL, these pairs
specify actions to try creating such a string. A pair matches if either
KEY is a symbol, and it equals `major-mode', or
KEY is a string, it should match NAME as a regexp.
-On a match, \(FUNCTION NAME\) is called and should return a file, an
+On a match, (FUNCTION NAME) is called and should return a file, an
URL, or nil. If nil, search the alist for further matches.")
(put 'ffap-alist 'risky-local-variable t)
(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)
(defcustom ffap-rfc-path
(concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt")
"A `format' string making a filename for RFC documents.
-This can be an ange-ftp or tramp remote filename to download, or
+This can be an ange-ftp or Tramp remote filename to download, or
a local filename if you have full set of RFCs locally. See also
`ffap-rfc-directories'."
:type 'string
;; * 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:
;; Mathematica paths: allow backquotes
(math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
)
- "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
-possibly a major-mode name, or one of the symbol
+ "Alist of (MODE CHARS BEG END), where MODE is a symbol,
+possibly a major-mode name, or one of the symbols
`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.
-MODE (defaults to value of `major-mode') is a symbol used to look up string
-syntax parameters in `ffap-string-at-point-mode-alist'.
+MODE (defaults to value of `major-mode') is a symbol used to look up
+string 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.
(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)))
- ((ffap-url-p name)))))))
+ (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 ffap-lax-url
+ (if (use-region-p)
+ (cons (region-beginning)
+ (region-end))))))))
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
;; Icky regexp avoids: default: 123: foo::bar cs:pub
;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
"\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
- "Strings matching this are coerced to ftp file names by ffap.
+ "Strings matching this are coerced to FTP file names by ffap.
That is, ffap just prepends \"/\". Set to nil to disable.")
(defun ffap-file-at-point ()
(not (ffap-file-exists-string dir))
(not (equal dir (setq dir (file-name-directory
(directory-file-name dir)))))))
- (ffap-file-exists-string dir)))
+ (and (not (string= dir "/"))
+ (ffap-file-exists-string dir))))
)
(set-match-data data))))
\f
: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.
(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)
"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
+The optional RESCAN argument (a prefix, interactively) forces
a rebuild. Searches with `ffap-menu-regexp'."
(interactive "P")
;; (require 'imenu) -- no longer used, but roughly emulated
(defun ffap-menu-ask (title alist cont)
"Prompt from a menu of choices, and then apply some action.
-Arguments are TITLE, ALIST, and CONT \(a continuation function\).
+Arguments are TITLE, ALIST, and CONT (a continuation function).
This uses either a menu or the minibuffer depending on invocation.
The TITLE string is used as either the prompt or menu title.
Each ALIST entry looks like (STRING . DATA) and defines one choice.
(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-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)
HCoop / bpt / emacs.git / blobdiff