Mercurial > hg > lib > markup

annotate emacs/compress.el @ 13:1cd5c7952aaa default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix failure to read first line of Air/Lava, keep me from swimming in Lava, again!
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sun, 30 Jan 2022 14:49:33 -0500
parents 509549c55989
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
1 ;;; Last edited: Thu Oct 3 12:28:00 1991
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
2 ;;; Handle compressed files
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
3 ;;; adapted by Henry S. Thompson from Miles Bader from ???
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
4 (provide 'compress)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
5
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
6 (defun uncompress-while-visiting ()
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
7 "Temporary \"major mode\" used for .[gzZ] files, to uncompress the contents.
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
8 It then selects a major mode from the uncompressed file name and contents."
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
9 (if (and (not (null buffer-file-name))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
10 (string-match "\\.g?[zZ]$" buffer-file-name))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
11 (set-visited-file-name
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
12 (substring buffer-file-name 0 (match-beginning 0))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
13 (message "Uncompressing...")
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
14 (let ((buffer-read-only nil))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
15 (shell-command-on-region (point-min) (point-max) "zcat" t))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
16 (message "Uncompressing...done")
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
17 (set-buffer-modified-p nil)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
18 (normal-mode))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
19
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
20 (setq auto-mode-alist
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
21 (cons '("\\.g?[zZ]$" . uncompress-while-visiting) auto-mode-alist))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
22
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
23 (defun find-compressed-version ()
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
24 "Hook to read and uncompress the compressed version of a file."
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
25 ;; Just pretend we had visited the compressed file,
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
26 ;; and uncompress-while-visiting will do the rest.
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
27 (let ((exts '("gz" "z" "Z")) ext found)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
28 (while (and exts (setq ext (car exts)) (not found))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
29 (if (file-exists-p (concat buffer-file-name "." ext))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
30 (progn
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
31 (setq buffer-file-name (concat buffer-file-name "." ext))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
32 (insert-file-contents buffer-file-name t)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
33 (goto-char (point-min))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
34 (setq error nil)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
35 t)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
36 (setq exts (cdr exts))))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
37
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
38 (setq find-file-not-found-hooks
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
39 (cons 'find-compressed-version find-file-not-found-hooks))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
40
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
41 (defun compress-again ()
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
42 "Hook to compress the uncompressed version of a file."
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
43 (let ((exts '("gz" "z" "Z")) ext found)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
44 (while (and exts (setq ext (car exts)) (not found))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
45 (if (file-exists-p (concat buffer-file-name "." ext))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
46 (let ((here (current-buffer))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
47 (fake-buffer-file-name (concat buffer-file-name "." ext))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
48 (require-final-newline nil))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
49 (set-buffer (get-buffer-create " *compress*"))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
50 (erase-buffer)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
51 (insert-buffer here)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
52 (message "Compressing...")
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
53 (shell-command-on-region (point-min) (point-max)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
54 (if (equal "Z" ext)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
55 "compress"
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
56 "gzip") t)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
57 (message "Compressing...done")
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
58 (write-region (point-min)(point-max) fake-buffer-file-name)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
59 (bury-buffer (current-buffer))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
60 (set-buffer here)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
61 (set-buffer-modified-p nil)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
62 (setq found t)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
63 t)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
64 (setq exts (cdr exts))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
65 found))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
66
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
67
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
68 (setq write-file-hooks (cons 'compress-again write-file-hooks))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
69