home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / compress2.el < prev    next >
Encoding:
Text File  |  1991-08-04  |  3.7 KB  |  114 lines
  1. ; Path: dg-rtp!rock!mcnc!stanford.edu!agate!spool.mu.edu!uwm.edu!linac!pacific.mps.ohio-state.edu!cis.ohio-state.edu!kernel.co.UK!mjh
  2. ; From: mjh@kernel.co.UK (Mark J Hewitt)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: Re: Wanted: Uncompress on load / Compress on save
  5. ; Date: 23 Jul 91 16:22:34 GMT
  6. ; References: <9107230124.AAmaud27574@maud.ifi.uio.no>
  7. ; Organization: Source only  Discussion and requests in gnu.emacs.help.
  8.  
  9. ;;; -*- emacs-lisp -*-
  10. ;
  11. ;  compress.el    Edit compressed files transparently
  12. ;
  13. ;  Mark J. Hewitt  Kernel Technology Ltd.  1-Feb-89
  14. ;
  15. ;;;
  16.  
  17. ;; LCD Archive Entry:
  18. ;; compress2|Mark J Hewitt|mjh@kernel.co.UK
  19. ;; |Edit compressed files transparently
  20. ;; |89-02-01||~/misc/compress2.el.Z|
  21.  
  22. (defvar uncompress-command "uncompress"
  23.   "The command used to uncompress a buffer.")
  24.  
  25. (defvar compress-command "compress"
  26.   "The command used to compress a buffer.")
  27.  
  28. ;;; Always uncompress .Z files
  29. (setq auto-mode-alist
  30.       (cons '("\\.Z$" . uncompress-file-while-visiting) auto-mode-alist))
  31.  
  32. ;;; How we uncompress the file
  33. (defun uncompress-file-while-visiting nil
  34.   "Uncompress a file into a buffer, and then set appropriate \"auto-mode\""
  35.   (if (and (not (null buffer-file-name))
  36.        (string-match "\\.Z$" buffer-file-name))
  37.       (set-visited-file-name
  38.        (substring buffer-file-name 0 (match-beginning 0))))
  39.   (let (read-only-status buffer-read-only)
  40.     (setq buffer-read-only nil)
  41.     (message "Uncompressing...")
  42.     (shell-command-on-region (point-min) (point-max) uncompress-command t)
  43.     (message "Uncompressing...Done")
  44.     (setq buffer-read-only read-only-status))
  45.   (set-buffer-modified-p nil)
  46.   (normal-mode)
  47.   (if (not (assq 'compressed-mode minor-mode-alist))
  48.       (setq minor-mode-alist (cons '(compressed-mode " Compressed")
  49.                    minor-mode-alist)))
  50.   (setq compressed-mode t)
  51.   (or (memq (function compress-file-while-saving) write-file-hooks)
  52.       (setq write-file-hooks
  53.         (cons (function compress-file-while-saving)
  54.           write-file-hooks))))
  55.  
  56.  
  57. ;;; Compress a file when saving
  58. (defun compress-file-while-saving nil
  59.   "Compress a buffer prior to saving it"
  60.   (if (and (buffer-modified-p) compressed-mode
  61.        (y-or-n-p (concat "Re-compress " buffer-file-name "? ")))
  62.       (progn
  63.     (message "Compressing...")
  64.     (let* ((current-filename (concat buffer-file-name ".Z"))
  65.            (buffer (generate-new-buffer current-filename)))
  66.  
  67.       (save-excursion
  68.         (set-buffer buffer)
  69.         (erase-buffer))
  70.  
  71.       (call-process-region (point-min) (point-max) shell-file-name
  72.                    nil buffer nil "-c" compress-command)
  73.       (message "Compressing...Done")
  74.  
  75.       (save-excursion
  76.         (set-buffer buffer)
  77.         (make-local-variable 'require-final-newline)
  78.         (setq require-final-newline nil)
  79.         (write-file current-filename))
  80.  
  81.       (kill-buffer buffer))
  82.     (set-buffer-modified-p nil)
  83.     t)
  84.     nil))
  85.  
  86.  
  87. ;;; Look for the compressed version of a file
  88. (defun find-compressed-file nil
  89.   "Read and uncompress a file"
  90.   (if (file-exists-p (concat buffer-file-name ".Z"))
  91.       (progn
  92.     (setq buffer-file-name (concat buffer-file-name ".Z"))
  93.     (insert-file-contents buffer-file-name t)
  94.     (goto-char (point-min))
  95.     (setq error nil)
  96.     t)))
  97.  
  98. ;;; How we remember what mode this buffer is in
  99. (make-variable-buffer-local 'compressed-mode)
  100.  
  101. ;;; If we can't find the file as given - look for a compressed version
  102. (setq find-file-not-found-hooks
  103.       (cons 'find-compressed-file
  104.         find-file-not-found-hooks))
  105.  
  106. -------------------------------------------------------------------------------
  107. Mark J. Hewitt
  108.  
  109. bangpath: ...!ukc!kernel!mjh        JANET:    mjh@uk.co.kernel
  110. voice:      (+44) 532 484844        other:    mjh@kernel.co.uk
  111. fax:      (+44) 532 404164        old style:  mjh%uk.co.kernel@uk.ac.ukc
  112. paper:    Kernel Technology Ltd, Kernel House, Killingbeck Drive,
  113.     Leeds LS14 6UF, West Yorkshire, UK
  114.