X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c98ddbe5daa656e3cbd64c7132b01ba3206879b5..69008bcff4efd4190e3628299580313875a74080:/lisp/ffap.el diff --git a/lisp/ffap.el b/lisp/ffap.el index 2b4c7826c2..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. -;; +;;; ffap.el --- find file (or url) at point + +;; 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/ @@ -41,10 +42,21 @@ ;; ;; 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 ;; @@ -201,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'. @@ -235,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 @@ -700,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. @@ -938,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: @@ -965,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 @@ -972,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))) @@ -1114,8 +1149,8 @@ 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))) @@ -1127,9 +1162,6 @@ which may actually result in an url rather than a filename." ((and ffap-shell-prompt-regexp (not abs) (string-match ffap-shell-prompt-regexp name) (ffap-file-exists-string (substring name (match-end 0))))) - ;; Immediately test local filenames. If default-directory is - ;; remote, you probably already have a connection. - ((and (not abs) (ffap-file-exists-string name))) ;; Accept remote names without actual checking (too slow): ((if abs (ffap-file-remote-p name) @@ -1184,6 +1216,20 @@ which may actually result in an url rather than a filename." 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)))) @@ -1216,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. @@ -1248,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 @@ -1264,15 +1310,7 @@ which may actually result in an url rather than a filename." (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'): @@ -1356,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? ")) @@ -1555,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. @@ -1567,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: @@ -1664,22 +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) "*")))) - ((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) @@ -1689,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)