[COMMIT] Clean up auto-save.el, extend functionality of #'auto-save-{un,}escape-name.

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1489281373 0 # Sun Mar 12 01:16:13 2017 +0000 # Node ID 55b8780e42f49fe8abaeb84784316dfc4727b70b # Parent f669d096d3d4491cfd04e5d859a4e9bf9a787d63 Clean up auto-save.el, extend functionality of #'auto-save-{un,}escape-name. lisp/ChangeLog addition: 2017-03-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; Clean up auto-save.el, extend the functionality of #'auto-save-{un,}escape-name. * auto-save.el: * auto-save.el (efs-auto-save-remotely): Always provide a defvar for this, since this file is dumped efs.el will not be loaded before auto-save.el. * auto-save.el (auto-save-checked-directory): Fix some indentation; remove some long-commented code, avoiding distraction. * auto-save.el (auto-save-name-in-fixed-directory): We have DOC now, it's not expensive of RAM to have function docstrings, uncomment this one. * auto-save.el (auto-save-name-in-same-directory): Ditto. * auto-save.el (auto-save-reserved-chars): Expand the docstring of this a little. * auto-save.el (auto-save-escape-name): Preserve those characters which wouldn't be preserved by file-name-coding-system in this function. * auto-save.el (auto-save-unescape-name): Do the inverse of the newly-added functionality of #'auto-save-escape-name. * auto-save.el (auto-save-cyclic-hash-14): Uncomment the docstring for this function. tests/ChangeLog addition: 2017-03-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: [...] Test the new escaping of ESC with the same two functions. diff -r f669d096d3d4 -r 55b8780e42f4 lisp/ChangeLog --- a/lisp/ChangeLog Sun Mar 12 00:06:24 2017 +0000 +++ b/lisp/ChangeLog Sun Mar 12 01:16:13 2017 +0000 ＠＠ -1,3 +1,31 ＠＠ +2017-03-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Clean up auto-save.el, extend the functionality of + #'auto-save-{un,}escape-name. + + * auto-save.el: + * auto-save.el (efs-auto-save-remotely): + Always provide a defvar for this, since this file is dumped efs.el + will not be loaded before auto-save.el. + * auto-save.el (auto-save-checked-directory): + Fix some indentation; remove some long-commented code, avoiding + distraction. + * auto-save.el (auto-save-name-in-fixed-directory): + We have DOC now, it's not expensive of RAM to have function + docstrings, uncomment this one. + * auto-save.el (auto-save-name-in-same-directory): + Ditto. + * auto-save.el (auto-save-reserved-chars): + Expand the docstring of this a little. + * auto-save.el (auto-save-escape-name): + Preserve those characters which wouldn't be preserved by + file-name-coding-system in this function. + * auto-save.el (auto-save-unescape-name): + Do the inverse of the newly-added functionality of + #'auto-save-escape-name. + * auto-save.el (auto-save-cyclic-hash-14): + Uncomment the docstring for this function. + 2017-03-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * auto-save.el (auto-save-unescape-name): diff -r f669d096d3d4 -r 55b8780e42f4 lisp/auto-save.el --- a/lisp/auto-save.el Sun Mar 12 00:06:24 2017 +0000 +++ b/lisp/auto-save.el Sun Mar 12 01:16:13 2017 +0000 ＠＠ -163,12 +163,9 ＠＠ :type 'boolean :group 'auto-save) -;;; This defvar is in efs.el now, but doesn't hurt to give it here as -;;; well so that loading first auto-save.el does not abort. - -;; #### Now that `auto-save' is dumped, this is looks obnoxious. -(or (boundp 'efs-auto-save) (defvar efs-auto-save 0)) -(or (boundp 'efs-auto-save-remotely) (defvar efs-auto-save-remotely nil)) +;; This has a defcustom in efs.el, which unfortunately won't be picked up when +;; `efs-ftp-path' is autoloaded, because that is in efs-cu.el. +(defvar efs-auto-save-remotely nil) (defcustom auto-save-offer-delete nil "*If non-nil, `recover-all-files' offers to delete autosave files ＠＠ -200,23 +197,15 ＠＠ (defun auto-save-checked-directory (dir) "Make sure the directory DIR exists and return it expanded if non-nil." - (when dir - (setq dir (expand-file-name dir)) - ;; Make sure directory exists - (unless (file-directory-p dir) - ;; Else we create and chmod 0700 the directory - (setq dir (directory-file-name dir)) ; some systems need this - (make-directory dir) - (set-file-modes dir #o700)) - dir)) - -;; This make no sense at dump time -;; (mapc #'auto-save-check-directory -; '(auto-save-directory auto-save-directory-fallback)) - -;(and auto-save-hash-p -; (auto-save-check-directory 'auto-save-hash-directory)) - + (when dir + (setq dir (expand-file-name dir)) + ;; Make sure directory exists + (unless (file-directory-p dir) + ;; Else we create and chmod 0700 the directory + (setq dir (directory-file-name dir)) ; some systems need this + (make-directory dir) + (set-file-modes dir #o700)) + dir))  ;;; Computing an autosave name for a file and vice versa ＠＠ -349,13 +338,14 ＠＠ (concat savedir (substring basename 1 -1)))))) (defun auto-save-name-in-fixed-directory (filename &optional prefix) - ;; Escape and enclose the whole FILENAME in `#' to make an auto - ;; save file in the auto-save-directory, or if that is nil, in - ;; auto-save-directory-fallback (which must be the name of an - ;; existing directory). If the results would be too long for 14 - ;; character filenames, and `auto-save-hash-p' is set, hash FILENAME - ;; into a shorter name. - ;; Optional PREFIX is string to use instead of "#" to prefix name. + "Escape FILENAME using `#' to make a file in `auto-save-directory'. + +If `auto-save-directory' is nil, make a file in `auto-save-directory-fallback' +(which must be the name of an existing directory). If the results would be +too long for 14 character filenames, and `auto-save-hash-p' is set, hash +FILENAME into a shorter name. + +Optional PREFIX is string to use instead of \"#\" to prefix FILENAME." (let ((base-name (concat (or prefix "#") (auto-save-escape-name filename) "#"))) ＠＠ -363,20 +353,23 ＠＠ auto-save-hash-directory (> (length base-name) 14)) (expand-file-name (auto-save-cyclic-hash-14 filename) - (auto-save-checked-directory auto-save-hash-directory)) + (auto-save-checked-directory + auto-save-hash-directory)) (expand-file-name base-name (auto-save-checked-directory (or auto-save-directory auto-save-directory-fallback)))))) (defun auto-save-name-in-same-directory (filename &optional prefix) - ;; Enclose the non-directory part of FILENAME in `#' to make an auto - ;; save file in the same directory as FILENAME. But if this - ;; directory is not writable, use auto-save-directory-fallback. - ;; FILENAME is assumed to be in non-directory form (no trailing slash). - ;; It may be a name without a directory part (presumably it really - ;; comes from a buffer name then), the fallback is used then. - ;; Optional PREFIX is string to use instead of "#" to prefix name. + "Escape FILENAME using `#', creating an auto-save name in its directory. + +If that directory is not writable, use `auto-save-directory-fallback'. + +FILENAME is assumed to be in non-directory form (no trailing slash). It may +be a name without a directory part, in which case the current directory is +used. + +Optional PREFIX is string to use instead of \"#\" to prefix FILENAME." (let ((directory (file-name-directory filename))) (or (null directory) (file-writable-p directory) ＠＠ -388,75 +381,83 ＠＠ "#"))) (defconst auto-save-reserved-chars - '( - ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\10 ?\11 ?\12 ?\13 ?\14 ?\15 ?\16 + '(?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\10 ?\11 ?\12 ?\13 ?\14 ?\15 ?\16 ?\17 ?\20 ?\21 ?\22 ?\23 ?\24 ?\25 ?\26 ?\27 ?\30 ?\31 ?\32 ?\33 ?\34 ?\35 ?\36 ?\37 ?\40 ?? ?* ?: ?< ?> ?| ?/ ?\\ ?& ?^ ?% ?= ?\") "List of characters disallowed (or potentially disallowed) in filenames. -Includes everything that can get us into trouble under MS Windows or Unix.") -;; This code based on code in Bill Perry's url.el. - -(defun auto-save-escape-name (str) - "Escape any evil nasty characters in a potential filename. -Uses quoted-printable-style escaping -- e.g. the dreaded =3D. -Does not use URL escaping (with %) because filenames beginning with #% are -a special signal for non-file buffers." - (mapconcat - (function - (lambda (char) - (if (memq char auto-save-reserved-chars) - (if (< char 16) - (upcase (format "=0%x" char)) - (upcase (format "=%x" char))) - (list char)))) - str "")) +Includes everything that can get us into trouble under MS Windows or Unix. +Characters that `file-name-coding-system' cannot handle are dealt with +separately from this list.") -(defun auto-save-unescape-name (str) - "Undo any escaping of evil nasty characters in a file name. +;; This code based (ultimately) on code in Bill Perry's url.el. + +(defun auto-save-escape-name (string) + "Escape any reserved characters in a potential filename. + +Uses quoted-printable-style escaping -- e.g. =3D. Does not use URL escaping +(with %) because filenames beginning with #% are a special signal for non-file +buffers. + +If STRING contains characters that `file-name-coding-system' cannot encode, +these are also escaped, after having been transformed to `escape-quoted' +encoding. Both operations are reversed by `auto-save-unescape-name', which +see." + (let ((start 0) stream) + (multiple-value-bind (ignored details) + (query-coding-string string 'file-name) + (declare (special ignored)) + (loop for char being each element in string using (index index) + if (or (memq char auto-save-reserved-chars) + (and details (get-range-table index details))) + do (progn + (write-sequence string (or stream + (setq stream + (make-string-output-stream))) + :start start :end index) + (if (or (eql char ?\033) + (> char (load-time-value + (reduce #'max auto-save-reserved-chars)))) + (loop for character + ;; We know escape-quoted can encode the file name! + across (encode-coding-char char 'escape-quoted) + do (format-into stream "=%02X" character)) + (format-into stream "=%02X" char)) + (setf start (1+ index)))) + (if stream + (get-output-stream-string + (prog1 stream (write-sequence string stream :start start))) + string)))) + +(defun auto-save-unescape-name (string) + "Undo any escaping of reserved characters in STRING. + See `auto-save-escape-name'." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match #r"=\([0-9a-f][0-9a-f]\)" str) - (let* ((start (match-beginning 0)) - (code (parse-integer str :start (match-beginning 1) - :end (match-end 1) :radix 16))) - (setq tmp (concat tmp (substring str 0 start) - (list code)) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - -;; The old versions are below. - -;(defun auto-save-escape-name (s) -; ;; "Quote any slashes in string S by replacing them with the two -; ;;characters `\\!'. -; ;;Also, replace any backslash by double backslash, to make it one-to-one." -; (let ((limit 0)) -; (while (string-match "[/\\]" s limit) -; (setq s (concat (substring s 0 (match-beginning 0)) -; (if (string= (substring s -; (match-beginning 0) -; (match-end 0)) -; "/") -; "\\!" -; "\\\\") -; (substring s (match-end 0)))) -; (setq limit (1+ (match-end 0))))) -; s) - -;(defun auto-save-unescape-name (s) -; ;;"Reverse of `auto-save-escape-name'." -; (let (pos) -; (while (setq pos (string-match "\\\\[\\!]" s pos)) -; (setq s (concat (substring s 0 pos) -; (if (eq ?! (aref s (1+ pos))) "/" "\\") -; (substring s (+ pos 2))) -; pos (1+ pos)))) -; s) - + (let ((start 0) (string (or string "")) offset stream fixnum decode) + (while (setq offset + (string-match-p #r"=[[:xdigit:]]\{2,2\}" string start)) + (write-sequence string (or stream + (setq stream (make-string-output-stream))) + :start start :end offset) + (write-char (setq fixnum + (parse-integer string :start (+ offset (length "=")) + :end (+ offset (length "=ab")) + :radix 16)) + stream) + (or (and ;; ESC will have been doubled, it always needs decoding. + (not (eql fixnum #o033)) + (memq (int-char fixnum) auto-save-reserved-chars)) + (setf decode t)) + (setf start (+ offset (length "=ab")))) + (if stream + (if decode + (decode-coding-string + (get-output-stream-string + (prog1 stream (write-sequence string stream :start start))) + 'escape-quoted t) + (get-output-stream-string + (prog1 stream (write-sequence string stream :start start)))) + string)))  ;;; Hashing for autosave names ＠＠ -464,11 +465,11 ＠＠ ;;; based upon C code from pot(a)fly.cnuce.cnr.IT (Francesco Potorti`). (defun auto-save-cyclic-hash-14 (s) - ;; "Hash string S into a string of length 14. - ;; A 7-bytes cyclic code for burst correction is calculated on a - ;; byte-by-byte basis. The polynomial used is D^7 + D^6 + D^3 +1. - ;; The resulting string consists of hexadecimal digits [0-9a-f]. - ;; In particular, it contains no slash, so it can be used as autosave name." + "Hash string S into a string of length 14. +A 7-bytes cyclic code for burst correction is calculated on a +byte-by-byte basis. The polynomial used is D^7 + D^6 + D^3 +1. +The resulting string consists of hexadecimal digits [0-9a-f]. +In particular, it contains no slash, so it can be used as autosave name." (let ((crc (make-vector 7 ?\0))) (mapc (lambda (new) ＠＠ -489,38 +490,6 ＠＠ (logand 255 (aref crc 4)) (logand 255 (aref crc 5)) (logand 255 (aref crc 6))))) - -;; #### It is unclear to me how the following function is useful. It -;; should be used in `auto-save-name-in-same-directory', if anywhere. -;; -hniksic - -;; This leaves two characters that could be used to wrap it in `#' or -;; make two filenames from it: one for autosaving, and another for a -;; file containing the name of the autosaved file, to make hashing -;; reversible. -;(defun auto-save-cyclic-hash-12 (s) -; "Outputs the 12-characters ascii hex representation of a 6-bytes -;cyclic code for burst correction calculated on STRING on a -;byte-by-byte basis. The used polynomial is D^6 + D^5 + D^4 + D^3 +1." -; (let ((crc (make-string 6 0))) -; (mapc -; (lambda (new) -; (setq new (+ new (aref crc 5))) -; (aset crc 5 (+ (aref crc 4) new)) -; (aset crc 4 (+ (aref crc 3) new)) -; (aset crc 3 (+ (aref crc 2) new)) -; (aset crc 2 (aref crc 1)) -; (aset crc 1 (aref crc 0)) -; (aset crc 0 new)) -; s) -; (format "%02x%02x%02x%02x%02x%02x" -; (aref crc 0) -; (aref crc 1) -; (aref crc 2) -; (aref crc 3) -; (aref crc 4) -; (aref crc 5)))) -  ;;; Recovering files diff -r f669d096d3d4 -r 55b8780e42f4 tests/ChangeLog --- a/tests/ChangeLog Sun Mar 12 00:06:24 2017 +0000 +++ b/tests/ChangeLog Sun Mar 12 01:16:13 2017 +0000 ＠＠ -4,6 +4,7 ＠＠ Add a parenthesis which had gone astray while merging. Test #'auto-save-escape-name, #'auto-save-unescape-name, reasonably important functions which previously had no testing. + Test the new escaping of ESC with the same two functions. 2017-03-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; diff -r f669d096d3d4 -r 55b8780e42f4 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sun Mar 12 00:06:24 2017 +0000 +++ b/tests/automated/lisp-tests.el Sun Mar 12 01:16:13 2017 +0000 ＠＠ -4240,12 +4240,23 ＠＠ ,(format "hello=20=%02Xab" char)) ,(format "hello %cab" char)))))))) (create-individual-char-tests - ;; This is the value of auto-save-reserved-chars. Don't reference the - ;; variable from the test code, we want the set to be stable. + ;; This is (almost) the value of auto-save-reserved-chars. Don't reference + ;; the variable from the test code, we want the set to be stable. ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\10 ?\11 ?\12 ?\13 ?\14 ?\15 ?\16 - ?\17 ?\20 ?\21 ?\22 ?\23 ?\24 ?\25 ?\26 ?\27 ?\30 ?\31 ?\32 ?\33 + ?\17 ?\20 ?\21 ?\22 ?\23 ?\24 ?\25 ?\26 ?\27 ?\30 ?\31 ?\32 ; ?\33 ?\34 ?\35 ?\36 ?\37 ?\40 ?? ?* ?: ?< ?> ?| ?/ ?\\ ?& ?^ ?% ?= ?\")) +;; Test ?\33 separately, since it is doubled because of the escape-quoting. + +(Assert (equal (auto-save-escape-name "hello  there") + "hello=20=1B=1B=20there")) +(Assert (equal (auto-save-unescape-name "hello=20=1B=1B=20there") + "hello  there")) +(Assert (equal (auto-save-escape-name "hello ") "hello=20=1B=1B")) +(Assert (equal (auto-save-unescape-name "hello=20=1B=1B") "hello ")) +(Assert (equal (auto-save-escape-name "hello ab") "hello=20=1B=1Bab")) +(Assert (equal (auto-save-unescape-name "hello=20=1B=1Bab") "hello ab")) + (when (featurep 'mule) (let ((file-name-alias (coding-system-aliasee 'file-name)) (complicated-file-name -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)