-;; ffap.el --- find file (or url) at point
-;;
-;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc.
-;;
+;;; ffap.el --- find file (or url) at point
+
+;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
+
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
+;; Maintainer: FSF
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
\f
;;; Commentary:
;;
;; ffap-bindings makes the following global key bindings:
;;
-;; C-x C-f find-file-at-point (abbreviated as ffap)
-;; C-x d dired-at-point
-;; C-x 4 f ffap-other-window
-;; C-x 5 f ffap-other-frame
+;; C-x C-f find-file-at-point (abbreviated as ffap)
+;; C-x C-r ffap-read-only
+;; C-x C-v ffap-alternate-file
+;;
+;; C-x d dired-at-point
+;; C-x C-d ffap-list-directory
+;;
+;; C-x 4 f ffap-other-window
+;; C-x 4 r ffap-read-only-other-window
+;; C-x 4 d ffap-dired-other-window
+;;
+;; C-x 5 f ffap-other-frame
+;; C-x 5 r ffap-read-only-other-frame
+;; C-x 5 d ffap-dired-other-frame
+;;
;; S-mouse-3 ffap-at-mouse
;; C-S-mouse-3 ffap-menu
;;
;; (setq ffap-alist nil) ; faster, dumber prompting
;; (setq ffap-machine-p-known 'accept) ; no pinging
;; (setq ffap-url-regexp nil) ; disable URL features in ffap
+;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping
;;
;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
(let ((sym (intern-soft name)))
(if (and sym (boundp sym)) (symbol-value sym) default)))
+(defcustom ffap-shell-prompt-regexp
+ ;; This used to test for some shell prompts that don't have a space
+ ;; 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
+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.
;; through this section for features that you like, put an appropriate
;; enabler in your .emacs file.
-(defcustom ffap-dired-wildcards nil
- ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still
- ;; available by "C-x C-d <pattern>", and valid filenames may
- ;; sometimes contain wildcard characters.
+(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
"*A regexp matching filename wildcard characters, or nil.
+
If `find-file-at-point' gets a filename matching this pattern,
-it passes it on to `dired' instead of `find-file'."
+and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
+`find-file' with non-nil WILDCARDS argument, which expands
+wildcards and visits multiple files. To visit a file whose name
+contains wildcard characters you can suppress wildcard expansion
+by setting `find-file-wildcards'. If `find-file-at-point' gets a
+filename matching this pattern and `ffap-pass-wildcards-to-dired'
+is non-nil, it passes it on to `dired'.
+
+If `dired-at-point' gets a filename matching this pattern,
+it passes it on to `dired'."
:type '(choice (const :tag "Disable" nil)
(const :tag "Enable" "[*?][^/]*\\'")
;; regexp -- probably not useful
)
:group 'ffap)
+(defcustom ffap-pass-wildcards-to-dired nil
+ "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
+ :type 'boolean
+ :group 'ffap)
+
(defcustom ffap-newfile-prompt nil
;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
;; better handled by `find-file-not-found-hooks'.
:group 'ffap)
(put 'ffap-file-finder 'risky-local-variable 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)
+
(defcustom ffap-url-fetcher
(if (fboundp 'browse-url)
'browse-url ; rely on browse-url-browser-function
\f
;;; Compatibility:
;;
-;; This version of ffap supports Emacs 20 only, see the ftp site
-;; for a more general version. The following functions are necessary
-;; "leftovers" from the more general version.
+;; This version of ffap supports only the Emacs it is distributed in.
+;; See the ftp site for a more general version. The following
+;; functions are necessary "leftovers" from the more general version.
(defun ffap-mouse-event nil ; current mouse event, or nil
(and (listp last-nonmenu-event) last-nonmenu-event))
;;
;; It pays to put a big fancy regexp here, since ffap-guesser is
;; much more time-consuming than regexp searching:
- "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
+ "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
"*Regular expression governing movements of `ffap-next'."
:type 'regexp
:group 'ffap)
;; (ffap-machine-p "mathcs" 5678 nil 'ping)
;; (ffap-machine-p "foo.bonk" nil nil 'ping)
;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
- (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
+ (if (or (string-match "[^-[:alnum:].]" host) ; Illegal chars (?)
(not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
nil
(let* ((domain
"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)
- (mapcar
+ (mapc
(function (lambda (sym) (and (fboundp sym) (setq found sym))))
'(
efs-replace-path-component
(ffap-ftp-regexp (ffap-host-to-filename mach))
))
-(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
+(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")
(setq heads nil))
(error nil)))
(or ret (not heads)
- (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
+ (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string)))
(and head (setq head (substring string 0 (match-end 1)))
(member head heads)
(setq ret string))))
path)))
(defun ffap-locate-file (file &optional nosuffix path dir-ok)
- ;; The Emacs 20 version of locate-library could almost replace this,
- ;; except it does not let us overrride the suffix list. The
+ ;; The current version of locate-library could almost replace this,
+ ;; except it does not let us override the suffix list. The
;; compression-suffixes search moved to ffap-file-exists-string.
"A generic path-searching function, mimics `load' by default.
Returns path to file that \(load FILE\) would load, or nil.
("" . ffap-completable) ; completion, slow on some systems
("\\.info\\'" . ffap-info) ; gzip.info
("\\`info/" . ffap-info-2) ; info/emacs
- ("\\`[-a-z]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses]
+ ("\\`[-[:lower:]]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses]
("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc
(emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom
;; (lisp-interaction-mode . ffap-el-mode) ; maybe
(substring name 2))))
(defvar ffap-rfc-path
- (concat (ffap-host-to-filename "ds.internic.net") "/rfc/rfc%s.txt"))
+ (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt"))
(defun ffap-rfc (name)
(format ffap-rfc-path
;; Slightly controversial decisions:
;; * strip trailing "@" and ":"
;; * no commas (good for latex)
- (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
+ (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:")
;; An url, or maybe a email/news message-id:
- (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
+ (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?")
;; Find a string that does *not* contain a colon:
- (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
+ (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?")
;; A machine:
- (machine "-a-zA-Z0-9." "" ".")
+ (machine "-[:alnum:]." "" ".")
;; Mathematica paths: allow backquotes
- (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
+ (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
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'."
(let* ((args
(cdr
(assq 'file ffap-string-at-point-mode-alist))))
(pt (point))
(str
- (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))))))
+ (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)))
(let ((name (ffap-string-at-point 'url)))
(cond
((string-match "^url:" name) (setq name (substring name 4)))
- ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z0-9]\\'" name)
+ ((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'.
"mailto")))
(and prefix (setq name (concat prefix ":" name))))))
((ffap-newsgroup-p name) (setq name (concat "news:" name)))
- ((and (string-match "\\`[a-z0-9]+\\'" name) ; <mic> <root> <nobody>
+ ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
(equal (ffap-string-around) "<>")
;; (ffap-user-p name):
(not (string-match "~" (expand-file-name (concat "~" name))))
(error nil))
string))
(abs (file-name-absolute-p name))
- (default-directory default-directory))
+ (default-directory default-directory)
+ (oname name))
(unwind-protect
(cond
- ;; Immediate rejects (/ and // are too common in C++):
- ((member name '("" "/" "//" ".")) nil)
+ ;; Immediate rejects (/ and // and /* are too common in C/C++):
+ ((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)))
+ ;; Try stripping off prominent (non-root - #) shell prompts
+ ;; if the ffap-shell-prompt-regexp is non-nil.
+ ((and ffap-shell-prompt-regexp
+ (not abs) (string-match ffap-shell-prompt-regexp name)
+ (ffap-file-exists-string (substring name (match-end 0)))))
;; Accept remote names without actual checking (too slow):
- ((if abs
- (ffap-file-remote-p name)
- ;; Try adding a leading "/" (common omission in ftp file names):
- (and
- ffap-ftp-sans-slash-regexp
- (string-match ffap-ftp-sans-slash-regexp name)
- (ffap-file-remote-p (concat "/" name)))))
+ ((and abs (ffap-file-remote-p name)))
;; Ok, not remote, try the existence test even if it is absolute:
((and abs (ffap-file-exists-string name)))
;; If it contains a colon, get rid of it (and return if exists)
(ffap-file-remote-p try)
(ffap-file-exists-string try))))))
try))
+ ;; Try adding a leading "/" (common omission in ftp file names).
+ ;; Note that this uses oname, which still has any colon part.
+ ;; This should have a lower priority than the alist stuff,
+ ;; else it matches things like "ffap.el:1234:56:Warning".
+ ((and (not abs)
+ ffap-ftp-sans-slash-regexp
+ (string-match ffap-ftp-sans-slash-regexp oname)
+ (ffap-file-remote-p (concat "/" oname))))
;; Alist failed? Try to guess an active remote connection
;; from buffer variables, and try once more, both as an
;; absolute and relative file name on that remote host.
remote-dir (substring name (match-end 1)))))
(ffap-file-exists-string
(ffap-replace-file-component remote-dir name))))))
+ ((and ffap-dired-wildcards
+ (string-match ffap-dired-wildcards name)
+ abs
+ (ffap-file-exists-string (file-name-directory
+ (directory-file-name name)))
+ name))
+ ;; Try all parent directories by deleting the trailing directory
+ ;; name until existing directory is found or name stops changing
+ ((let ((dir name))
+ (while (and dir
+ (not (ffap-file-exists-string dir))
+ (not (equal dir (setq dir (file-name-directory
+ (directory-file-name dir)))))))
+ (ffap-file-exists-string dir)))
)
(set-match-data data))))
\f
(abbreviate-file-name (expand-file-name guess))
))
(setq dir (file-name-directory guess))))
- (let ((minibuffer-completing-file-name t))
+ (let ((minibuffer-completing-file-name t)
+ (completion-ignore-case read-file-name-completion-ignore-case))
(setq guess
(completing-read
prompt
dir
nil
(if dir (cons guess (length dir)) guess)
- (list 'file-name-history))))
+ (list 'file-name-history)
+ (and buffer-file-name
+ (abbreviate-file-name buffer-file-name)))))
;; 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.
;; 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. For earlier versions of
-;; complete.el, this requires a defadvice. For recent versions
-;; there may be a special variable for this purpose.
+;; will do filename style completion.
(defun ffap-complete-as-file-p nil
;; Will `minibuffer-completion-table' complete the minibuffer
(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)
- (require 'advice)
- (defadvice PC-do-completion (around ffap-fix act)
- "Work with ffap."
- (let ((minibuffer-completion-table
- (if (eq t (ffap-complete-as-file-p))
- 'read-file-name-internal
- minibuffer-completion-table)))
- ad-do-it))))
+ (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))
\f
;;; Highlighting (`ffap-highlight'):
(defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.")
+(defface ffap
+ '((t :inherit highlight))
+ "Face used to highlight the current buffer substring."
+ :group 'ffap
+ :version "22.1")
+
(defvar ffap-highlight-overlay nil
"Overlay used by `ffap-highlight'.")
(t
(setq ffap-highlight-overlay
(apply 'make-overlay ffap-string-at-point-region))
- (overlay-put ffap-highlight-overlay 'face
- (if (facep 'ffap) 'ffap 'highlight)))))
+ (overlay-put ffap-highlight-overlay 'face 'ffap))))
\f
;;; Main Entrance (`find-file-at-point' == `ffap'):
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'.
-
-See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
+and the functions `ffap-file-at-point' and `ffap-url-at-point'."
(interactive)
(if (and (interactive-p)
(if ffap-require-prefix (not current-prefix-arg)
((ffap-url-p filename)
(let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
(funcall ffap-url-fetcher filename)))
- ;; This junk more properly belongs in a modified ffap-file-finder:
- ((and ffap-dired-wildcards
+ ((and ffap-pass-wildcards-to-dired
+ ffap-dired-wildcards
(string-match ffap-dired-wildcards filename))
- (dired 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? "))
(let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
(range (- (point-max) (point-min)))
(mod (buffer-modified-p)) ; was buffer modified?
- buffer-read-only ; to set text-properties
+ ;; inhibit-read-only works on read-only text properties
+ ;; as well as read-only buffers.
+ (inhibit-read-only t) ; to set text-properties
item
;; Avoid repeated searches of the *mode-alist:
(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
)))
\f
-;;; ffap-other-* commands:
-;;
-;; Requested by KPC.
+;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
;; There could be a real `ffap-noselect' function, but we would need
;; at least two new user variables, and there is no w3-fetch-noselect.
"Like `ffap', but put buffer in another window.
Only intended for interactive use."
(interactive)
- (switch-to-buffer-other-window
- (save-window-excursion (call-interactively 'ffap) (current-buffer))))
+ (let (value)
+ (switch-to-buffer-other-window
+ (save-window-excursion
+ (setq value (call-interactively 'ffap))
+ (unless (or (bufferp value) (bufferp (car-safe value)))
+ (setq value (current-buffer)))
+ (current-buffer)))
+ value))
(defun ffap-other-frame nil
"Like `ffap', but put buffer in another frame.
Only intended for interactive use."
(interactive)
;; Extra code works around dedicated windows (noted by JENS, 7/96):
- (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
+ (let* ((win (selected-window))
+ (wdp (window-dedicated-p win))
+ value)
(unwind-protect
(progn
(set-window-dedicated-p win nil)
(switch-to-buffer-other-frame
(save-window-excursion
- (call-interactively 'ffap)
+ (setq value (call-interactively 'ffap))
+ (unless (or (bufferp value) (bufferp (car-safe value)))
+ (setq value (current-buffer)))
(current-buffer))))
- (set-window-dedicated-p win wdp))))
+ (set-window-dedicated-p win wdp))
+ value))
+
+(defun ffap-read-only ()
+ "Like `ffap', but mark buffer as read-only.
+Only intended for interactive use."
+ (interactive)
+ (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)))
+ value))
+
+(defun ffap-read-only-other-window ()
+ "Like `ffap', but put buffer in another window and mark as read-only.
+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)))
+ value))
+
+(defun ffap-read-only-other-frame ()
+ "Like `ffap', but put buffer in another frame and mark as read-only.
+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)))
+ value))
+
+(defun ffap-alternate-file ()
+ "Like `ffap' and `find-alternate-file'.
+Only intended for interactive use."
+ (interactive)
+ (let ((ffap-file-finder 'find-alternate-file))
+ (call-interactively 'ffap)))
\f
;;; Bug Reporter:
(local-set-key "\M-l" 'ffap-gnus-next)
(local-set-key "\M-m" 'ffap-gnus-menu))
+(defvar gnus-summary-buffer)
+(defvar gnus-article-buffer)
+
(defun ffap-gnus-wrapper (form) ; used by both commands below
(and (eq (current-buffer) (get-buffer gnus-summary-buffer))
(gnus-summary-select-article)) ; get article of current line
(not current-prefix-arg)
current-prefix-arg))
(let (current-prefix-arg) ; already interpreted
- (call-interactively 'dired))
+ (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))
- (dired filename))
+ (funcall ffap-directory-finder filename))
((file-exists-p filename)
(if (file-directory-p filename)
- (dired (expand-file-name filename))
- (dired (concat (expand-file-name filename) "*"))))
- ((and (file-writable-p (file-name-directory 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)
- (dired filename))
+ (funcall ffap-directory-finder filename))
((error "No such file or directory `%s'" filename)))))
(defun dired-at-point-prompter (&optional guess)
;; Extra complication for the temporary highlighting.
(unwind-protect
(ffap-read-file-or-url
- (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
+ (cond
+ ((eq ffap-directory-finder 'list-directory)
+ "List directory (brief): ")
+ (ffap-url-regexp "Dired file or URL: ")
+ (t "Dired file: "))
(prog1
- (setq guess (or guess (ffap-guesser)))
- (and guess (ffap-highlight))
- ))
+ (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))))
+ ))
+ (and guess (ffap-highlight))))
(ffap-highlight t)))
\f
+;;; ffap-dired-other-*, ffap-list-directory commands:
+
+(defun ffap-dired-other-window ()
+ "Like `dired-at-point', but put buffer in another window.
+Only intended for interactive use."
+ (interactive)
+ (let (value)
+ (switch-to-buffer-other-window
+ (save-window-excursion
+ (setq value (call-interactively 'dired-at-point))
+ (current-buffer)))
+ value))
+
+(defun ffap-dired-other-frame ()
+ "Like `dired-at-point', but put buffer in another frame.
+Only intended for interactive use."
+ (interactive)
+ ;; Extra code works around dedicated windows (noted by JENS, 7/96):
+ (let* ((win (selected-window))
+ (wdp (window-dedicated-p win))
+ value)
+ (unwind-protect
+ (progn
+ (set-window-dedicated-p win nil)
+ (switch-to-buffer-other-frame
+ (save-window-excursion
+ (setq value (call-interactively 'dired-at-point))
+ (current-buffer))))
+ (set-window-dedicated-p win wdp))
+ value))
+
+(defun ffap-list-directory ()
+ "Like `dired-at-point' and `list-directory'.
+Only intended for interactive use."
+ (interactive)
+ (let ((ffap-directory-finder 'list-directory))
+ (call-interactively 'dired-at-point)))
+
+\f
;;; Offer default global bindings (`ffap-bindings'):
(defvar ffap-bindings
'(
(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)
+ (global-set-key "\C-x\C-r" 'ffap-read-only)
+ (global-set-key "\C-x\C-v" 'ffap-alternate-file)
+
(global-set-key "\C-x4f" 'ffap-other-window)
(global-set-key "\C-x5f" 'ffap-other-frame)
+ (global-set-key "\C-x4r" 'ffap-read-only-other-window)
+ (global-set-key "\C-x5r" 'ffap-read-only-other-frame)
+
(global-set-key "\C-xd" 'dired-at-point)
+ (global-set-key "\C-x4d" 'ffap-dired-other-window)
+ (global-set-key "\C-x5d" 'ffap-dired-other-frame)
+ (global-set-key "\C-x\C-d" 'ffap-list-directory)
+
(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)