|
0
|
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)
|
