;;; ffap.el --- find file (or url) at point
;;
-;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc.
;;
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Created: 29 Mar 1993
-;; Keywords: files, hypermedia, matching, mouse
+;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
-;; X-Source: this file is generated from ffap.epp
;; This file is part of GNU Emacs.
;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
;; M-x ffap-bug.
;;
-;; For the default installation, byte-compile ffap.el somewhere in
-;; your `load-path' and add these two lines to your .emacs file:
+;; For the default installation, add this line to your .emacs file:
;;
-;; (require 'ffap) ; load the package
;; (ffap-bindings) ; do default key bindings
;;
;; ffap-bindings makes the following global key bindings:
(defgroup ffap nil
"Find file or URL at point."
:link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
- :group 'matching)
+ :group 'matching
+ :group 'convenience)
;; The code is organized in pages, separated by formfeed characters.
;; See the next two pages for standard customization ideas.
:group 'ffap)
(defcustom ffap-url-unwrap-local t
- "*If non-nil, convert \"file:\" url to local path before prompting."
+ "*If non-nil, convert `file:' url to local path before prompting."
:type 'boolean
:group 'ffap)
(defcustom ffap-url-unwrap-remote t
- "*If non-nil, convert \"ftp:\" url to remote path before prompting.
+ "*If non-nil, convert `ftp:' url to remote path before prompting.
This is ignored if `ffap-ftp-regexp' is nil."
:type 'boolean
:group 'ffap)
"\\`\\("
"news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
"\\|"
- "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
+ "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
"\\)." ; require one more character
)
"Regexp matching URL's. nil to disable URL features in ffap.")
;; http://home.netscape.com/newsref/std/x-remote.html
"*A function of one argument, called by ffap to fetch an URL.
Reasonable choices are `w3-fetch' or a `browse-url-*' function.
-For a fancy alternative, get ffap-url.el."
+For a fancy alternative, get `ffap-url.el'."
:type '(choice (const w3-fetch)
(const browse-url) ; in recent versions of browse-url
(const browse-url-netscape)
;; particular, if `Pinging...' is broken or takes too long on your
;; machine, try setting these all to accept or reject.
(defcustom ffap-machine-p-local 'reject ; this happens often
- "*A symbol, one of: `ping', `accept', `reject'.
-What `ffap-machine-p' does with hostnames that have no domain."
+ "*What `ffap-machine-p' does with hostnames that have no domain.
+Value should be a symbol, one of `ping', `accept', and `reject'."
:type '(choice (const ping)
(const accept)
(const reject))
:group 'ffap)
-(defcustom ffap-machine-p-known 'ping ; 'accept for speed
- "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have a known domain
-\(see mail-extr.el for the known domains\)."
+(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed
+ "*What `ffap-machine-p' does with hostnames that have a known domain.
+Value should be a symbol, one of `ping', `accept', and `reject'.
+See `mail-extr.el' for the known domains."
:type '(choice (const ping)
(const accept)
(const reject))
:group 'ffap)
(defcustom ffap-machine-p-unknown 'reject
- "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have an unknown domain
-\(see mail-extr.el for the known domains\)."
+ "*What `ffap-machine-p' does with hostnames that have an unknown domain.
+Value should be a symbol, one of `ping', `accept', and `reject'.
+See `mail-extr.el' for the known domains."
:type '(choice (const ping)
(const accept)
(const reject))
(cond
((eq strategy 'accept) 'accept)
((eq strategy 'reject) nil)
+ ((not (fboundp 'open-network-stream)) nil)
;; assume (eq strategy 'ping)
(t
(or quiet
;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
(defun ffap-file-suffix (file)
- "Return trailing \".foo\" suffix of FILE, or nil if none."
+ "Return trailing `.foo' suffix of FILE, or nil if none."
(let ((pos (string-match "\\.[^./]*\\'" file)))
(and pos (substring file pos nil))))
;; filename, maybe modified by adding a suffix like ".gz". That
;; broke the interface of file-exists-p, so it was later dropped.
;; Here we document and simulate the old behavior.
- "Return FILE \(maybe modified\) if it exists, else nil.
+ "Return FILE (maybe modified) if the file exists, else nil.
When using jka-compr (a.k.a. `auto-compression-mode'), the returned
name may have a suffix added from `ffap-compression-suffixes'.
The optional NOMODIFY argument suppresses the extra search."
ret))))
(defun ffap-file-remote-p (filename)
- "If FILENAME looks remote, return it \(maybe slightly improved\)."
+ "If FILENAME looks remote, return it (maybe slightly improved)."
;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
;; (ffap-file-remote-p "/ffap.el:80")
(progn
;; errs: htb symbol may be unbound, or not a hash-table.
;; gnus-gethash is just a macro for intern-soft.
- (and (intern-soft string (symbol-value htb))
+ (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))
(math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
)
"Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
-possibly a `major-mode' or some symbol internal to ffap
-\(such as 'file, 'url, 'machine, and 'nocolon\).
+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:
1. find a maximal string of CHARS around point,
2. strip BEG chars before point from the beginning,
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
-MODE (defaults to `major-mode') is a symbol used to lookup string
+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 fall back on the symbol 'file.
+If MODE is not found, we use `file' instead of MODE.
Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
(let* ((args
(cdr
(unwind-protect
(cond
;; Immediate rejects (/ and // are too common in C++):
- ((member name '("" "/" "//")) nil)
+ ((member name '("" "/" "//" ".")) nil)
+ ;; Immediately test local filenames. If default-directory is
+ ;; remote, you probably already have a connection.
+ ((and (not abs) (ffap-file-exists-string name)))
+ ;; Try stripping off line numbers; good for compilation/grep output.
+ ((and (not abs) (string-match ":[0-9]" name)
+ (ffap-file-exists-string (substring name 0 (match-beginning 0)))))
;; Immediately test local filenames. If default-directory is
;; remote, you probably already have a connection.
((and (not abs) (ffap-file-exists-string name)))
(abbreviate-file-name (expand-file-name guess))
))
(setq dir (file-name-directory guess))))
- (setq guess
- (completing-read
- prompt
- 'ffap-read-file-or-url-internal
- dir
- nil
- (if dir (cons guess (length dir)) guess)
- (list 'file-name-history)
- ))
+ (let ((minibuffer-completing-file-name t))
+ (setq guess
+ (completing-read
+ prompt
+ 'ffap-read-file-or-url-internal
+ dir
+ nil
+ (if dir (cons guess (length dir)) guess)
+ (list 'file-name-history))))
;; 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.
(t t))))
(defun ffap-read-file-or-url-internal (string dir action)
+ (unless dir
+ (setq dir default-directory))
+ (unless string
+ (setq string default-directory))
(if (ffap-url-p string)
(ffap-read-url-internal string dir action)
(read-file-name-internal string dir action)))
;;
;; Based on overlay highlighting in Emacs 19.28 isearch.el.
-(defvar ffap-highlight (and window-system t)
+(defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.")
(defvar ffap-highlight-overlay nil
(setq ffap-highlight-overlay
(apply 'make-overlay ffap-string-at-point-region))
(overlay-put ffap-highlight-overlay 'face
- (if (internal-find-face 'ffap)
- 'ffap 'highlight)))))
+ (if (facep 'ffap) 'ffap 'highlight)))))
\f
;;; Main Entrance (`find-file-at-point' == `ffap'):
filename))))))
;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
-;; The defun is for autoload.el; the defalias takes over at load time.
-;;;###autoload
-(defun ffap (&optional filename)
- "A short alias for the find-file-at-point command.")
-(defalias 'ffap 'find-file-at-point)
-
+;;;###autoload(defalias 'ffap 'find-file-at-point)
\f
;;; Menu support (`ffap-menu'):
(defvar ffap-menu-text-plist
(cond
- ((not window-system) nil)
- (t '(face bold mouse-face highlight))) ; keymap <mousy-map>
+ ((display-mouse-p) '(face bold mouse-face highlight)) ; keymap <mousy-map>
+ (t nil))
"Text properties applied to strings found by `ffap-menu-rescan'.
These properties may be used to fontify the menu references.")
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 \(string . data\) ALIST entry defines a choice.
+Each ALIST entry looks like (STRING . DATA) and defines one choice.
Function CONT is applied to the entry chosen by the user."
;; Note: this function is used with a different continuation
;; by the ffap-url add-on package.
(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'."
+ (interactive)
+ (if (and (interactive-p)
+ (if dired-at-point-require-prefix
+ (not current-prefix-arg)
+ current-prefix-arg))
+ (let (current-prefix-arg) ; already interpreted
+ (call-interactively 'dired))
+ (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))
+ (dired filename))
+ ((file-exists-p filename)
+ (if (file-directory-p filename)
+ (dired (expand-file-name filename))
+ (dired (concat (expand-file-name filename) "*"))))
+ ((y-or-n-p "Directory does not exist, create it? ")
+ (make-directory filename)
+ (dired 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.
+ ;; Extra complication for the temporary highlighting.
+ (unwind-protect
+ (ffap-read-file-or-url
+ (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
+ (prog1
+ (setq guess (or guess (ffap-guesser)))
+ (and guess (ffap-highlight))
+ ))
+ (ffap-highlight t)))
+\f
;;; Offer default global bindings (`ffap-bindings'):
(defvar ffap-bindings
(global-set-key "\C-x\C-f" 'find-file-at-point)
(global-set-key "\C-x4f" 'ffap-other-window)
(global-set-key "\C-x5f" 'ffap-other-frame)
+ (global-set-key "\C-xd" 'dired-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)
;; (setq dired-x-hands-off-my-keys t) ; the default
)
"List of binding forms evaluated by function `ffap-bindings'.
-A reasonable ffap installation needs just these two lines:
- (require 'ffap)
+A reasonable ffap installation needs just this one line:
(ffap-bindings)
Of course if you do not like these bindings, just roll your own!")
+;;;###autoload
(defun ffap-bindings nil
"Evaluate the forms in variable `ffap-bindings'."
+ (interactive)
(eval (cons 'progn ffap-bindings)))
\f