home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / dired-links.el < prev    next >
Encoding:
Text File  |  1991-03-30  |  4.5 KB  |  132 lines
  1. ; Path: ark1!nems!mimsy!haven!uflorida!novavax!weiner
  2. ; >From weiner@novavax.UUCP (Bob Weiner)
  3. ; Newsgroups: comp.emacs
  4. ; Subject: dired-links.el - resolves links in GNU Emacs Dired
  5. ; Date: 26 Oct 89 02:00:55 GMT
  6. ; Organization: Motorola Inc.
  7. ; 
  8. ;;!emacs
  9. ;;
  10. ;; FILE:         dired-links.el
  11. ;; SUMMARY:      Properly resolves UNIX (and Apollo variant) links under dired.
  12. ;; USAGE:        GNU Emacs Lisp Library
  13. ;;
  14. ;; AUTHOR:       Bob Weiner
  15. ;; ORG:          Motorola, Inc., Communications Sector, Applied Research
  16. ;; E-MAIL:       USENET:  weiner@novavax.UUCP
  17. ;;
  18. ;; ORIG-DATE:    09-May-89
  19. ;; LAST-MOD:     25-Oct-89 at 21:42:56 by Bob Weiner
  20. ;;
  21. ;; Copyright (C) 1989 Bob Weiner and Free Software Foundation, Inc.
  22. ;; Available for use and distribution under the same terms as GNU Emacs.
  23. ;;
  24. ;; This file is not part of GNU Emacs.
  25. ;;
  26. ;; DESCRIPTION:  
  27. ;;
  28. ;;   To install, simply load this file after loading dired.el, or create a
  29. ;;   dired hook which loads this file.
  30. ;;
  31. ;;   The changes below to 'dired-noselect' assume UNIX shell file abbreviation
  32. ;;   and UNIX file name conventions.
  33. ;;
  34. ;;   This modified version of the 'dired-noselect' function automatically
  35. ;;   resolves all recursive links properly and edits the actual directory
  36. ;;   pointed to.  It handles Apollo-isms such as '/usr/local ->
  37. ;;   $(SERVER_LOCAL)/usr/local', '/usr/bin -> ../$(SYSTYPE)/usr/bin' and '/tmp
  38. ;;   -> `node_data/tmp'.  It also handles relative links properly as in
  39. ;;   '/usr/local/emacs -> gnu/emacs' which must be resolved relative to the
  40. ;;   '/usr/local' directory.
  41. ;;
  42. ;; DESCRIP-END.
  43.  
  44.  
  45. ;; Normally, if you perform a dired multiple times on a directory which is a
  46. ;; link, a new buffer will be created each time.  This is due to the fact
  47. ;; that 'dired-find-buffer' is called in 'dired-noselect' before the link is
  48. ;; resolved.  The following code solves this problem by checking for a
  49. ;; previously existing buffer that is performing dired on the directory that
  50. ;; the link resolves to.  This is also done recursively.  If one is found,
  51. ;; the dired buffer that shows the link is killed and the previously existing
  52. ;; one is used and re-read in.
  53.  
  54. (defun dired-noselect (dirname)
  55.   "Like M-x dired but returns the dired buffer as value, does not select it."
  56.   (or dirname (setq dirname default-directory))
  57.   (setq dirname (directory-file-name dirname))
  58.   (if (file-directory-p dirname)
  59.       (setq dirname (file-name-as-directory dirname)))
  60.   (let ((buffer (dired-find-buffer dirname))
  61.     (actual-dir t)
  62.     (actual-buffer))
  63.     (save-excursion
  64.       (set-buffer buffer)
  65.       (while actual-dir
  66.     (if (= (aref dirname 0) ?~) (setq dirname (expand-file-name dirname)))
  67.     (dired-readin dirname buffer)
  68.     (if (setq actual-dir (dired-resolve-link dirname))
  69.         (progn (setq dirname (directory-file-name actual-dir)
  70.              actual-buffer (dired-find-buffer dirname))
  71.            (if (file-directory-p dirname)
  72.                (setq dirname (file-name-as-directory dirname)))))
  73.     (if actual-buffer
  74.         (progn (set-buffer actual-buffer)
  75.            (kill-buffer buffer)
  76.            (setq buffer actual-buffer
  77.              actual-buffer nil))))
  78.       (dired-move-to-filename)
  79.       (dired-mode dirname))
  80.     buffer))
  81.  
  82. (defconst dired-link-string " -> "
  83.   "String pattern in a dired listing line that indicates a link.")
  84.  
  85. ;;;
  86. ;;; Works with Apollo's variant links if variable is first part of the linkname
  87. ;;;
  88. (defun dired-resolve-link (dirname)
  89.   (save-excursion
  90.     (goto-char (point-min))
  91.     (end-of-line)
  92.     (let ((eol (point))
  93.       (actual-dir)
  94.       (buffer-read-only)
  95.       (var-link))
  96.       (goto-char (point-min))
  97.       (if (search-forward dired-link-string eol t)
  98.       (progn (delete-region (point-min) (point))
  99.          (save-excursion
  100.            (end-of-line)
  101.            (setq eol (point)))
  102.          (while (re-search-forward "\\$(\\([^\)]*\\))" eol t)
  103.            (progn (setq var-link (getenv (buffer-substring
  104.                            (match-beginning 1)
  105.                            (match-end 1))))
  106.               (delete-region (match-beginning 0) (match-end 0))
  107.               (insert var-link)))
  108.          (setq actual-dir (buffer-substring (point-min) (1- (point-max))))
  109.          ;; If not an absolute path
  110.          (let ((nd-abbrev (string-match "`node_data" actual-dir)))
  111.            (if (and nd-abbrev (= nd-abbrev 0))
  112.                (setq actual-dir (concat "/sys/"
  113.                         (substring actual-dir 1)))))
  114.          (if (/= (aref actual-dir 0) ?/)
  115.              (setq actual-dir
  116.                (concat 
  117.                  (file-name-directory
  118.                    (substring dirname 0 
  119.                       (if (= (aref dirname
  120.                                (1- (length dirname))) ?/)
  121.                           -1)))
  122.                  actual-dir)))
  123.          actual-dir
  124. )))))
  125.  
  126. (provide 'dired-links)
  127. ;-- 
  128. ;Bob Weiner, Motorola, Inc.,   USENET:  ...!gatech!uflorida!novavax!weiner
  129. ;(407) 738-2087
  130.  
  131.  
  132.