home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / dired-guess.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  4.8 KB  |  122 lines

  1. ;;; -*- Mode: Emacs-lisp -*- ;;;
  2. ;;; dired-guess.el - In Dired, guess what shell command to apply.
  3.  
  4. ;;; Copyright (C) 1991, 1992 Gregory N. Shapiro
  5. ;;;
  6. ;;; Author:  Gregory N. Shapiro   gshapiro@wpi.wpi.edu
  7. ;;;
  8. ;;; This program is free software; you can redistribute it and/or modify
  9. ;;; it under the terms of the GNU General Public License as published by
  10. ;;; the Free Software Foundation; either version 2, or (at your option)
  11. ;;; any later version.
  12. ;;;
  13. ;;; This program is distributed in the hope that it will be useful,
  14. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;;; GNU General Public License for more details.
  17. ;;;
  18. ;;; A copy of the GNU General Public License can be obtained from this
  19. ;;; program's author (send electronic mail to the above address) or from
  20. ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. ;;; This extension to Sebastian Kremer's (sk@thp.Uni-Koeln.DE) Tree-Dired
  24. ;;; permits dired to guess a shell command to use when the user performs
  25. ;;; a shell command on a single file.
  26. ;;;
  27. ;;; New variables (user options):
  28. ;;;    dired-auto-shell-command-alist
  29. ;;;    dired-auto-shell-use-last-extension
  30. ;;;    dired-guess-have-gnutar
  31. ;;;
  32. ;;; Replaces procedures:
  33. ;;;    dired-read-shell-command  (new doc, calls dired-guess-shell-command)
  34. ;;;
  35. ;;; Adds procedures:
  36. ;;;    dired-guess-shell-command  (guesses command by comparing file extensions
  37. ;;;                                to dired-auto-shell-command-alist)
  38.  
  39. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  40. ;;    LCD Archive Entry:
  41. ;;    dired-guess|Gregory N. Shapiro|gshapiro@wpi.wpi.edu
  42. ;;    |Guess a Dired shell command from the filename.
  43.  
  44. ;; INSTALLATION
  45. ;;
  46. ;; Put this file into your load-path and add (load "dired-guess") to
  47. ;; your dired-load-hook, e.g.
  48. ;;
  49. ;; (setq dired-load-hook '(lambda ()
  50. ;;               ;; possibly more statements here
  51. ;;              (load "dired-guess")))
  52. ;;
  53. ;; Note: dired-guess must be loaded after dired-extra.
  54. ;;
  55. ;; If dired-auto-shell-use-last-extension is nil, all file extensions will
  56. ;; be used to determine the command to use.  If nil, use all the
  57. ;; extensions.  For example, foo.tar.Z would guess for the .tar.Z extension.
  58. ;; If non-nil, uses only the last extension of the filename. For example,
  59. ;; foo.tar.Z would use the guess for the .Z extension.
  60. ;;
  61. ;; Set dired-guess-have-gnutar to the name of the GNU tar file (defaults to 
  62. ;; "gnutar").  Set to nil if you don't have GNU tar installed on your system.
  63. ;; GNU tar is available for anonymous ftp at prep.ai.mit.edu.
  64.  
  65. (defvar dired-guess-have-gnutar "gnutar"
  66.   "*If non-nil, name of GNU tar (e.g. \"tar\" or \"gnutar\").
  67. GNU tar's `z' switch is used for compressed tar files.
  68. If you don't have GNU tar, set this to nil: a pipe is then used.")
  69.  
  70. (defvar dired-guess-tar (or dired-guess-have-gnutar "tar"))
  71.  
  72. (defvar dired-auto-shell-command-alist
  73.   (list
  74.    '(".Z"     . "uncompress")
  75.    '(".Z.uu" . "uudecode * | uncompress")
  76.    '(".uu"    . "uudecode")
  77.    '(".hqx"   . "mcvert")
  78.    '(".sh"    . "sh")
  79.    '(".shar"  . "unshar")
  80.    (cons ".tar" (concat dired-guess-tar " xvf"))
  81.    (cons ".tar.Z" (if dired-guess-have-gnutar
  82.               (concat dired-guess-tar " xvfz")
  83.             (concat "zcat * | " dired-guess-tar " xvf -")))
  84.    (cons ".tar.Z.uu" (if dired-guess-have-gnutar
  85.              (concat "uudecode * | " dired-guess-tar " xvfz -")
  86.                "uudecode * | zcat | tar xvf -")))
  87.  
  88.   "*Alist of file extensions and their suggested commands.
  89. See also variable `dired-auto-shell-use-last-extension'.")
  90.  
  91. (defvar dired-auto-shell-use-last-extension nil
  92.   "*If non-nil, uses only the last extension of the filename.
  93.   For example, foo.tar.Z would use the guess for the .Z extension.
  94. If nil, use all the extensions.  For example, foo.tar.Z would guess
  95.   for the .tar.Z extension.")
  96.  
  97. (defun dired-read-shell-command (prompt arg files)
  98.   "Read a dired shell command using generic minibuffer history.
  99. This command tries to guess a command from the filename(s)
  100. from the variable `dired-auto-shell-command-alist' (which see)."
  101.   (dired-mark-pop-up
  102.    nil 'shell files            ; bufname type files
  103.    'dired-guess-shell-command        ; function &rest args
  104.    (format prompt (dired-mark-prompt arg files)) files))
  105.  
  106.  
  107. (defun dired-guess-shell-command (prompt files)
  108.   ;;"Ask user with PROMPT for a shell command, guessing a default from FILES."
  109.   (let ((defalt (if (cdr files)
  110.             nil                 ; If more than one file, don't guess
  111.           (cdr (assoc
  112.             (substring (car files) ; Separate extension & lookup
  113.                    (if dired-auto-shell-use-last-extension
  114.                        (string-match "\.[^.]*$" (car files))
  115.                      (string-match "\\." (car files))))
  116.             dired-auto-shell-command-alist)))))
  117.     (if (not (featurep 'gmhist))
  118.     (read-string prompt defalt)
  119.       (if defalt
  120.       (put 'dired-shell-command-history 'default defalt)))
  121.     (read-with-history-in 'dired-shell-command-history prompt)))
  122.