jka-cmpr-hook.el 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388
  1. ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
  2. ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2012
  3. ;; Free Software Foundation, Inc.
  4. ;; Author: jka@ece.cmu.edu (Jay K. Adams)
  5. ;; Maintainer: FSF
  6. ;; Keywords: data
  7. ;; Package: emacs
  8. ;; This file is part of GNU Emacs.
  9. ;; GNU Emacs is free software: you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; GNU Emacs 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. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; This file contains the code to enable and disable Auto-Compression mode.
  21. ;; It is preloaded. The guts of this mode are in jka-compr.el, which
  22. ;; is loaded only when you really try to uncompress something.
  23. ;;; Code:
  24. (defgroup compression nil
  25. "Data compression utilities."
  26. :group 'data)
  27. (defgroup jka-compr nil
  28. "jka-compr customization."
  29. :group 'compression)
  30. (defcustom jka-compr-verbose t
  31. "If non-nil, output messages whenever compressing or uncompressing files."
  32. :version "24.1"
  33. :type 'boolean
  34. :group 'jka-compr)
  35. ;; List of all the elements we actually added to file-coding-system-alist.
  36. (defvar jka-compr-added-to-file-coding-system-alist nil)
  37. (defvar jka-compr-file-name-handler-entry
  38. nil
  39. "`file-name-handler-alist' entry used by jka-compr I/O functions.")
  40. ;; Compiler defvars. These three variables will be defined later with
  41. ;; `defcustom' when everything used in the :set functions is defined.
  42. (defvar jka-compr-compression-info-list)
  43. (defvar jka-compr-mode-alist-additions)
  44. (defvar jka-compr-load-suffixes)
  45. (defvar jka-compr-compression-info-list--internal nil
  46. "Stored value of `jka-compr-compression-info-list'.
  47. If Auto Compression mode is enabled, this is the value of
  48. `jka-compr-compression-info-list' when `jka-compr-install' was last called.
  49. Otherwise, it is nil.")
  50. (defvar jka-compr-mode-alist-additions--internal nil
  51. "Stored value of `jka-compr-mode-alist-additions'.
  52. If Auto Compression mode is enabled, this is the value of
  53. `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
  54. Otherwise, it is nil.")
  55. (defvar jka-compr-load-suffixes--internal nil
  56. "Stored value of `jka-compr-load-suffixes'.
  57. If Auto Compression mode is enabled, this is the value of
  58. `jka-compr-load-suffixes' when `jka-compr-install' was last called.
  59. Otherwise, it is nil.")
  60. (defun jka-compr-build-file-regexp ()
  61. (purecopy
  62. (let ((re-anchored '())
  63. (re-free '()))
  64. (dolist (e jka-compr-compression-info-list)
  65. (let ((re (jka-compr-info-regexp e)))
  66. (if (string-match "\\\\'\\'" re)
  67. (push (substring re 0 (match-beginning 0)) re-anchored)
  68. (push re re-free))))
  69. (concat
  70. (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|"))
  71. "\\(?:"
  72. (mapconcat 'identity re-anchored "\\|")
  73. "\\)" file-name-version-regexp "?\\'"))))
  74. ;; Functions for accessing the return value of jka-compr-get-compression-info
  75. (defun jka-compr-info-regexp (info) (aref info 0))
  76. (defun jka-compr-info-compress-message (info) (aref info 1))
  77. (defun jka-compr-info-compress-program (info) (aref info 2))
  78. (defun jka-compr-info-compress-args (info) (aref info 3))
  79. (defun jka-compr-info-uncompress-message (info) (aref info 4))
  80. (defun jka-compr-info-uncompress-program (info) (aref info 5))
  81. (defun jka-compr-info-uncompress-args (info) (aref info 6))
  82. (defun jka-compr-info-can-append (info) (aref info 7))
  83. (defun jka-compr-info-strip-extension (info) (aref info 8))
  84. (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
  85. (defun jka-compr-get-compression-info (filename)
  86. "Return information about the compression scheme of FILENAME.
  87. The determination as to which compression scheme, if any, to use is
  88. based on the filename itself and `jka-compr-compression-info-list'."
  89. (catch 'compression-info
  90. (let ((case-fold-search nil))
  91. (dolist (x jka-compr-compression-info-list)
  92. (and (string-match (jka-compr-info-regexp x) filename)
  93. (throw 'compression-info x)))
  94. nil)))
  95. (defun jka-compr-install ()
  96. "Install jka-compr.
  97. This adds entries to `file-name-handler-alist' and `auto-mode-alist'
  98. and `inhibit-local-variables-suffixes'."
  99. (setq jka-compr-file-name-handler-entry
  100. (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
  101. (push jka-compr-file-name-handler-entry file-name-handler-alist)
  102. (setq jka-compr-compression-info-list--internal
  103. jka-compr-compression-info-list
  104. jka-compr-mode-alist-additions--internal
  105. jka-compr-mode-alist-additions
  106. jka-compr-load-suffixes--internal
  107. jka-compr-load-suffixes)
  108. (dolist (x jka-compr-compression-info-list)
  109. ;; Don't do multibyte encoding on the compressed files.
  110. (let ((elt (cons (jka-compr-info-regexp x)
  111. '(no-conversion . no-conversion))))
  112. (push elt file-coding-system-alist)
  113. (push elt jka-compr-added-to-file-coding-system-alist))
  114. (and (jka-compr-info-strip-extension x)
  115. ;; Make entries in auto-mode-alist so that modes
  116. ;; are chosen right according to the file names
  117. ;; sans `.gz'.
  118. (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
  119. ;; Also add these regexps to inhibit-local-variables-suffixes,
  120. ;; so that a -*- line in the first file of a compressed tar file,
  121. ;; or a Local Variables section in a member file at the end of
  122. ;; the tar file don't override tar-mode.
  123. (push (jka-compr-info-regexp x)
  124. inhibit-local-variables-suffixes)))
  125. (setq auto-mode-alist
  126. (append auto-mode-alist jka-compr-mode-alist-additions))
  127. ;; Make sure that (load "foo") will find /bla/foo.el.gz.
  128. (setq load-file-rep-suffixes
  129. (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
  130. (defun jka-compr-installed-p ()
  131. "Return non-nil if jka-compr is installed.
  132. The return value is the entry in `file-name-handler-alist' for jka-compr."
  133. (let ((fnha file-name-handler-alist)
  134. (installed nil))
  135. (while (and fnha (not installed))
  136. (and (eq (cdr (car fnha)) 'jka-compr-handler)
  137. (setq installed (car fnha)))
  138. (setq fnha (cdr fnha)))
  139. installed))
  140. (defun jka-compr-update ()
  141. "Update Auto Compression mode for changes in option values.
  142. If you change the options `jka-compr-compression-info-list',
  143. `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
  144. outside Custom, while Auto Compression mode is already enabled
  145. \(as it is by default), then you have to call this function
  146. afterward to properly update other variables. Setting these
  147. options through Custom does this automatically."
  148. (when (jka-compr-installed-p)
  149. (jka-compr-uninstall)
  150. (jka-compr-install)))
  151. (defun jka-compr-set (variable value)
  152. "Internal Custom :set function."
  153. (set-default variable value)
  154. (jka-compr-update))
  155. ;; I have this defined so that .Z files are assumed to be in unix
  156. ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
  157. ;; FIXME? It seems ugly that one has to add "\\(~\\|\\.~[0-9]+~\\)?" to
  158. ;; all the regexps here, in order to match backup files etc.
  159. ;; It's trivial to modify jka-compr-get-compression-info to match
  160. ;; regexps against file-name-sans-versions, but this regexp is also
  161. ;; used to build a file-name-handler-alist entry.
  162. ;; find-file-name-handler does not use file-name-sans-versions.
  163. ;; Perhaps it should,
  164. ;; http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg00812.html,
  165. ;; but it's used all over the place and there are probably other ramifications.
  166. ;; One could modify jka-compr-build-file-regexp to add the backup regexp,
  167. ;; but jka-compr-compression-info-list is a defcustom to which
  168. ;; anything could be added, so it's easiest to leave things as they are.
  169. (defcustom jka-compr-compression-info-list
  170. ;;[regexp
  171. ;; compr-message compr-prog compr-args
  172. ;; uncomp-message uncomp-prog uncomp-args
  173. ;; can-append strip-extension-flag file-magic-bytes]
  174. (mapcar 'purecopy
  175. '(["\\.Z\\'"
  176. "compressing" "compress" ("-c")
  177. ;; gzip is more common than uncompress. It can only read, not write.
  178. "uncompressing" "gzip" ("-c" "-q" "-d")
  179. nil t "\037\235"]
  180. ;; Formerly, these had an additional arg "-c", but that fails with
  181. ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
  182. ;; "Version 0.9.0b, 9-Sept-98".
  183. ["\\.bz2\\'"
  184. "bzip2ing" "bzip2" nil
  185. "bunzip2ing" "bzip2" ("-d")
  186. nil t "BZh"]
  187. ["\\.tbz2?\\'"
  188. "bzip2ing" "bzip2" nil
  189. "bunzip2ing" "bzip2" ("-d")
  190. nil nil "BZh"]
  191. ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
  192. "compressing" "gzip" ("-c" "-q")
  193. "uncompressing" "gzip" ("-c" "-q" "-d")
  194. t nil "\037\213"]
  195. ["\\.g?z\\'"
  196. "compressing" "gzip" ("-c" "-q")
  197. "uncompressing" "gzip" ("-c" "-q" "-d")
  198. t t "\037\213"]
  199. ["\\.lz\\'"
  200. "Lzip compressing" "lzip" ("-c" "-q")
  201. "Lzip uncompressing" "lzip" ("-c" "-q" "-d")
  202. t t "LZIP"]
  203. ["\\.lzma\\'"
  204. "LZMA compressing" "lzma" ("-c" "-q" "-z")
  205. "LZMA uncompressing" "lzma" ("-c" "-q" "-d")
  206. t t ""]
  207. ["\\.xz\\'"
  208. "XZ compressing" "xz" ("-c" "-q")
  209. "XZ uncompressing" "xz" ("-c" "-q" "-d")
  210. t t "\3757zXZ\0"]
  211. ;; dzip is gzip with random access. Its compression program can't
  212. ;; read/write stdin/out, so .dz files can only be viewed without
  213. ;; saving, having their contents decompressed with gzip.
  214. ["\\.dz\\'"
  215. nil nil nil
  216. "uncompressing" "gzip" ("-c" "-q" "-d")
  217. nil t "\037\213"]))
  218. "List of vectors that describe available compression techniques.
  219. Each element, which describes a compression technique, is a vector of
  220. the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
  221. UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
  222. APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
  223. regexp is a regexp that matches filenames that are
  224. compressed with this format
  225. compress-msg is the message to issue to the user when doing this
  226. type of compression (nil means no message)
  227. compress-program is a program that performs this compression
  228. (nil means visit file in read-only mode)
  229. compress-args is a list of args to pass to the compress program
  230. uncompress-msg is the message to issue to the user when doing this
  231. type of uncompression (nil means no message)
  232. uncompress-program is a program that performs this compression
  233. uncompress-args is a list of args to pass to the uncompress program
  234. append-flag is non-nil if this compression technique can be
  235. appended
  236. strip-extension-flag non-nil means strip the regexp from file names
  237. before attempting to set the mode.
  238. file-magic-chars is a string of characters that you would find
  239. at the beginning of a file compressed in this way.
  240. If you set this outside Custom while Auto Compression mode is
  241. already enabled \(as it is by default), you have to call
  242. `jka-compr-update' after setting it to properly update other
  243. variables. Setting this through Custom does that automatically."
  244. :type '(repeat (vector regexp
  245. (choice :tag "Compress Message"
  246. (string :format "%v")
  247. (const :tag "No Message" nil))
  248. (choice :tag "Compress Program"
  249. (string)
  250. (const :tag "None" nil))
  251. (repeat :tag "Compress Arguments" string)
  252. (choice :tag "Uncompress Message"
  253. (string :format "%v")
  254. (const :tag "No Message" nil))
  255. (choice :tag "Uncompress Program"
  256. (string)
  257. (const :tag "None" nil))
  258. (repeat :tag "Uncompress Arguments" string)
  259. (boolean :tag "Append")
  260. (boolean :tag "Strip Extension")
  261. (string :tag "Magic Bytes")))
  262. :set 'jka-compr-set
  263. :group 'jka-compr)
  264. (defcustom jka-compr-mode-alist-additions
  265. (list (cons (purecopy "\\.tgz\\'") 'tar-mode) (cons (purecopy "\\.tbz2?\\'") 'tar-mode))
  266. "List of pairs added to `auto-mode-alist' when installing jka-compr.
  267. Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
  268. installing added.
  269. If you set this outside Custom while Auto Compression mode is
  270. already enabled \(as it is by default), you have to call
  271. `jka-compr-update' after setting it to properly update other
  272. variables. Setting this through Custom does that automatically."
  273. :type '(repeat (cons string symbol))
  274. :set 'jka-compr-set
  275. :group 'jka-compr)
  276. (defcustom jka-compr-load-suffixes (list (purecopy ".gz"))
  277. "List of compression related suffixes to try when loading files.
  278. Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
  279. which see. Disabling Auto Compression mode removes all suffixes
  280. from `load-file-rep-suffixes' that enabling added.
  281. If you set this outside Custom while Auto Compression mode is
  282. already enabled \(as it is by default), you have to call
  283. `jka-compr-update' after setting it to properly update other
  284. variables. Setting this through Custom does that automatically."
  285. :type '(repeat string)
  286. :set 'jka-compr-set
  287. :group 'jka-compr)
  288. (define-minor-mode auto-compression-mode
  289. "Toggle Auto Compression mode.
  290. With a prefix argument ARG, enable Auto Compression mode if ARG
  291. is positive, and disable it otherwise. If called from Lisp,
  292. enable the mode if ARG is omitted or nil.
  293. Auto Compression mode is a global minor mode. When enabled,
  294. compressed files are automatically uncompressed for reading, and
  295. compressed when writing."
  296. :global t :init-value t :group 'jka-compr :version "22.1"
  297. (let* ((installed (jka-compr-installed-p))
  298. (flag auto-compression-mode))
  299. (cond
  300. ((and flag installed) t) ; already installed
  301. ((and (not flag) (not installed)) nil) ; already not installed
  302. (flag (jka-compr-install))
  303. (t (jka-compr-uninstall)))))
  304. (defmacro with-auto-compression-mode (&rest body)
  305. "Evaluate BODY with automatic file compression and uncompression enabled."
  306. (declare (indent 0))
  307. (let ((already-installed (make-symbol "already-installed")))
  308. `(let ((,already-installed (jka-compr-installed-p)))
  309. (unwind-protect
  310. (progn
  311. (unless ,already-installed
  312. (jka-compr-install))
  313. ,@body)
  314. (unless ,already-installed
  315. (jka-compr-uninstall))))))
  316. ;; This is what we need to know about jka-compr-handler
  317. ;; in order to decide when to call it.
  318. (put 'jka-compr-handler 'safe-magic t)
  319. (put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
  320. write-region insert-file-contents
  321. file-local-copy load))
  322. ;; Turn on the mode.
  323. (when auto-compression-mode (auto-compression-mode 1))
  324. (provide 'jka-cmpr-hook)
  325. ;;; jka-cmpr-hook.el ends here