code.delx.au - gnu-emacs/blob - lisp/uncompress.el

   1 ;; When we are about to make a backup file,
   2 ;; uncompress the file we visited
   3 ;; so that making the backup can work properly.
   4 ;; This is used as a write-file-hook.
   5
   6 (defun uncompress-backup-file ()
   7   (and buffer-file-name make-backup-files (not buffer-backed-up)
   8        (not (file-exists-p buffer-file-name))
   9        (call-process "uncompress" nil nil nil buffer-file-name))
  10   nil)
  11
  12 (or (assoc "\\.Z$" auto-mode-alist)
  13     (setq auto-mode-alist
  14           (cons '("\\.Z$" . uncompress-while-visiting) auto-mode-alist)))
  15
  16 (defun uncompress-while-visiting ()
  17   "Temporary \"major mode\" used for .Z files, to uncompress the contents.
  18 It then selects a major mode from the uncompressed file name and contents."
  19   (if (and (not (null buffer-file-name))
  20            (string-match "\\.Z$" buffer-file-name))
  21       (set-visited-file-name
  22        (substring buffer-file-name 0 (match-beginning 0))))
  23   (message "Uncompressing...")
  24   (let ((buffer-read-only nil))
  25     (shell-command-on-region (point-min) (point-max) "uncompress" t))
  26   (message "Uncompressing...done")
  27   (set-buffer-modified-p nil)
  28   (make-local-variable 'write-file-hooks)
  29   (or (memq 'uncompress-backup-file write-file-hooks)
  30       (setq write-file-hooks (cons 'uncompress-backup-file write-file-hooks)))
  31   (normal-mode))
  32
  33 (or (memq 'find-compressed-version find-file-not-found-hooks)
  34     (setq find-file-not-found-hooks
  35           (cons 'find-compressed-version find-file-not-found-hooks)))
  36
  37 (defun find-compressed-version ()
  38   "Hook to read and uncompress the compressed version of a file."
  39   ;; Just pretend we had visited the compressed file,
  40   ;; and uncompress-while-visiting will do the rest.
  41   (if (file-exists-p (concat buffer-file-name ".Z"))
  42       (progn
  43         (setq buffer-file-name (concat buffer-file-name ".Z"))
  44         (insert-file-contents buffer-file-name t)
  45         (goto-char (point-min))
  46         (setq error nil)
  47         t)))