home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / a / atav11.zip / ZCAT.EL < prev   
Lisp/Scheme  |  1993-01-13  |  5KB  |  127 lines
  1. ;From ark1!uakari.primate.wisc.edu!aplcen!uunet!mcsun!ukc!mucs!graham@r3.cs.man.ac.uk Sun Dec 17 22:39:01 EST 1989
  2. ;Article 1077 of comp.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!aplcen!uunet!mcsun!ukc!mucs!graham@r3.cs.man.ac.uk
  4. ;From: graham@r3.cs.man.ac.uk (Graham Gough)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: Re: Automatic uncompress of .Z files?
  7. ;Message-ID: <408@m1.cs.man.ac.uk>
  8. ;Date: 15 Dec 89 15:35:11 GMT
  9. ;Sender: news@cs.man.ac.uk
  10. ;Organization: University of Manchester, UK
  11. ;Lines: 91
  12. ;
  13. ;>From article <7365@cs.utexas.edu>, by ctp@cs.utexas.edu (Clyde T. Poole):
  14. ;> Sometime awhile back, I believe I saw a posting including some emacs
  15. ;> lisp code to implement the automatic uncompress of .Z files (files
  16. ;> compressed with the unix compress utility).  I would appreciate it if
  17. ;> someone would provide me with the code or give me pointers to where I
  18. ;> can find it.
  19. ;> 
  20. ;
  21. ;This  isn't the one that was posted then and isn't  the  most  elegant
  22. ;piece  of  e-lisp  I've  ever  written,  but it's served me well for a
  23. ;couple of years. I hope it does what is required,
  24. ;
  25. ;Graham Gough
  26.  
  27. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!uwm.edu!cs.utexas.edu!rutgers!mit-eddie!bloom-beacon!eru!luth!sunic!mcsun!ukc!mucs!graham@r3.cs.man.ac.uk Mon Jan  8 10:02:12 1990
  28. ;Article 1151 of comp.emacs:
  29. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!uwm.edu!cs.utexas.edu!rutgers!mit-eddie!bloom-beacon!eru!luth!sunic!mcsun!ukc!mucs!graham@r3.cs.man.ac.uk
  30. ;From graham@r3.cs.man.ac.uk
  31. ;Newsgroups: comp.emacs
  32. ;Subject: zcat.el : Repost
  33. ;Message-ID: <552@m1.cs.man.ac.uk>
  34. ;Date: 4 Jan 90 15:38:44 GMT
  35. ;Sender: news@cs.man.ac.uk
  36. ;Organization: University of Manchester, UK
  37. ;Lines: 86
  38. ;
  39. ;This  is  a  repost  prompted  by  RMS's message re copyright, since I
  40. ;inadvertently  omitted the copyright notice from my previous posting. 
  41. ;It also fixes a bug by replacing a call to shell-command-on-region  by
  42. ;one to call-process-region.
  43. ;
  44. ;Graham Gough
  45. ;
  46. ;----------------------------------------------------------
  47. ;Graham D. Gough, Department of Computer Science,
  48. ;University of Manchester, Oxford Road, Manchester, M13 9PL, U.K.
  49. ;Tel: (+44) 61-275 6277
  50. ;JANET: graham@uk.ac.man.cs   USENET: ..ukc!man.cs.r3!graham
  51. ;
  52. ;------------------------cut here ------------------------
  53. ;;
  54. ;; zcat.el
  55. ;;
  56. ;; Copyright (C) 1989 Graham D. Gough
  57. ;;
  58. ;; This file is not  part of GNU Emacs, however, GNU copyleft applies
  59. ;;
  60. ;; Visiting compressed files.
  61. ;;
  62. ;; Graham Gough (graham@uk.ac.man.cs.ux) 13/5/87
  63. ;; 
  64. ;; To use just load via .emacs, everything else is automatic
  65. ;;
  66.  
  67. (or (assoc "\\.Z$" auto-mode-alist)
  68.     (setq auto-mode-alist (append  auto-mode-alist '(("\\.Z$" . zcat-buffer)))))
  69.  
  70. (defvar delete-compressed-files t "*Non-nil means delete the compressed version 
  71.  of a file when a buffer is saved. Only has effect if original file visited
  72.  was compressed.")
  73.  
  74. (defun delete-compressed-file ()
  75.   "   Deletes (on confirmation) compressed version of file associated with
  76.    current buffer"
  77.   (interactive)
  78.   (let ((fname (concat (buffer-file-name) ".Z"))
  79.     ret)
  80.     (if  (file-exists-p fname)
  81.     (progn
  82.       (setq answer (yes-or-no-p (concat "Delete compressed file (" fname ")? ")))
  83.       (if answer 
  84.           (condition-case ()
  85.           (delete-file fname)
  86.         (error
  87.          (message "Can't delete compressed file.")
  88.          (setq ret t))))))
  89.     nil))
  90.  
  91. (defun zcat-buffer ()
  92.   "   Uncompresses contents of buffer, respecting read-only status. Changes
  93.    buffer-name, visited-file-name and mode appropriately. If buffer is saved, 
  94.    compressed file is (optionally) deleted.
  95.    Bug: Doesn't find an existing uncompressed buffer, creates a new one"
  96.   (interactive)
  97.   (let ((buf-stat buffer-read-only)         ; remember read-only status
  98.     (new-buf-name (substring (buffer-name) 0 -2)) ; get new buffer name
  99.     (new-buf-fname (substring (buffer-file-name) 0 -2))) ; and file name
  100.     (setq buffer-read-only nil)
  101.     (message "Uncompressing %s .." (buffer-name))
  102.     (call-process-region  (point-min)  (point-max)  "zcat" t t)
  103.     (message "Done")
  104.     (setq buffer-read-only buf-stat)         ; reinstate original
  105.                          ; buffer-read-only status
  106.     (rename-buffer
  107.      (let ((newbname new-buf-name)
  108.        (counter 1))
  109.        (while (get-buffer newbname)
  110.      (setq newbname
  111.            (concat new-buf-name "<" (prin1-to-string counter) ">"))
  112.      (setq counter (1+ counter)))
  113.        newbname))                 ;  generate appropriate name.
  114.     (set-visited-file-name new-buf-fname)
  115.     (set-auto-mode)
  116.     (if (not delete-compressed-files)
  117.     nil
  118.       (make-variable-buffer-local 'write-file-hooks)
  119.       (setq write-file-hooks
  120.         (append write-file-hooks '(delete-compressed-file))))
  121.     (set-buffer-modified-p nil)             ; this means that auto-saves
  122.                          ; and saves only take place
  123.                          ; if buffer is really modified
  124.     (goto-char (point-min))))
  125.  
  126.  
  127.