X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e5eee690ffdc37ee963da26aa5c2d6cf2b0e85e4..034a48f4d34a43f7599b71369c561227767304f9:/lisp/ffap.el diff --git a/lisp/ffap.el b/lisp/ffap.el index bc934ed351..dc78bd355b 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,14 +36,14 @@ ;; 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 d dired-at-point ;; C-x 4 f ffap-other-window ;; C-x 5 f ffap-other-frame ;; S-mouse-3 ffap-at-mouse @@ -65,11 +66,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 +82,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 +122,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 +167,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) @@ -397,6 +411,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 +448,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 +460,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 +499,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 +519,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 +532,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 +542,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 +564,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 +594,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 +610,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 +701,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 +915,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 +924,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 @@ -925,7 +941,7 @@ If t, `ffap-tex-init' will initialize this when needed.") ;; * no commas (good for latex) (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 +966,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 +974,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 +1096,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 +1106,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 @@ -1107,13 +1128,15 @@ which may actually result in an url rather than a filename." ;; 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 +1165,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 +1183,18 @@ 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)))))) + ;; 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)))) @@ -1216,6 +1247,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 +1259,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 +1267,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 @@ -1350,7 +1373,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 +1390,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.") @@ -1652,7 +1677,10 @@ ffap most of the time." (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? ") + ((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)) ((error "No such file or directory `%s'" filename))))) @@ -1664,9 +1692,24 @@ 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))) ;;; Offer default global bindings (`ffap-bindings'): @@ -1686,14 +1729,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