Mercurial > hg > xemacs-beta

comparison lisp/dired/dired-link.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: dired-link.el
4 ;; SUMMARY: Properly resolves UNIX (and Apollo variant) links under dired.
5 ;; Works for both classic dired (V18) and tree dired (V19).
6 ;;
7 ;; AUTHOR: Bob Weiner
8 ;;
9 ;; ORIG-DATE: 09-May-89
10 ;; LAST-MOD: 30-Aug-92 at 19:15:57 by Bob Weiner
11 ;;
12 ;; Copyright (C) 1989, 1991, 1992, Free Software Foundation, Inc.
13 ;; Available for use and distribution under the same terms as GNU Emacs.
14 ;;
15 ;; This file is part of InfoDock.
16 ;;
17 ;; DESCRIPTION:
18 ;;
19 ;; This library is used in conjunction with the Emacs dired facility.
20 ;; To install it, simply load this file or create a
21 ;; dired hook which loads this file. Then use {M-x dired <directory> RTN}
22 ;; or {C-x C-f <directory> RTN} as one normally would.
23 ;;
24 ;; The changes below to 'dired-noselect' assume UNIX shell file
25 ;; abbreviation and UNIX file name conventions.
26 ;;
27 ;; This modified version of the 'dired-noselect' function automatically
28 ;; resolves all recursive links properly and edits the final directory that
29 ;; a link points to, called the link referent. It handles Apollo-isms such
30 ;; as /usr/local -> $(SERVER_LOCAL)/usr/local, /usr/bin ->
31 ;; ../$(SYSTYPE)/usr/bin and /tmp -> `node_data/tmp. It also handles
32 ;; relative links properly as in /usr/local/emacs -> gnu/emacs which must
33 ;; be resolved relative to the '/usr/local' directory.
34 ;;
35 ;; DESCRIP-END.
36
37 ;; ************************************************************************
38 ;; Internal functions
39 ;; ************************************************************************
40
41 ;; Normally, if one performs a dired multiple times on a directory which is a
42 ;; link, a new buffer will be created each time. This is due to the fact
43 ;; that 'dired-find-buffer' is called in 'dired-noselect' before the link is
44 ;; resolved. The following code solves this problem by checking for a
45 ;; previously existing buffer that is performing dired on the directory that
46 ;; the link resolves to. This is also done recursively. If one is found,
47 ;; the dired buffer that shows the link is killed and the previously existing
48 ;; one is used and re-read in.
49
50 (defun dired-link-noselect-classic (dirname)
51 "Like M-x dired but returns the dired buffer as value, does not select it."
52 (or dirname (setq dirname default-directory))
53 (setq dirname (dired-link-referent (directory-file-name dirname)))
54 (if (equal dirname "")
55 nil
56 (if (= (aref dirname 0) ?~) (setq dirname (expand-file-name dirname)))
57 (if (file-directory-p dirname)
58 (setq dirname (file-name-as-directory dirname)))
59 (let ((buffer (dired-find-buffer dirname)))
60 (set-buffer buffer)
61 (dired-readin dirname buffer)
62 (dired-move-to-filename)
63 (dired-mode dirname)
64 buffer)))
65
66 (defun dired-link-noselect-tree (dirname &optional switches)
67 "Like `dired' but returns the dired buffer as value, does not select it."
68 (or dirname (setq dirname default-directory))
69 (setq dirname (expand-file-name
70 (dired-link-referent (directory-file-name dirname))))
71 (if (file-directory-p dirname)
72 (setq dirname (file-name-as-directory dirname)))
73 (dired-internal-noselect dirname switches))
74
75 ;; Overload as appropriate for Classic (V18) or Tree Dired
76 (fset 'dired-noselect (if (fboundp 'dired-internal-noselect)
77 'dired-link-noselect-tree
78 'dired-link-noselect-classic))
79
80 ;;
81 ;; Resolves all UNIX links.
82 ;; Works with Apollo's variant and other strange links. Will fail on
83 ;; Apollos if the '../' notation is used to move just above the '/'
84 ;; directory level. This is fairly uncommon and so the problem has not been
85 ;; fixed.
86 ;;;
87 (defun dired-link-referent (linkname)
88 "Returns expanded file or directory referent of LINKNAME.
89 LINKNAME should not end with a directory delimiter.
90 If LINKNAME is not a string, returns nil.
91 If LINKNAME is not a link, it is simply expanded and returned."
92 (if (not (stringp linkname))
93 nil
94 (let ((referent))
95 (while (setq referent (file-symlink-p linkname))
96 (setq linkname (dired-link-expand
97 referent (file-name-directory linkname)))))
98 (dired-link-expand linkname (file-name-directory linkname))))
99
100 (defun dired-link-expand (referent dirname)
101 "Expands REFERENT relative to DIRNAME and returns."
102 (let ((var-link)
103 (dir dirname))
104 (while (string-match "\\$(\\([^\)]*\\))" referent)
105 (setq var-link (getenv (substring referent (match-beginning 1)
106 (match-end 1)))
107 referent (concat (substring referent 0 (match-beginning 0))
108 var-link
109 (substring referent (match-end 0)))))
110 ;; If referent is not an absolute path
111 (let ((nd-abbrev (string-match "`node_data" referent)))
112 (if (and nd-abbrev (= nd-abbrev 0))
113 (setq referent (concat
114 ;; Prepend node name given in dirname, if any
115 (and (string-match "^//[^/]+" dirname)
116 (substring dirname 0 (match-end 0)))
117 "/sys/" (substring referent 1)))))
118 (while (string-match "\\.\\." referent)
119 ;; Match to "//.." or "/.." at the start of link referent
120 (while (string-match "^\\(//\\.\\.\\|/\\.\\.\\)\\(/\\|$\\)" referent)
121 (setq referent (substring referent (match-end 1))))
122 ;; Match to "../" or ".." at the start of link referent
123 (while (string-match "^\\.\\.\\(/\\|$\\)" referent)
124 (setq dir (file-name-directory (directory-file-name dir))
125 referent (concat dir (substring referent (match-end 0)))))
126 ;; Match to rest of "../" in link referent
127 (while (string-match "[^/]+/\\.\\./" referent)
128 (setq referent (concat (substring referent 0 (match-beginning 0))
129 (substring referent (match-end 0))))))
130 (and (/= (aref referent 0) ?~)
131 (/= (aref referent 0) ?/)
132 (setq referent (concat dirname referent))))
133 referent)
134
135 (provide 'dired-link)