X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/409cc4a3ea9e7461572a04f021ff3993e9a516f6..ae8ba4092c4b068779cdd8a8705d4a7872bee9c4:/lisp/ffap.el?ds=sidebyside diff --git a/lisp/ffap.el b/lisp/ffap.el index 881766d92c..8ac4a9d304 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1,7 +1,7 @@ ;;; ffap.el --- find file (or url) at point ;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni ;; Maintainer: FSF @@ -11,10 +11,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -22,9 +22,7 @@ ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -150,7 +148,7 @@ If nil, ffap doesn't do shell prompt stripping." ;; This used to test for ange-ftp or efs being present, but it should be ;; harmless (and simpler) to give it this value unconditionally. "\\`/[^/:]+:" - "*File names matching this regexp are treated as remote ffap. + "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" "\\`/[^/:]+:") @@ -158,18 +156,18 @@ If nil, ffap neither recognizes nor generates such names." :group 'ffap) (defcustom ffap-url-unwrap-local t - "*If non-nil, convert `file:' URL to local file name 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 file name 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 file names 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 @@ -179,7 +177,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 file names are treated as remote. Use nil to disable." + "Matching file names are treated as remote. Use nil to disable." :type 'regexp :group 'ffap) @@ -196,7 +194,7 @@ Note this name may be omitted if it equals the default "Regexp matching URL's. nil to disable URL features in ffap.") (defcustom ffap-foo-at-bar-prefix "mailto" - "*Presumed URL prefix type of strings like \"\". + "Presumed URL prefix type of strings like \"\". Sensible values are nil, \"news\", or \"mailto\"." :type '(choice (const "mailto") (const "news") @@ -215,7 +213,7 @@ Sensible values are nil, \"news\", or \"mailto\"." ;; enabler in your .emacs file. (defcustom ffap-dired-wildcards "[*?][^/]*\\'" - "*A regexp matching filename wildcard characters, or nil. + "A regexp matching filename wildcard characters, or nil. If `find-file-at-point' gets a filename matching this pattern, and `ffap-pass-wildcards-to-dired' is nil, it passes it on to @@ -235,33 +233,33 @@ it passes it on to `dired'." :group 'ffap) (defcustom ffap-pass-wildcards-to-dired nil - "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired." + "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'. - "*Whether `find-file-at-point' prompts about a nonexistent file." + "Whether `find-file-at-point' prompts about a nonexistent file." :type 'boolean :group 'ffap) (defcustom ffap-require-prefix nil ;; Suggestion from RHOGEE, 20 Oct 1994. - "*If set, reverses the prefix argument to `find-file-at-point'. + "If set, reverses the prefix argument to `find-file-at-point'. This is nil so neophytes notice ffap. Experts may prefer to disable ffap most of the time." :type 'boolean :group 'ffap) (defcustom ffap-file-finder 'find-file - "*The command called by `find-file-at-point' to find a file." + "The command called by `find-file-at-point' to find a file." :type 'function :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." + "The command called by `dired-at-point' to find a directory." :type 'function :group 'ffap) (put 'ffap-directory-finder 'risky-local-variable t) @@ -273,7 +271,7 @@ ffap most of the time." ;; Remote control references: ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html ;; http://home.netscape.com/newsref/std/x-remote.html - "*A function of one argument, called by ffap to fetch an URL. + "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'." :type '(choice (const w3-fetch) @@ -311,7 +309,7 @@ For a fancy alternative, get `ffap-url.el'." ;; It pays to put a big fancy regexp here, since ffap-guesser is ;; much more time-consuming than regexp searching: "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\." - "*Regular expression governing movements of `ffap-next'." + "Regular expression governing movements of `ffap-next'." :type 'regexp :group 'ffap) @@ -377,14 +375,14 @@ Actual search is done by `ffap-next-guess'." ;; 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 - "*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 higher speed - "*What `ffap-machine-p' does with hostnames that have a known domain. + "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) @@ -392,7 +390,7 @@ See `mail-extr.el' for the known domains." (const reject)) :group 'ffap) (defcustom ffap-machine-p-unknown 'reject - "*What `ffap-machine-p' does with hostnames that have an unknown domain. + "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) @@ -426,7 +424,7 @@ Returned values: ;; (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 "[^-[:alnum:].]" host) ; Illegal chars (?) + (if (or (string-match "[^-[:alnum:].]" host) ; Invalid chars (?) (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject nil (let* ((domain @@ -482,7 +480,7 @@ Returned values: "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 @@ -635,8 +633,9 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) ((and ffap-url-unwrap-remote ffap-ftp-regexp (ffap-url-unwrap-remote url))) - ((fboundp 'url-normalize-url) ; may autoload url (part of w3) - (url-normalize-url url)) + ;; All this seems to do is remove any trailing "#anchor" part (Bug#898). +;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3) +;;; (url-normalize-url url)) (url))) @@ -797,7 +796,10 @@ This uses ffap-file-exists-string, which may try adding suffixes from ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| - ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ + ;; This uses to have a blank, but ffap-string-at-point doesn't + ;; handle blanks. + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html + ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $ . ffap-rfc) ; "100% RFC2100 compliant" (dired-mode . ffap-dired) ; maybe in a subdirectory ) @@ -919,7 +921,7 @@ If t, `ffap-tex-init' will initialize this when needed.") (ffap-locate-file name t ffap-bib-path)) (defun ffap-dired (name) - (let ((pt (point)) dir try) + (let ((pt (point)) try) (save-excursion (and (progn (beginning-of-line) @@ -953,12 +955,20 @@ If t, `ffap-tex-init' will initialize this when needed.") "/pub/gnu/emacs/elisp-archive/")) (substring name 2)))) +(defcustom ffap-rfc-directories nil + "A list of directories to look for RFC files. +If a given RFC isn't in these then `ffap-rfc-path' is offered." + :type '(repeat directory) + :version "23.1" + :group 'ffap) + (defvar ffap-rfc-path (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt")) (defun ffap-rfc (name) - (format ffap-rfc-path - (substring name (match-beginning 1) (match-end 1)))) + (let ((num (match-string 1 name))) + (or (ffap-locate-file (format "rfc%s.txt" num) t ffap-rfc-directories) + (format ffap-rfc-path num)))) ;;; At-Point Functions: @@ -969,11 +979,11 @@ If t, `ffap-tex-init' will initialize this when needed.") ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) - (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") + (file "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: - (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") + (url "--:=&?$+@-Z_[:alpha:]~#,%;*" "^[:alnum:]" ":;.,!?") ;; Find a string that does *not* contain a colon: - (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?") + (nocolon "--9$+<>@-Z_[:alpha:]~" "<@" "@>;.,!?") ;; A machine: (machine "-[:alnum:]." "" ".") ;; Mathematica paths: allow backquotes @@ -1045,6 +1055,9 @@ Assumes the buffer has not changed." ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region) (message "Copied to kill ring: %s" str)))) +;; External. +(declare-function w3-view-this-url "ext:w3" (&optional no-show)) + (defun ffap-url-at-point nil "Return url from around point if it exists, or nil." ;; Could use w3's url-get-url-at-point instead. Both handle "URL:", @@ -1260,46 +1273,51 @@ which may actually result in an url rather than a filename." (setq dir (file-name-directory guess)))) (let ((minibuffer-completing-file-name t) (completion-ignore-case read-file-name-completion-ignore-case) - ;; because of `rfn-eshadow-update-overlay'. - (file-name-handler-alist - (cons (cons ffap-url-regexp 'url-file-handler) - file-name-handler-alist))) - (setq guess - (completing-read - prompt - 'ffap-read-file-or-url-internal - dir - nil - (if dir (cons guess (length dir)) guess) - (list 'file-name-history) - (and buffer-file-name - (abbreviate-file-name buffer-file-name))))) + (fnh-elem (cons ffap-url-regexp 'url-file-handler))) + ;; Explain to `rfn-eshadow' that we can use URLs here. + (push fnh-elem file-name-handler-alist) + (unwind-protect + (setq guess + (let ((default-directory (if dir (expand-file-name dir) + default-directory))) + (completing-read + prompt + 'ffap-read-file-or-url-internal + nil + nil + (if dir (cons guess (length dir)) guess) + (list 'file-name-history) + (and buffer-file-name + (abbreviate-file-name buffer-file-name))))) + ;; Remove the special handler manually. We used to just let-bind + ;; file-name-handler-alist to preserve its value, but that caused + ;; other modifications to be lost (e.g. when Tramp gets loaded + ;; during the completing-read call). + (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist)))) ;; 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. ;; Note: upcoming url.el package ought to handle this automatically. guess)) -(defun ffap-read-url-internal (string dir action) +(defun ffap-read-url-internal (string pred action) "Complete url's from history, treating given string as valid." (let ((hist (ffap-soft-value "url-global-history-hash-table"))) (cond ((not action) - (or (try-completion string hist) string)) + (or (try-completion string hist pred) string)) ((eq action t) - (or (all-completions string hist) (list string))) + (or (all-completions string hist pred) (list string))) ;; action == lambda, documented where? Tests whether string is a ;; valid "match". Let us always say yes. (t t)))) -(defun ffap-read-file-or-url-internal (string dir action) - (unless dir - (setq dir default-directory)) - (unless string +(defun ffap-read-file-or-url-internal (string pred action) + (unless string ;Why would this ever happen? (setq string default-directory)) (if (ffap-url-p string) - (ffap-read-url-internal string dir action) - (read-file-name-internal string dir action))) + (ffap-read-url-internal string pred action) + (read-file-name-internal string pred action))) ;; The rest of this page is just to work with package complete.el. ;; This code assumes that you load ffap.el after complete.el. @@ -1381,7 +1399,11 @@ Uses the face `ffap' if it is defined, or else `highlight'." (ffap-read-file-or-url (if ffap-url-regexp "Find file or URL: " "Find file: ") (prog1 - (setq guess (or guess (ffap-guesser))) ; using ffap-alist here + (let ((mark-active nil)) + ;; Don't use the region here, since it can be something + ;; completely unwieldy. If the user wants that, she could + ;; use M-w before and then C-y. --Stef + (setq guess (or guess (ffap-guesser)))) ; using ffap-alist here (and guess (ffap-highlight)) ))) (ffap-highlight t))) @@ -1504,7 +1526,7 @@ Function CONT is applied to the entry chosen by the user." (x-popup-menu t (list "" (cons title - (mapcar (function (lambda (i) (cons (car i) i))) + (mapcar (lambda (i) (cons (car i) i)) alist)))))) ;; minibuffer with completion buffer: (t @@ -1518,8 +1540,7 @@ Function CONT is applied to the entry chosen by the user." nil))) (sit-for 0) ; redraw original screen ;; Convert string to its entry, or else the default: - (setq choice (or (assoc choice alist) (car alist)))) - ) + (setq choice (or (assoc choice alist) (car alist))))) (if choice (funcall cont choice) (message "No choice made!") ; possible with menus @@ -1550,7 +1571,7 @@ Applies `ffap-menu-text-plist' text properties at all matches." ffap-menu-text-plist) (message "Scanning...%2d%% <%s>" (/ (* 100 (- (point) (point-min))) range) item))) - (or mod (set-buffer-modified-p nil)))) + (or mod (restore-buffer-modified-p nil)))) (message "Scanning...done") ;; Remove duplicates. (setq ffap-menu-alist ; sort by item @@ -1691,20 +1712,8 @@ Only intended for interactive use." ;;; Bug Reporter: -(defun ffap-bug nil - "Submit a bug report for the ffap package." - ;; Important: keep the version string here in synch with that at top - ;; of file! Could use lisp-mnt from Emacs 19, but that would depend - ;; on being able to find the ffap.el source file. - (interactive) - (require 'reporter) - (let ((reporter-prompt-for-summary-p t)) - (reporter-submit-bug-report - "Michelangelo Grigni " - "ffap" - (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) - -(fset 'ffap-submit-bug 'ffap-bug) ; another likely name +(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1") +(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1") ;;; Hooks for Gnus, VM, Rmail: @@ -1728,6 +1737,13 @@ Only intended for interactive use." (defvar gnus-summary-buffer) (defvar gnus-article-buffer) +;; This code is called from gnus. +(declare-function gnus-summary-select-article "gnus-sum" + (&optional all-headers force pseudo article)) + +(declare-function gnus-configure-windows "gnus-win" + (setting &optional force)) + (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 @@ -1754,7 +1770,7 @@ Only intended for interactive use." (defcustom dired-at-point-require-prefix nil - "*If set, reverses the prefix argument to `dired-at-point'. + "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 @@ -1797,7 +1813,11 @@ ffap most of the time." ;; 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 (let ((guess (ffap-guesser))) @@ -1898,5 +1918,5 @@ Of course if you do not like these bindings, just roll your own!") -;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc +;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc ;;; ffap.el ends here