X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e5eee690ffdc37ee963da26aa5c2d6cf2b0e85e4..69008bcff4efd4190e3628299580313875a74080:/lisp/ffap.el diff --git a/lisp/ffap.el b/lisp/ffap.el index bc934ed351..89e04c0f2b 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,8 +1,9 @@ ;;; ffap.el --- find file (or url) at point -;; -;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc. -;; + +;; Copyright (C) 1995, 96, 97, 2000, 2004 Free Software Foundation, Inc. + ;; Author: Michelangelo Grigni +;; Maintainer: Rajesh Vaidheeswarran ;; Created: 29 Mar 1993 ;; Keywords: files, hypermedia, matching, mouse, convenience ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ @@ -35,16 +36,27 @@ ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with ;; M-x ffap-bug. ;; -;; For the default installation, 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: ;; -;; C-x C-f find-file-at-point (abbreviated as ffap) -;; 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 ;; @@ -65,11 +77,12 @@ ;; (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). ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify -;; the file and URL references within a buffer. +;; the file and URL references within a buffer. ;;; Change Log: @@ -80,11 +93,11 @@ ;;; Todo list: ;; * use kpsewhich -;; * let "/path/file#key" jump to key (tag or regexp) in /path/file +;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file ;; * find file of symbol if TAGS is loaded (like above) ;; * break long menus into multiple panes (like imenu?) ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace) -;; * notice "machine.dom blah blah blah path/file" (how?) +;; * notice "machine.dom blah blah blah dir/file" (how?) ;; * as w3 becomes standard, rewrite to rely more on its functions ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK) ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library' @@ -120,30 +133,42 @@ Otherwise return nil (or the optional DEFAULT value)." (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. "\\`/[^/:]+:" - "*Paths matching this regexp are treated as remote ftp paths by ffap. -If nil, ffap neither recognizes nor generates such paths." + "*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) (const :tag "Standard" "\\`/[^/:]+:") regexp) :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 file name 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 file name before prompting. This is ignored if `ffap-ftp-regexp' is nil." :type 'boolean :group 'ffap) (defcustom ffap-ftp-default-user "anonymous" - "*User name in ftp paths 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'\)." :type 'string @@ -153,7 +178,7 @@ Note this name may be omitted if it equals the default ;; Remote file access built into file system? HP rfa or Andrew afs: "\\`/\\(afs\\|net\\)/." ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.") - "*Matching paths are treated as remote. nil to disable." + "*Matching file names are treated as remote. Use nil to disable." :type 'regexp :group 'ffap) @@ -188,19 +213,31 @@ Sensible values are nil, \"news\", or \"mailto\"." ;; 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 ", 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'. @@ -222,6 +259,12 @@ ffap most of the time." :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 @@ -397,6 +440,7 @@ Returned values: (cond ((eq strategy 'accept) 'accept) ((eq strategy 'reject) nil) + ((not (fboundp 'open-network-stream)) nil) ;; assume (eq strategy 'ping) (t (or quiet @@ -433,7 +477,7 @@ Returned values: ;;; Possibly Remote Resources: -(defun ffap-replace-path-component (fullname name) +(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) @@ -445,9 +489,9 @@ Returned values: ange-ftp-replace-name-component )) (and found - (fset 'ffap-replace-path-component found) + (fset 'ffap-replace-file-component found) (funcall found fullname name)))) -;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new") +;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new") (defun ffap-file-suffix (file) "Return trailing `.foo' suffix of FILE, or nil if none." @@ -484,12 +528,12 @@ The optional NOMODIFY argument suppresses the extra search." (defun ffap-file-remote-p (filename) "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 "/cssun.mathcs.emory.edu://dir") ;; (ffap-file-remote-p "/ffap.el:80") (or (and ffap-ftp-regexp (string-match ffap-ftp-regexp filename) - ;; Convert "/host.com://path" to "/host:/path", to handle a dieing - ;; practice of advertising ftp paths as "host.dom://path". + ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing + ;; practice of advertising ftp files as "host.dom://filename". (if (string-match "//" filename) ;; (replace-match "/" nil nil filename) (concat (substring filename 0 (1+ (match-beginning 0))) @@ -504,7 +548,7 @@ The optional NOMODIFY argument suppresses the extra search." (let ((mach (ffap-string-at-point 'machine))) (and (ffap-machine-p mach) mach))) -(defsubst ffap-host-to-path (host) +(defsubst ffap-host-to-filename (host) "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\". Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (if (equal host "localhost") @@ -517,7 +561,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (concat "/" user (and user "@") host ":")))) (defun ffap-fixup-machine (mach) - ;; Convert a hostname into an url, an ftp path, or nil. + ;; Convert a hostname into an url, an ftp file name, or nil. (cond ((not (and ffap-url-regexp (stringp mach))) nil) ;; gopher.well.com @@ -527,7 +571,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) (concat "http://" mach "/")) ;; More cases? Maybe "telnet:" for archie? - (ffap-ftp-regexp (ffap-host-to-path mach)) + (ffap-ftp-regexp (ffap-host-to-filename mach)) )) (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$" @@ -549,7 +593,8 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (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)) @@ -578,7 +623,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'." (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) (concat - (ffap-host-to-path (substring url (match-beginning 2) (match-end 2))) + (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") @@ -594,10 +639,10 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (url))) -;;; Path Handling: +;;; File Name Handling: ;; ;; The upcoming ffap-alist actions need various utilities to prepare -;; and search paths of directories. Too many features here. +;; and search directories. Too many features here. ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l) ;; (defun ffap-splice (func inlist) @@ -685,7 +730,7 @@ kpathsea, a library used by some versions of TeX." (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 + ;; 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. @@ -899,7 +944,7 @@ If t, `ffap-tex-init' will initialize this when needed.") (member (ffap-string-around) '("||" "|\n"))) (concat ;; lispdir.el may not be loaded yet: - (ffap-host-to-path + (ffap-host-to-filename (ffap-soft-value "elisp-archive-host" "archive.cis.ohio-state.edu")) (file-name-as-directory @@ -908,7 +953,7 @@ If t, `ffap-tex-init' will initialize this when needed.") (substring name 2)))) (defvar ffap-rfc-path - (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt")) + (concat (ffap-host-to-filename "ds.internic.net") "/rfc/rfc%s.txt")) (defun ffap-rfc (name) (format ffap-rfc-path @@ -923,9 +968,9 @@ If t, `ffap-tex-init' will initialize this when needed.") ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) - (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") + (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: - (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?") + (url "--:=&?$+@-Z_a-z~#,%;*" "^A-Za-z0-9" ":;.,!?") ;; Find a string that does *not* contain a colon: (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?") ;; A machine: @@ -950,6 +995,7 @@ 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 @@ -957,15 +1003,19 @@ Sets `ffap-string-at-point' and `ffap-string-at-point-region'." (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))) @@ -1075,7 +1125,7 @@ The two subexpressions are the KEY and VALUE.") ;; 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 paths 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 nil @@ -1085,7 +1135,7 @@ If the filename is not obvious, it also tries `ffap-alist', which may actually result in an url rather than a filename." ;; Note: this function does not need to look for url's, just ;; filenames. On the other hand, it is responsible for converting - ;; a pseudo-url "site.com://path" to an ftp path + ;; a pseudo-url "site.com://dir" to an ftp file name (let* ((case-fold-search t) ; url prefixes are case-insensitive (data (match-data)) (string (ffap-string-at-point)) ; uses mode alist @@ -1099,21 +1149,23 @@ which may actually result in an url rather than a filename." (default-directory default-directory)) (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 paths): + ;; Try adding a leading "/" (common omission in ftp file names): (and ffap-ftp-sans-slash-regexp (string-match ffap-ftp-sans-slash-regexp name) @@ -1142,7 +1194,7 @@ which may actually result in an url rather than a filename." try)) ;; Alist failed? Try to guess an active remote connection ;; from buffer variables, and try once more, both as an - ;; absolute and relative path on that remote host. + ;; absolute and relative file name on that remote host. ((let* (ffap-rfs-regexp ; suppress (remote-dir (cond @@ -1160,10 +1212,24 @@ which may actually result in an url rather than a filename." (or (and (string-match "\\`\\(/?~?ftp\\)/" name) (ffap-file-exists-string - (ffap-replace-path-component + (ffap-replace-file-component remote-dir (substring name (match-end 1))))) (ffap-file-exists-string - (ffap-replace-path-component remote-dir name)))))) + (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)))) @@ -1196,7 +1262,9 @@ which may actually result in an url rather than a filename." 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. @@ -1216,6 +1284,10 @@ which may actually result in an url rather than a filename." (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))) @@ -1224,9 +1296,7 @@ which may actually result in an url rather than a filename." ;; 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 @@ -1234,30 +1304,20 @@ which may actually result in an url rather than a filename." ;; 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 - (memq minibuffer-completion-table - '(read-file-name-internal read-directory-name-internal)) ; list - )) + (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) - (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))) ;;; Highlighting (`ffap-highlight'): ;; ;; 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 @@ -1334,10 +1394,16 @@ See for latest version." ((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? ")) @@ -1350,7 +1416,9 @@ See for latest version." filename)))))) ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. -;;;###autoload(defalias 'ffap 'find-file-at-point) +;;;###autoload +(defalias 'ffap 'find-file-at-point) + ;;; Menu support (`ffap-menu'): @@ -1365,8 +1433,8 @@ For example, try \":/\" for URL (and some ftp) references.") (defvar ffap-menu-text-plist (cond - ((not window-system) nil) - (t '(face bold mouse-face highlight))) ; keymap + ((display-mouse-p) '(face bold mouse-face highlight)) ; keymap + (t nil)) "Text properties applied to strings found by `ffap-menu-rescan'. These properties may be used to fontify the menu references.") @@ -1531,9 +1599,7 @@ Return value: ))) -;;; 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. @@ -1543,23 +1609,70 @@ Return value: "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))) ;;; Bug Reporter: @@ -1640,21 +1753,26 @@ ffap most of the time." (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) "*")))) - ((y-or-n-p "Directory does not exist, create it? ") + (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) @@ -1664,21 +1782,86 @@ ffap most of the time." (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)) - )) + (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))) +;;; 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))) + + ;;; 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) @@ -1686,14 +1869,17 @@ ffap most of the time." ;; (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))) + +;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc ;;; ffap.el ends here