/[emacs]/emacs/lisp/ffap.el
ViewVC logotype

Diff of /emacs/lisp/ffap.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.45 by rv, Wed Jun 9 18:32:06 2004 UTC revision 1.46 by jurta, Mon Dec 13 05:16:25 2004 UTC
# Line 42  Line 42 
42  ;;  ;;
43  ;; ffap-bindings makes the following global key bindings:  ;; ffap-bindings makes the following global key bindings:
44  ;;  ;;
45  ;; C-x C-f       find-file-at-point (abbreviated as ffap)  ;; C-x C-f              find-file-at-point (abbreviated as ffap)
46  ;; C-x d         dired-at-point  ;; C-x C-r              ffap-read-only
47  ;; C-x 4 f       ffap-other-window  ;; C-x C-v              ffap-alternate-file
48  ;; C-x 5 f       ffap-other-frame  ;;
49    ;; C-x d                dired-at-point
50    ;; C-x C-d              ffap-list-directory
51    ;;
52    ;; C-x 4 f              ffap-other-window
53    ;; C-x 4 r              ffap-read-only-other-window
54    ;; C-x 4 d              ffap-dired-other-window
55    ;;
56    ;; C-x 5 f              ffap-other-frame
57    ;; C-x 5 r              ffap-read-only-other-frame
58    ;; C-x 5 d              ffap-dired-other-frame
59    ;;
60  ;; S-mouse-3     ffap-at-mouse  ;; S-mouse-3     ffap-at-mouse
61  ;; C-S-mouse-3   ffap-menu  ;; C-S-mouse-3   ffap-menu
62  ;;  ;;
# Line 202  Sensible values are nil, \"news\", or \" Line 213  Sensible values are nil, \"news\", or \"
213  ;; through this section for features that you like, put an appropriate  ;; through this section for features that you like, put an appropriate
214  ;; enabler in your .emacs file.  ;; enabler in your .emacs file.
215    
216  (defcustom ffap-dired-wildcards nil  (defcustom ffap-dired-wildcards "[*?][^/]*\\'"
   ;; 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.  
217    "*A regexp matching filename wildcard characters, or nil.    "*A regexp matching filename wildcard characters, or nil.
218    
219  If `find-file-at-point' gets a filename matching this pattern,  If `find-file-at-point' gets a filename matching this pattern,
220  it passes it on to `dired' instead of `find-file'."  it passes it on to `find-file' with non-nil WILDCARDS argument,
221    which expands wildcards and visits multiple files.  To visit
222    a file whose name contains wildcard characters you can suppress
223    wildcard expansion by setting `find-file-wildcards'.
224    
225    If `dired-at-point' gets a filename matching this pattern,
226    it passes it on to `dired'."
227    :type '(choice (const :tag "Disable" nil)    :type '(choice (const :tag "Disable" nil)
228                   (const :tag "Enable" "[*?][^/]*\\'")                   (const :tag "Enable" "[*?][^/]*\\'")
229                   ;; regexp -- probably not useful                   ;; regexp -- probably not useful
# Line 236  ffap most of the time." Line 251  ffap most of the time."
251    :group 'ffap)    :group 'ffap)
252  (put 'ffap-file-finder 'risky-local-variable t)  (put 'ffap-file-finder 'risky-local-variable t)
253    
254    (defcustom ffap-directory-finder 'dired
255      "*The command called by `dired-at-point' to find a directory."
256      :type 'function
257      :group 'ffap)
258    (put 'ffap-directory-finder 'risky-local-variable t)
259    
260  (defcustom ffap-url-fetcher  (defcustom ffap-url-fetcher
261    (if (fboundp 'browse-url)    (if (fboundp 'browse-url)
262        'browse-url                       ; rely on browse-url-browser-function        'browse-url                       ; rely on browse-url-browser-function
# Line 939  If t, `ffap-tex-init' will initialize th Line 960  If t, `ffap-tex-init' will initialize th
960      ;; Slightly controversial decisions:      ;; Slightly controversial decisions:
961      ;; * strip trailing "@" and ":"      ;; * strip trailing "@" and ":"
962      ;; * no commas (good for latex)      ;; * no commas (good for latex)
963      (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")      (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:")
964      ;; An url, or maybe a email/news message-id:      ;; An url, or maybe a email/news message-id:
965      (url "--:=&?$+@-Z_a-z~#,%;" "^A-Za-z0-9" ":;.,!?")      (url "--:=&?$+@-Z_a-z~#,%;" "^A-Za-z0-9" ":;.,!?")
966      ;; Find a string that does *not* contain a colon:      ;; Find a string that does *not* contain a colon:
# Line 1120  which may actually result in an url rath Line 1141  which may actually result in an url rath
1141           (default-directory default-directory))           (default-directory default-directory))
1142      (unwind-protect      (unwind-protect
1143          (cond          (cond
1144           ;; Immediate rejects (/ and // are too common in C++):           ;; Immediate rejects (/ and // and /* are too common in C/C++):
1145           ((member name '("" "/" "//" ".")) nil)           ((member name '("" "/" "//" "/*" ".")) nil)
1146           ;; Immediately test local filenames.  If default-directory is           ;; Immediately test local filenames.  If default-directory is
1147           ;; remote, you probably already have a connection.           ;; remote, you probably already have a connection.
1148           ((and (not abs) (ffap-file-exists-string name)))           ((and (not abs) (ffap-file-exists-string name)))
# Line 1187  which may actually result in an url rath Line 1208  which may actually result in an url rath
1208                           remote-dir (substring name (match-end 1)))))                           remote-dir (substring name (match-end 1)))))
1209                    (ffap-file-exists-string                    (ffap-file-exists-string
1210                     (ffap-replace-file-component remote-dir name))))))                     (ffap-replace-file-component remote-dir name))))))
1211             ((and ffap-dired-wildcards
1212                   (string-match ffap-dired-wildcards name)
1213                   abs
1214                   (ffap-file-exists-string (file-name-directory
1215                                             (directory-file-name name)))
1216                   name))
1217           ;; Try all parent directories by deleting the trailing directory           ;; Try all parent directories by deleting the trailing directory
1218           ;; name until existing directory is found or name stops changing           ;; name until existing directory is found or name stops changing
1219           ((let ((dir name))           ((let ((dir name))
# Line 1227  which may actually result in an url rath Line 1254  which may actually result in an url rath
1254               dir               dir
1255               nil               nil
1256               (if dir (cons guess (length dir)) guess)               (if dir (cons guess (length dir)) guess)
1257               (list 'file-name-history))))               (list 'file-name-history)
1258                 (and buffer-file-name
1259                      (abbreviate-file-name buffer-file-name)))))
1260      ;; Do file substitution like (interactive "F"), suggested by MCOOK.      ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1261      (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))      (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
1262      ;; Should not do it on url's, where $ is a common (VMS?) character.      ;; Should not do it on url's, where $ is a common (VMS?) character.
# Line 1357  See <ftp://ftp.mathcs.emory.edu/pub/mic/ Line 1386  See <ftp://ftp.mathcs.emory.edu/pub/mic/
1386       ((ffap-url-p filename)       ((ffap-url-p filename)
1387        (let (current-prefix-arg)         ; w3 2.3.25 bug, reported by KPC        (let (current-prefix-arg)         ; w3 2.3.25 bug, reported by KPC
1388          (funcall ffap-url-fetcher filename)))          (funcall ffap-url-fetcher filename)))
      ;; This junk more properly belongs in a modified ffap-file-finder:  
1389       ((and ffap-dired-wildcards       ((and ffap-dired-wildcards
1390             (string-match ffap-dired-wildcards filename))             (string-match ffap-dired-wildcards filename)
1391        (dired filename))             find-file-wildcards
1392               ;; Check if it's find-file that supports wildcards arg
1393               (memq ffap-file-finder '(find-file find-alternate-file)))
1394          (funcall ffap-file-finder (expand-file-name filename) t))
1395       ((or (not ffap-newfile-prompt)       ((or (not ffap-newfile-prompt)
1396            (file-exists-p filename)            (file-exists-p filename)
1397            (y-or-n-p "File does not exist, create buffer? "))            (y-or-n-p "File does not exist, create buffer? "))
# Line 1556  Return value: Line 1587  Return value:
1587       )))       )))
1588    
1589    
1590  ;;; ffap-other-* commands:  ;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
 ;;  
 ;; Requested by KPC.  
1591    
1592  ;; There could be a real `ffap-noselect' function, but we would need  ;; There could be a real `ffap-noselect' function, but we would need
1593  ;; at least two new user variables, and there is no w3-fetch-noselect.  ;; at least two new user variables, and there is no w3-fetch-noselect.
# Line 1568  Return value: Line 1597  Return value:
1597    "Like `ffap', but put buffer in another window.    "Like `ffap', but put buffer in another window.
1598  Only intended for interactive use."  Only intended for interactive use."
1599    (interactive)    (interactive)
1600    (switch-to-buffer-other-window    (let (value)
1601     (save-window-excursion (call-interactively 'ffap) (current-buffer))))      (switch-to-buffer-other-window
1602         (save-window-excursion
1603           (setq value (call-interactively 'ffap))
1604           (unless (or (bufferp value) (bufferp (car-safe value)))
1605             (setq value (current-buffer)))
1606           (current-buffer)))
1607        value))
1608    
1609  (defun ffap-other-frame nil  (defun ffap-other-frame nil
1610    "Like `ffap', but put buffer in another frame.    "Like `ffap', but put buffer in another frame.
1611  Only intended for interactive use."  Only intended for interactive use."
1612    (interactive)    (interactive)
1613    ;; Extra code works around dedicated windows (noted by JENS, 7/96):    ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1614    (let* ((win (selected-window)) (wdp (window-dedicated-p win)))    (let* ((win (selected-window))
1615             (wdp (window-dedicated-p win))
1616             value)
1617      (unwind-protect      (unwind-protect
1618          (progn          (progn
1619            (set-window-dedicated-p win nil)            (set-window-dedicated-p win nil)
1620            (switch-to-buffer-other-frame            (switch-to-buffer-other-frame
1621             (save-window-excursion             (save-window-excursion
1622               (call-interactively 'ffap)               (setq value (call-interactively 'ffap))
1623                 (unless (or (bufferp value) (bufferp (car-safe value)))
1624                   (setq value (current-buffer)))
1625               (current-buffer))))               (current-buffer))))
1626        (set-window-dedicated-p win wdp))))        (set-window-dedicated-p win wdp))
1627        value))
1628    
1629    (defun ffap-read-only ()
1630      "Like `ffap', but mark buffer as read-only.
1631    Only intended for interactive use."
1632      (interactive)
1633      (let ((value (call-interactively 'ffap)))
1634        (unless (or (bufferp value) (bufferp (car-safe value)))
1635          (setq value (current-buffer)))
1636        (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1637              (if (listp value) value (list value)))
1638        value))
1639    
1640    (defun ffap-read-only-other-window ()
1641      "Like `ffap', but put buffer in another window and mark as read-only.
1642    Only intended for interactive use."
1643      (interactive)
1644      (let ((value (ffap-other-window)))
1645        (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1646              (if (listp value) value (list value)))
1647        value))
1648    
1649    (defun ffap-read-only-other-frame ()
1650      "Like `ffap', but put buffer in another frame and mark as read-only.
1651    Only intended for interactive use."
1652      (interactive)
1653      (let ((value (ffap-other-frame)))
1654        (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1655              (if (listp value) value (list value)))
1656        value))
1657    
1658    (defun ffap-alternate-file ()
1659      "Like `ffap' and `find-alternate-file'.
1660    Only intended for interactive use."
1661      (interactive)
1662      (let ((ffap-file-finder 'find-alternate-file))
1663        (call-interactively 'ffap)))
1664    
1665    
1666  ;;; Bug Reporter:  ;;; Bug Reporter:
# Line 1665  ffap most of the time." Line 1741  ffap most of the time."
1741                 (not current-prefix-arg)                 (not current-prefix-arg)
1742               current-prefix-arg))               current-prefix-arg))
1743        (let (current-prefix-arg)         ; already interpreted        (let (current-prefix-arg)         ; already interpreted
1744          (call-interactively 'dired))          (call-interactively ffap-directory-finder))
1745      (or filename (setq filename (dired-at-point-prompter)))      (or filename (setq filename (dired-at-point-prompter)))
1746      (cond      (cond
1747       ((ffap-url-p filename)       ((ffap-url-p filename)
1748        (funcall ffap-url-fetcher filename))        (funcall ffap-url-fetcher filename))
1749       ((and ffap-dired-wildcards       ((and ffap-dired-wildcards
1750             (string-match ffap-dired-wildcards filename))             (string-match ffap-dired-wildcards filename))
1751        (dired filename))        (funcall ffap-directory-finder filename))
1752       ((file-exists-p filename)       ((file-exists-p filename)
1753        (if (file-directory-p filename)        (if (file-directory-p filename)
1754            (dired (expand-file-name filename))            (funcall ffap-directory-finder
1755          (dired (concat (expand-file-name filename) "*"))))                     (expand-file-name filename))
1756            (funcall ffap-directory-finder
1757                     (concat (expand-file-name filename) "*"))))
1758       ((and (file-writable-p       ((and (file-writable-p
1759              (or (file-name-directory (directory-file-name filename))              (or (file-name-directory (directory-file-name filename))
1760                  filename))                  filename))
1761             (y-or-n-p "Directory does not exist, create it? "))             (y-or-n-p "Directory does not exist, create it? "))
1762        (make-directory filename)        (make-directory filename)
1763        (dired filename))        (funcall ffap-directory-finder filename))
1764       ((error "No such file or directory `%s'" filename)))))       ((error "No such file or directory `%s'" filename)))))
1765    
1766  (defun dired-at-point-prompter (&optional guess)  (defun dired-at-point-prompter (&optional guess)
# Line 1712  ffap most of the time." Line 1790  ffap most of the time."
1790           (and guess (ffap-highlight))))           (and guess (ffap-highlight))))
1791      (ffap-highlight t)))      (ffap-highlight t)))
1792    
1793    ;;; ffap-dired-other-*, ffap-list-directory commands:
1794    
1795    (defun ffap-dired-other-window ()
1796      "Like `dired-at-point', but put buffer in another window.
1797    Only intended for interactive use."
1798      (interactive)
1799      (let (value)
1800        (switch-to-buffer-other-window
1801         (save-window-excursion
1802           (setq value (call-interactively 'dired-at-point))
1803           (current-buffer)))
1804        value))
1805    
1806    (defun ffap-dired-other-frame ()
1807      "Like `dired-at-point', but put buffer in another frame.
1808    Only intended for interactive use."
1809      (interactive)
1810      ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1811      (let* ((win (selected-window))
1812             (wdp (window-dedicated-p win))
1813             value)
1814        (unwind-protect
1815            (progn
1816              (set-window-dedicated-p win nil)
1817              (switch-to-buffer-other-frame
1818               (save-window-excursion
1819                 (setq value (call-interactively 'dired-at-point))
1820                 (current-buffer))))
1821          (set-window-dedicated-p win wdp))
1822        value))
1823    
1824    (defun ffap-list-directory ()
1825      "Like `dired-at-point' and `list-directory'.
1826    Only intended for interactive use."
1827      (interactive)
1828      (let ((ffap-directory-finder 'list-directory))
1829        (call-interactively 'dired-at-point)))
1830    
1831    
1832  ;;; Offer default global bindings (`ffap-bindings'):  ;;; Offer default global bindings (`ffap-bindings'):
1833    
1834  (defvar ffap-bindings  (defvar ffap-bindings
1835     '(     '(
1836       (global-set-key [S-mouse-3] 'ffap-at-mouse)       (global-set-key [S-mouse-3] 'ffap-at-mouse)
1837       (global-set-key [C-S-mouse-3] 'ffap-menu)       (global-set-key [C-S-mouse-3] 'ffap-menu)
1838    
1839       (global-set-key "\C-x\C-f" 'find-file-at-point)       (global-set-key "\C-x\C-f" 'find-file-at-point)
1840         (global-set-key "\C-x\C-r" 'ffap-read-only)
1841         (global-set-key "\C-x\C-v" 'ffap-alternate-file)
1842    
1843       (global-set-key "\C-x4f"   'ffap-other-window)       (global-set-key "\C-x4f"   'ffap-other-window)
1844       (global-set-key "\C-x5f"   'ffap-other-frame)       (global-set-key "\C-x5f"   'ffap-other-frame)
1845         (global-set-key "\C-x4r"   'ffap-read-only-other-window)
1846         (global-set-key "\C-x5r"   'ffap-read-only-other-frame)
1847    
1848       (global-set-key "\C-xd"    'dired-at-point)       (global-set-key "\C-xd"    'dired-at-point)
1849         (global-set-key "\C-x4d"   'ffap-dired-other-window)
1850         (global-set-key "\C-x5d"   'ffap-dired-other-frame)
1851         (global-set-key "\C-x\C-d" 'ffap-list-directory)
1852    
1853       (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)       (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
1854       (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)       (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
1855       (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)       (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)

Legend:
Removed from v.1.45  
changed lines
  Added in v.1.46

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26