home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / crypt.el < prev    next >
Encoding:
Text File  |  1990-03-21  |  19.9 KB  |  962 lines
  1. ;From ark1!nems!mimsy!tank!ux1.cso.uiuc.edu!brutus.cs.uiuc.edu!uakari.primate.wisc.edu!uwm.edu!bionet!rutgers!mcnc!rti!talos!kjones Thu Jan 11 09:53:07 1990
  2. ;Article 1163 of comp.emacs:
  3. ;Xref: ark1 comp.emacs:1163 gnu.emacs:948
  4. ;Path: ark1!nems!mimsy!tank!ux1.cso.uiuc.edu!brutus.cs.uiuc.edu!uakari.primate.wisc.edu!uwm.edu!bionet!rutgers!mcnc!rti!talos!kjones
  5. ;>From kjones@talos.uu.net (Kyle Jones)
  6. ;Newsgroups: comp.emacs,gnu.emacs,alt.sources
  7. ;Subject: crypt.el for GNU Emacs
  8. ;Message-ID: <1990Jan9.175837.25058@talos.uu.net>
  9. ;Date: 9 Jan 90 17:58:37 GMT
  10. ;Lines: 476
  11.  
  12. ;;; Compaction, compression and encryption for GNU Emacs
  13. ;;; Copyright (C) 1988, 1989, 1990 Kyle E. Jones
  14. ;;;
  15. ;;; This program is free software; you can redistribute it and/or modify
  16. ;;; it under the terms of the GNU General Public License as published by
  17. ;;; the Free Software Foundation; either version 1, or (at your option)
  18. ;;; any later version.
  19. ;;;
  20. ;;; This program is distributed in the hope that it will be useful,
  21. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. ;;; GNU General Public License for more details.
  24. ;;;
  25. ;;; A copy of the GNU General Public License can be obtained from this
  26. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  27. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  28. ;;; 02139, USA.
  29. ;;;
  30. ;;; Send bug reports to kyle@cs.odu.edu.
  31.  
  32. ;; To use this package, put it in a file called "crypt.el" in a Lisp
  33. ;; directory that Emacs knows about, byte-compile it, and put the line:
  34. ;;    (require 'crypt)
  35. ;; in your .emacs file or in the file default.el in the "lisp" directory
  36. ;; of the Emacs distribution.  Don't bother trying to autoload this file;
  37. ;; this package uses a find-file hook and thus should be loaded the
  38. ;; first time you visit any sort of file.
  39. ;;
  40. ;; The basic purpose of this package of Lisp functions is to automatically
  41. ;; recognize encrypted, compacted or compressed files when they are first
  42. ;; visited and decode the file's BUFFER before it is presented to the user.
  43. ;; The file itself is unchanged.  When the buffer is subsequently saved to
  44. ;; disk, a hook function re-encodes the buffer before the actual disk write
  45. ;; takes place.
  46. ;;
  47. ;; This package recognizes compacted and compressed files by a magic number at
  48. ;; the beginning of these files, but a heuristic is used to detect encrypted
  49. ;; files.  If you are asked for an encryption key for a file that is in fact
  50. ;; not encrypted, just hit RET and the file will be accepted as is, and the
  51. ;; crypt minor mode will not be entered.
  52.  
  53. (provide 'crypt)
  54.  
  55. (defvar auto-decode-buffer t
  56.   "*Non-nil value means that the buffers associated with encoded files will
  57. be decoded automatically, without requesting confirmation from the user.
  58. Nil means to ask before doing the decoding.")
  59.  
  60. (defvar buffer-save-encrypted nil
  61.   "*Non-nil means that when this buffer is saved it will be written out
  62. encrypted, as with the UNIX crypt(1) command.  Automatically local to all
  63. buffers.")
  64. (make-variable-buffer-local 'buffer-save-encrypted)
  65.  
  66. (defvar buffer-save-compacted nil
  67.   "*Non-nil means that when this buffer is saved it will be written out
  68. compacted, as with the UNIX compact(1) command.  Automatically local to all
  69. buffers.")
  70. (make-variable-buffer-local 'buffer-save-compacted)
  71.  
  72. (defvar buffer-save-compressed nil
  73.   "*Non-nil means that when this buffer is saved it will be written out
  74. compressed, as with the UNIX compress(1) command.  Automatically local to all
  75. buffers.")
  76. (make-variable-buffer-local 'buffer-save-compressed)
  77.  
  78. (defvar buffer-encryption-key nil
  79.   "*Key to use when encrypting the current buffer, prior to saving it.
  80. Automatically local to all buffers.")
  81. (make-variable-buffer-local 'buffer-encryption-key)
  82.  
  83. (defconst compact-magic-regexp "\377\037"
  84.   "Regexp that matches the magic number at the beginning of files created
  85. by the compact(1) command.")
  86.  
  87. (defconst compress-magic-regexp "\037\235\220"
  88.   "Regexp that matches the magic number at the beginning of files created
  89. by the compress(1) command.")
  90.  
  91. ;; Encrypted files have no magic number, so we have to hack a way of
  92. ;; determining which new buffers start in crypt mode.  The current setup is
  93. ;; that we use only buffers that have a non-ASCII character very close to
  94. ;; beginning of buffer and that do NOT match crypt-magic-regexp-inverse.
  95. ;; Currently crypt-magic-regexp-inverse will match Sun OS, 4.x BSD, and
  96. ;; Ultrix executable magic numbers, so binaries can still be edited (heh)
  97. ;; without headaches.
  98.  
  99. (defconst crypt-magic-regexp-inverse
  100.   "\\(..\\)?\\([\007\010\013]\001\\|\001[\007\010\013]\\)"
  101.   "Regexp that must NOT match the beginning of an encrypted buffer.")
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162. (defmacro save-point (&rest body)
  163.   "Save value of point, evalutes FORMS and restore value of point.
  164. If the saved value of point is no longer valid go to (point-max).
  165. This macro exists because, save-excursion loses track of point during
  166. some types of deletions."
  167.   (let ((var (make-symbol "saved-point")))
  168.     (list 'let (list (list var '(point)))
  169.       (list 'unwind-protect
  170.         (cons 'progn body)
  171.         (list 'goto-char var)))))
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232. (defun find-crypt-file-hook ()
  233.   (save-point
  234.     (save-restriction
  235.       (widen)
  236.       (goto-char (point-min))
  237.       (let ((buffer-file-name buffer-file-name)
  238.         (old-buffer-file-name buffer-file-name)
  239.         (old-buffer-modified-p (buffer-modified-p))
  240.         encrypted compressed compacted case-fold-search buffer-read-only)
  241.     ;; We can reasonably assume that either compaction or compression will
  242.     ;; be used, or neither, but not both.
  243.     (cond ((and (looking-at compact-magic-regexp)
  244.             (or auto-decode-buffer
  245.             (y-or-n-p (format "Uncompact buffer %s? "
  246.                       (buffer-name)))))
  247.            (message "Uncompacting %s..." (buffer-name))
  248.            (compact-buffer (current-buffer) t)
  249.            ;; We can't actually go into compact mode yet because the major
  250.            ;; mode may change later on and blow away all local variables
  251.            ;; (and thus the minor modes).  So we make a note to go into
  252.            ;; compact mode later.
  253.            (setq compacted t)
  254.            ;; here we strip the compacted file's .C extension so that later
  255.            ;; we can set the buffer's major mode based on this modified
  256.            ;; name instead of the name with the .C extension.
  257.            (if (string-match "\\(\\.C\\)$" buffer-file-name)
  258.            (setq buffer-file-name
  259.              (substring buffer-file-name 0 (match-beginning 1))))
  260.            (if (not (input-pending-p))
  261.            (message "Uncompacting %s... done" (buffer-name))))
  262.           ((and (looking-at compress-magic-regexp)
  263.             (or auto-decode-buffer
  264.             (y-or-n-p (format "Uncompress buffer %s? "
  265.                       (buffer-name)))))
  266.            (message "Uncompressing %s..." (buffer-name))
  267.            (compress-buffer (current-buffer) t)
  268.            (setq compressed t)
  269.            (if (string-match "\\(\\.Z\\)$" buffer-file-name)
  270.            (setq buffer-file-name
  271.              (substring buffer-file-name 0 (match-beginning 1))))
  272.            (if (not (input-pending-p))
  273.            (message "Uncompressing %s... done" (buffer-name)))))
  274.     ;; Now peek at the file and see if it still looks like a binary file.
  275.     ;; If so, try the crypt-magic-regexp-inverse against it and if it FAILS
  276.     ;; we assume that this is an encrypted buffer.
  277.     (cond ((and (not (eobp))
  278.             (re-search-forward "[\200-\377]" (min (point-max) 15) t)
  279.             (goto-char (point-min))
  280.             (not (looking-at crypt-magic-regexp-inverse)))
  281.            (if (not buffer-encryption-key)
  282.            (call-interactively 'set-encryption-key))
  283.            ;; if user did not enter a key, turn off crypt mode.
  284.            ;; good for binaries that crypt-magic-regexp-inverse
  285.            ;; doesn't recognize.
  286.            ;; -- thanx to Paul Dworkin (paul@media-lab.media.mit.edu)
  287.            (if (equal buffer-encryption-key "")
  288.            (message "No key given, buffer %s assumed normal."
  289.                 (buffer-name))
  290.          (message "Decrypting %s..." (buffer-name))
  291.          (crypt-buffer buffer-encryption-key)
  292.          ;; Tuck the key away for safe keeping since setting the major
  293.          ;; mode may well blow it away.
  294.          (setq encrypted buffer-encryption-key)
  295.          (if (not (input-pending-p))
  296.              (message "Decrypting %s... done" (buffer-name))))))
  297.     ;; OK, if any changes have been made to the buffer we need to rerun the
  298.     ;; code the does automatic selection of major mode.
  299.     (cond ((or compressed compacted encrypted)
  300.            (set-auto-mode)
  301.            (hack-local-variables)
  302.            ;; Now set our minor modes.
  303.            (if compressed (compress-mode 1))
  304.            (if compacted (compact-mode 1))
  305.            (if encrypted
  306.            (progn (crypt-mode 1)
  307.               (setq buffer-encryption-key encrypted)))
  308.            ;; Restore buffer file name now, so that lock file entry is
  309.            ;; removed properly.
  310.            (setq buffer-file-name old-buffer-file-name)
  311.            ;; Restore buffer modified flag to its previous value.
  312.            ;; This will also remove the lock file entry for the buffer
  313.            ;; if the previous value was nil; this is why buffer-file-name
  314.            ;; had to be manually restored above.
  315.            (set-buffer-modified-p old-buffer-modified-p)))))))
  316.  
  317. ;; This function should be called ONLY as a write-file hook.
  318. ;; Odd things will happen if it is called elsewhere.
  319. (defun write-crypt-file-hook ()
  320.   (cond
  321.    ((or buffer-save-encrypted buffer-save-compacted buffer-save-compressed)
  322.     (save-excursion
  323.       (save-restriction
  324.     (let ((copy-buffer (get-buffer-create " *crypt copy buffer*"))
  325.           (selective-display selective-display)
  326.           (buffer-read-only))
  327.       (copy-to-buffer copy-buffer 1 (1+ (buffer-size)))
  328.       (narrow-to-region (point) (point))
  329.       (unwind-protect
  330.           (progn
  331.         (insert-buffer-substring copy-buffer)
  332.         (kill-buffer copy-buffer)
  333.         ;; selective-display non-nil means we must convert carriage
  334.         ;; returns to newlines now, and set selective-display
  335.         ;; temporarily to nil.
  336.         (cond (selective-display
  337.                (goto-char (point-min))
  338.                (subst-char-in-region (point-min) (point-max) ?\r ?\n)
  339.                (setq selective-display nil)))
  340.         (cond
  341.          (buffer-save-encrypted
  342.           (if (null buffer-encryption-key)
  343.               (error "No encryption key set for buffer %s"
  344.                  (buffer-name)))
  345.           (if (not (stringp buffer-encryption-key))
  346.               (error "Encryption key is not a string"))
  347.           (message "Encrypting %s..." (buffer-name))
  348.           (crypt-buffer buffer-encryption-key)))
  349.         (cond
  350.          ((and buffer-save-compacted buffer-save-compressed)
  351.           (error "Cannot compact and compress buffer %s"
  352.              (buffer-name)))
  353.          (buffer-save-compacted
  354.           (message "Compacting %s..." (buffer-name))
  355.           (compact-buffer))
  356.          (buffer-save-compressed
  357.           (message "Compressing %s..." (buffer-name))
  358.           (compress-buffer)))
  359.         (write-region (point-min) (point-max) buffer-file-name nil t)
  360.         (delete-region (point-min) (point-max))
  361.         (set-buffer-modified-p nil)
  362.         ;; return t so that basic-save-buffer will
  363.         ;; know that the save has already been done.
  364.         t )
  365.         ;; unwind...
  366.         ;; If the crypted stuff has already been removed
  367.         ;; then this is a no-op.
  368.         (delete-region (point-min) (point-max)))))))))
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427.  
  428.  
  429. (defun crypt-region (start end key)
  430.   "Encrypt/decrypt the text in the region.
  431. From a program, this function takes three args: START, END and KEY.
  432. When called interactively START and END default to point and mark
  433. \(START being the lesser of the two), KEY is prompted for."
  434.   (interactive
  435.    (progn
  436.      (barf-if-buffer-read-only)
  437.      (list
  438.       (region-beginning)
  439.       (region-end)
  440.       (read-string-no-echo "Crypt region using key: "))))
  441.   (save-point
  442.    (let ((opoint-max (point-max)))
  443.      (call-process-region start end shell-file-name t t nil "-c"
  444.               (concat "crypt \"" key "\""))
  445.      (if (not (= opoint-max (point-max)))
  446.      (error "crypt command failed!")))))
  447.  
  448. (defun crypt-buffer (key &optional buffer)
  449.   "Using KEY, encrypt/decrypt BUFFER.
  450. BUFFER defaults to the current buffer."
  451.   (interactive
  452.    (progn
  453.      (barf-if-buffer-read-only)
  454.      (list (read-string-no-echo "Crypt buffer using key: "))))
  455.   (or buffer (setq buffer (current-buffer)))
  456.   (save-excursion
  457.     (set-buffer buffer)
  458.     (crypt-region (point-min) (point-max) key)))
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470.  
  471.  
  472.  
  473.  
  474.  
  475.  
  476.  
  477.  
  478.  
  479.  
  480.  
  481.  
  482.  
  483.  
  484.  
  485.  
  486.  
  487.  
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  
  510.  
  511.  
  512.  
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519. (defun compact-region (start end &optional undo)
  520.   "Compact the text in the region.
  521. From a program, this function takes three args: START, END and UNDO.
  522. When called interactively START and END default to point and mark
  523. \(START being the lesser of the two).
  524. Prefix arg (or optional second arg non-nil) UNDO means uncompact."
  525.   (interactive "*r\nP")
  526.   (save-point
  527.    (call-process-region start end shell-file-name t t nil "-c"
  528.             (if undo "uncompact" "compact"))
  529.    (cond ((not undo)
  530.       (goto-char start)
  531.       (let (case-fold-search)
  532.         (if (not (looking-at compact-magic-regexp))
  533.         (error "%s failed!" (if undo
  534.                     "Uncompaction"
  535.                       "Compaction"))))))))
  536.  
  537. (defun compact-buffer (&optional buffer undo)
  538.   "Compact BUFFER.
  539. BUFFER defaults to the current buffer.
  540. Prefix arg (or second arg non-nil from a program) UNDO means uncompact."
  541.   (interactive (list (current-buffer) current-prefix-arg))
  542.   (or buffer (setq buffer (current-buffer)))
  543.   (save-excursion
  544.     (set-buffer buffer)
  545.     (compact-region (point-min) (point-max) undo)))
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561.  
  562.  
  563.  
  564.  
  565.  
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606. (defun compress-region (start end &optional undo)
  607.   "Compress the text in the region.
  608. From a program, this function takes three args: START, END and UNDO.
  609. When called interactively START and END default to point and mark
  610. \(START being the lesser of the two).
  611. Prefix arg (or optional second arg non-nil) UNDO means uncompress."
  612.   (interactive "*r\nP")
  613.   (save-point
  614.    (call-process-region start end shell-file-name t t nil "-c"
  615.             (if undo "compress -d" "compress"))
  616.    (cond ((not undo)
  617.       (goto-char start)
  618.       (let (case-fold-search)
  619.         (if (not (looking-at compress-magic-regexp))
  620.         (error "%s failed!" (if undo
  621.                     "Uncompression"
  622.                       "Compression"))))))))
  623.  
  624. (defun compress-buffer (&optional buffer undo)
  625.   "Compress BUFFER.
  626. BUFFER defaults to the current buffer.
  627. Prefix arg (or second arg non-nil from a program) UNDO means uncompress."
  628.   (interactive (list (current-buffer) current-prefix-arg))
  629.   (or buffer (setq buffer (current-buffer)))
  630.   (save-excursion
  631.     (set-buffer buffer)
  632.     (compress-region (point-min) (point-max) undo)))
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682.  
  683.  
  684.  
  685.  
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693. (defun set-encryption-key (key &optional buffer)
  694.   "Set the encryption KEY for BUFFER.
  695. KEY should be a string.
  696. BUFFER should be a buffer or the name of one;
  697. it defaults to the current buffer.  If BUFFER is in crypt mode, then it is
  698. also marked as modified, since it needs to be saved with the new key."
  699.   (interactive
  700.    (progn
  701.      (barf-if-buffer-read-only)
  702.      (list
  703.       (read-string-no-echo
  704.        (format "Set encryption key for buffer %s: " (buffer-name))))))
  705.   (or buffer (setq buffer (current-buffer)))
  706.   (save-excursion
  707.     (set-buffer buffer)
  708.     (if (equal key buffer-encryption-key)
  709.     (message "Key is identical to original, no change.")
  710.       (setq buffer-encryption-key key)
  711.       ;; don't touch the modify flag unless we're in crypt-mode.
  712.       (if buffer-save-encrypted
  713.       (set-buffer-modified-p t)))))
  714.  
  715. (defun crypt-mode (&optional arg)
  716.   "Toggle crypt mode.
  717. With arg, turn crypt mode on iff arg is positive, otherwise turn it off.
  718. In crypt mode, buffers are automatically encrypted before being written.
  719. If crypt mode is toggled and a key has been set for the current buffer, then
  720. the current buffer is marked modified, since it needs to be rewritten
  721. with (or without) encryption.
  722.  
  723. Use \\[set-encryption-key] to set the encryption key for the current buffer.
  724.  
  725. Entering crypt mode causes auto-saving to be turned off in the current buffer,
  726. as there is no way (in Emacs Lisp) to force auto save files to be encrypted."
  727.   (interactive "P")
  728.   (let ((oldval buffer-save-encrypted))
  729.     (setq buffer-save-encrypted
  730.       (if arg (> arg 0) (not buffer-save-encrypted)))
  731.     (if buffer-save-encrypted
  732.     (auto-save-mode 0)
  733.       (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
  734.     (if buffer-encryption-key
  735.     (set-buffer-modified-p
  736.      (not (eq oldval buffer-save-encrypted))))))
  737.  
  738. (defun compact-mode (&optional arg)
  739.   "Toggle compact mode.
  740. With arg, turn compact mode on iff arg is positive, otherwise turn it off.
  741. In compact mode, buffers are automatically compacted before being written.
  742. If compact mode is toggled, the current buffer is marked modified, since
  743. it needs to be written with (or without) compaction.
  744.  
  745. Entering compact mode causes auto-saving to be turned off in the current
  746. buffer, as there is no way (in Emacs Lisp) to force auto save files to be
  747. compacted."
  748.   (interactive "P")
  749.   (let ((oldval buffer-save-compacted))
  750.     (setq buffer-save-compacted
  751.       (if arg (> arg 0) (not buffer-save-compacted)))
  752.     (if buffer-save-compacted
  753.     (auto-save-mode 0)
  754.       (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
  755.     (set-buffer-modified-p (not (eq oldval buffer-save-compacted)))))
  756.  
  757. (defun compress-mode (&optional arg)
  758.   "Toggle compress mode.
  759. With arg, turn compress mode on iff arg is positive, otherwise turn it off.
  760. In compress mode, buffers are automatically compressed before being written.
  761. If compress mode is toggled, the current buffer is marked modified, since
  762. it needs to be written with (or without) compression.
  763.  
  764. Entering compress mode causes auto-saving to be turned off in the current
  765. buffer, as there is no way (in Emacs Lisp) to force auto save files to be
  766. compressed."
  767.   (interactive "P")
  768.   (let ((oldval buffer-save-compressed))
  769.     (setq buffer-save-compressed
  770.       (if arg (> arg 0) (not buffer-save-compressed)))
  771.     (if buffer-save-compressed
  772.     (auto-save-mode 0)
  773.       (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
  774.     (set-buffer-modified-p (not (eq oldval buffer-save-compressed)))))
  775.  
  776.  
  777.  
  778.  
  779.  
  780.  
  781.  
  782.  
  783.  
  784.  
  785.  
  786.  
  787.  
  788.  
  789.  
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.  
  801.  
  802.  
  803.  
  804.  
  805.  
  806.  
  807.  
  808.  
  809.  
  810.  
  811.  
  812.  
  813.  
  814.  
  815.  
  816.  
  817.  
  818.  
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835. (defun read-string-no-echo (prompt &optional confirm)
  836.   "Read a string from the minibuffer, prompting with PROMPT.
  837. Optional second argument CONFIRM non-nil means that the user will be asked
  838.   to type the string a second time for confirmation and if there is a
  839.   mismatch, the process is repeated.
  840.  
  841. Line editing keys are:
  842.   C-h, DEL    rubout
  843.   C-u, C-x      line kill
  844.   C-q, C-v      literal next"
  845.   (catch 'return-value
  846.     (save-excursion
  847.       (let ((input-buffer (get-buffer-create " *password*"))
  848.         (cursor-in-echo-area t)
  849.         (echo-keystrokes 0)
  850.         char string help-form done kill-ring)
  851.     (set-buffer input-buffer)
  852.     (unwind-protect
  853.         (while t
  854.           (erase-buffer)
  855.           (message prompt)
  856.           (while (not (memq (setq char (read-char)) '(?\C-m ?\C-j)))
  857.         (if (setq form
  858.              (cdr
  859.               (assq char
  860.                 '((?\C-h . (delete-char -1))
  861.                   (?\C-? . (delete-char -1))
  862.                   (?\C-u . (delete-region 1 (point)))
  863.                   (?\C-x . (delete-region 1 (point)))
  864.                   (?\C-q . (quoted-insert 1))
  865.                   (?\C-v . (quoted-insert 1))))))
  866.             (condition-case error-data
  867.             (eval form)
  868.               (error t))
  869.           (insert char))
  870.         (message prompt))
  871.           (cond ((and confirm string)
  872.              (cond ((not (string= string (buffer-string)))
  873.                 (message
  874.                  (concat prompt "[Mismatch... try again.]"))
  875.                 (ding)
  876.                 (sit-for 2)
  877.                 (setq string nil))
  878.                (t (throw 'return-value string))))
  879.             (confirm
  880.              (setq string (buffer-string))
  881.              (message (concat prompt "[Retype to confirm...]"))
  882.              (sit-for 2))
  883.             (t (throw 'return-value (buffer-string)))))
  884.       (set-buffer-modified-p nil)
  885.       (kill-buffer input-buffer))))))
  886.  
  887.  
  888.  
  889.  
  890.  
  891.  
  892.  
  893.  
  894.  
  895.  
  896.  
  897.  
  898.  
  899.  
  900.  
  901.  
  902.  
  903.  
  904.  
  905.  
  906.  
  907.  
  908.  
  909.  
  910.  
  911.  
  912.  
  913.  
  914.  
  915.  
  916.  
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.  
  946. ;; Install the hooks, then add the mode indicators to
  947. ;; the minor mode alist.
  948. (cond
  949.  ((not (memq 'write-crypt-file-hook write-file-hooks))
  950.   ;; make this hook last on purpose
  951.   (setq write-file-hooks (append write-file-hooks
  952.                  (list 'write-crypt-file-hook))
  953.     find-file-hooks (cons 'find-crypt-file-hook find-file-hooks)
  954.     find-file-not-found-hooks (cons 'find-crypt-file-hook
  955.                     find-file-not-found-hooks)
  956.     minor-mode-alist (nconc (list '(buffer-save-encrypted " Crypt")
  957.                       '(buffer-save-compacted " Compact")
  958.                       '(buffer-save-compressed " Compress"))
  959.                 minor-mode-alist))))
  960.  
  961.  
  962.