home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / gnu / emacs / sources / 884 < prev    next >
Encoding:
Text File  |  1992-12-17  |  9.7 KB  |  276 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!mcsun!sunic!kth.se!News.kth.se!aho
  3. From: aho@thalamus.sans.kth.se (Anders Holst)
  4. Subject: aho-dired.el
  5. Message-ID: <AHO.92Dec17212547@thalamus.sans.kth.se>
  6. Sender: usenet@kth.se (Usenet)
  7. Nntp-Posting-Host: thalamus.sans.kth.se
  8. Organization: /home/aho/.organization
  9. Date: Thu, 17 Dec 1992 20:25:47 GMT
  10. Lines: 264
  11.  
  12. This is my additions to normal dired (NOT tree-dired). See the
  13. discussion in a previous article, or the documentation below for
  14. details.
  15.  
  16. ;;
  17. ;;  File: aho-dired.el
  18. ;; 
  19. ;;  Author: Anders Holst (aho@sans.kth.se)
  20. ;;
  21. ;;  Last change: 12 December 1992
  22. ;;
  23. ;;  Copyright (C) Anders Holst
  24. ;;
  25. ;;  ----------------------------------------------------------------------
  26. ;;  This program is free software; you can redistribute it and/or modify
  27. ;;  it under the terms of the GNU General Public License as published by
  28. ;;  the Free Software Foundation; either version 1, or (at your option)
  29. ;;  any later version.
  30. ;; 
  31. ;;  This program is distributed in the hope that it will be useful,
  32. ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  33. ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34. ;;  GNU General Public License for more details.
  35. ;; 
  36. ;;  You should have received a copy of the GNU General Public License
  37. ;;  along with your copy of Emacs; if not, write to the Free Software
  38. ;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  39. ;;  ----------------------------------------------------------------------
  40. ;;
  41. ;;  
  42. ;;  INSTALLATION
  43. ;;
  44. ;;  The easiest way to install this, is to put the file in your load-path, 
  45. ;;  and put the following in your .emacs :
  46. ;;  
  47. ;;    (autoload 'dired "aho-dired" () t)
  48. ;;    (autoload 'dired-other-window "aho-dired" () t)
  49. ;;    (autoload 'dired-noselect "aho-dired" ())
  50. ;;
  51. ;;
  52. ;;  DESCRIPTION
  53. ;;
  54. ;;  This file implements the following additions to (normal) dired:
  55. ;;
  56. ;;  * soft links to files in dired, 'l'
  57. ;;  * making of directories from dired, 'm'
  58. ;;  * printing of files from dired, 'w'
  59. ;;  * shell command on a file in dired, '!'
  60. ;;  * Copy/Rename/Link needs only the directory name
  61. ;;  * Defaulting to last directory used in Copy/Rename/Link
  62. ;;  * Uppdating of all dired-buffers at Copy/Rename/Link, and sorting in
  63. ;;    alphabetically of new files/links.
  64. ;;  * More emphasized tree-structure between the different dired-buffers.
  65. ;;    'f' and 'v' climbs (as before) down to a sub-directory, 'q' climbs
  66. ;;    up again (after having killed the dired-buffer quietly). (All
  67. ;;    dired-buffers in the 'tree' are kept buried, except the current.)
  68. ;;  
  69.  
  70.  
  71. (require 'dired)
  72.  
  73. (defun make-directory (fn)
  74.   "Make a directory."
  75.   (if (file-exists-p fn)
  76.       (error "Cannot make directory %s: file already exists" fn)
  77.     (call-process "mkdir" nil nil nil fn))
  78.   (or (file-directory-p fn)
  79.       (error "Could not make directory %s" fn)))
  80.  
  81. ; Ridiculous that this should be needed just because someone tries to be smart
  82. ; and makes string-lessp sort according to LOCALE, which is wrong here since
  83. ; ls doesn't care about that. I dont want to think about how much extra time
  84. ; this might take:
  85. (if (or (getenv "LANG") (getenv "LC_LOCALE"))
  86.  
  87.     (defun my-string-lessp (str1 str2)
  88.       (let ((maxlen (min (length str1) (length str2)))
  89.         (i 0))
  90.     (while (and (< i maxlen)
  91.             (= (string-to-char (substring str1 i)) 
  92.                (string-to-char (substring str2 i))))
  93.       (setq i (1+ i)))
  94.     (< (string-to-char (substring str1 i))
  95.        (string-to-char (substring str2 i)))))
  96.  
  97.     (fset 'my-string-lessp 'string-lessp))
  98.  
  99. (defun dired-add-entry (directory filename)
  100.   "If the buffer contains DIRECTORY, add an entry for FILENAME,
  101. inserted alfabetically"
  102.   (if (string-equal directory default-directory)
  103.       (let ((buffer-read-only nil))
  104.     (save-excursion
  105.       (beginning-of-buffer)
  106.       (forward-line 1)
  107.       (while (and (not (eobp)) 
  108.               (my-string-lessp (dired-get-filename t) filename))
  109.         (forward-line 1))
  110.       (call-process "ls" nil t nil
  111.             "-d" dired-listing-switches (concat directory 
  112.                                                 filename))
  113.       (forward-line -1)
  114.       (insert "  ")
  115.       (if (dired-move-to-filename)
  116.           (let ((beg (point))
  117.             (end (progn (skip-chars-forward "^ \n") (point))))
  118.         (setq filename (buffer-substring beg end))
  119.         (delete-region beg end)
  120.         (insert (file-name-nondirectory filename)))
  121.           (let ((beg (progn (beginning-of-line) (point)))
  122.             (end (progn (forward-line 1) (point))))
  123.         (message (buffer-substring beg (- end 1)))
  124.         (delete-region beg end)
  125.         (ding)))))))
  126.  
  127. (defun dired-add-to-all (directory filename)
  128.   (let ((buf (current-buffer))
  129.     (blist (buffer-list)))
  130.     (while blist
  131.       (set-buffer (car blist))
  132.       (if (and (eq major-mode 'dired-mode)
  133.            (equal dired-directory directory))
  134.       (dired-add-entry directory filename))
  135.       (setq blist (cdr blist)))
  136.     (set-buffer buf)))
  137.  
  138. (defun default-to-file (to-file)
  139.   (if (file-directory-p to-file)
  140.       (if (equal (file-name-nondirectory to-file) "")
  141.       (concat to-file (dired-get-filename t))
  142.       (concat to-file "/" (dired-get-filename t)))
  143.       to-file))
  144.  
  145. (defun kill-dired-buffer ()
  146.   "Kill dired buffer quietly and switch to invoking buffer if any"
  147.   (interactive)
  148.   (let ((ret-buf father-buffer))
  149.     (kill-buffer (current-buffer))
  150.     (if (and (bufferp ret-buf)
  151.          (buffer-name ret-buf))
  152.     (if (get-buffer-window ret-buf)
  153.         (select-window (get-buffer-window ret-buf))
  154.         (switch-to-buffer ret-buf)))))
  155.  
  156. (defun dired-link-file (link-name)
  157.   "Make a link to this file named LINK-NAME"
  158.   (interactive 
  159.    (list (read-file-name (format "Name of link to %s : "
  160.                  (dired-get-filename t))
  161.              last-used-directory)))
  162.   (setq link-name (expand-file-name (default-to-file link-name)))
  163.   (make-symbolic-link (dired-get-filename) link-name)
  164.   (setq last-used-directory (file-name-directory link-name))
  165.   (dired-add-to-all (file-name-directory link-name)
  166.             (file-name-nondirectory link-name))
  167.   (dired-move-to-filename))
  168.  
  169. (defun dired-rename-file (to-file)
  170.   "Rename this file to TO-FILE."
  171.   (interactive
  172.    (list (read-file-name (format "Rename %s to: "
  173.                  (dired-get-filename t))
  174.              last-used-directory)))
  175.   (setq to-file (expand-file-name (default-to-file to-file)))
  176.   (rename-file (dired-get-filename) to-file)
  177.   (setq last-used-directory (file-name-directory to-file))
  178.   (let ((buffer-read-only nil))
  179.     (beginning-of-line)
  180.     (delete-region (point) (progn (forward-line 1) (point)))
  181.     (dired-add-to-all (file-name-directory to-file)
  182.               (file-name-nondirectory to-file))
  183.     (dired-move-to-filename)))
  184.  
  185. (defun dired-copy-file (to-file)
  186.   "Copy this file to TO-FILE."
  187.   (interactive 
  188.    (list (read-file-name (format "Copy %s to: "
  189.                  (dired-get-filename t))
  190.              last-used-directory)))
  191.   (setq to-file (expand-file-name (default-to-file to-file)))
  192.   (copy-file (dired-get-filename) to-file)
  193.   (setq last-used-directory (file-name-directory to-file))
  194.   (dired-add-to-all (file-name-directory to-file)
  195.             (file-name-nondirectory to-file))
  196.   (dired-move-to-filename))
  197.  
  198. (defun dired-make-directory (dir-name)
  199.   "Make a subdirectory called DIR-NAME."
  200.   (interactive 
  201.    (list (read-file-name "Name of new directory : " last-used-directory)))
  202.   (setq dir-name (directory-file-name (expand-file-name dir-name)))
  203.   (make-directory dir-name)
  204.   (setq last-used-directory (file-name-as-directory dir-name))
  205.   (dired-add-to-all (file-name-directory dir-name)
  206.             (file-name-nondirectory dir-name))
  207.   (dired-move-to-filename))
  208.  
  209. (defun dired-find-file ()
  210.   "In dired, visit the file or directory named on this line."
  211.   (interactive)
  212.   (if (file-directory-p (dired-get-filename))
  213.       (let ((curr-buf (current-buffer)))
  214.     (dired (dired-get-filename))
  215.     (setq father-buffer curr-buf)
  216.     (bury-buffer curr-buf))
  217.       (find-file (dired-get-filename))))
  218.  
  219. (defun dired-view-file ()
  220.   "In dired, examine a file in view mode, returning to dired when done."
  221.   (interactive)
  222.   (if (file-directory-p (dired-get-filename))
  223.       (let ((curr-buf (current-buffer)))
  224.     (dired (dired-get-filename))
  225.     (setq father-buffer curr-buf)
  226.     (bury-buffer curr-buf))
  227.       (view-file (dired-get-filename))))
  228.  
  229. (defun dired-print-file ()
  230.   "Print this file, using the command in lpr-command and with lpr-switches"
  231.   (interactive)
  232.   (let* ((file (dired-get-filename t))
  233.      (flags (mapconcat (function identity) lpr-switches " ")))
  234.     (if (y-or-n-p (format "Print %s ? " file))
  235.     (call-process lpr-command nil nil nil flags file))))
  236.  
  237. (defun dired-shell-command (cmd)
  238.   "Apply COMMAND to this file"
  239.   (interactive "sShell command: ")
  240.   (shell-command (concat cmd " " (dired-get-filename t))))
  241.  
  242. (defun dired-delete-file-now ()
  243.   "Removes the file on this line immediately (dont use this)"
  244.   (interactive)
  245.   (let ((buffer-read-only nil))
  246.     (beginning-of-line)
  247.     (condition-case ()
  248.     (let ((fn (dired-get-filename)))
  249.       (if (y-or-n-p (format "Really delete %s now ? " 
  250.                 (file-name-nondirectory fn)))
  251.           (progn
  252.         (if (file-directory-p fn)
  253.             (call-process "rmdir" nil nil nil fn)
  254.             (delete-file fn))
  255.         (delete-region (point)
  256.                    (progn (forward-line 1) (point))))))
  257.       (error (delete-char 1)
  258.          (insert " ")
  259.          (message "Deletion failed: %s"
  260.               (dired-get-filename t))))))
  261.  
  262. (defvar father-buffer () "This buffers father in the dired tree")
  263. (make-variable-buffer-local 'father-buffer)
  264. (defvar last-used-directory () "Default directory in copy/rename/link file")
  265. (make-variable-buffer-local 'last-used-directory)
  266.  
  267. (define-key dired-mode-map "q" 'kill-dired-buffer)
  268. (define-key dired-mode-map "l" 'dired-link-file)
  269. (define-key dired-mode-map "c" 'dired-copy-file)
  270. (define-key dired-mode-map "r" 'dired-rename-file)
  271. (define-key dired-mode-map "m" 'dired-make-directory)
  272. (define-key dired-mode-map "f" 'dired-find-file)
  273. (define-key dired-mode-map "v" 'dired-view-file)
  274. (define-key dired-mode-map "w" 'dired-print-file)
  275. (define-key dired-mode-map "!" 'dired-shell-command)
  276.