Add `diff-buffer-with-file'
14 years, 4 months
Michael Sperber
This is a synch from FSF Emacs a friend of mine has asked for. Will
commit Friday or so if nobody objects:
2010-08-18 Mike Sperber <mike(a)xemacs.org>
* files.el (diff-files-for-recover): Abstract this out out
`recover-file'.
(diff-buffer-with-file): Add from (GPLv2) FSF Emacs.
(recover-file): Use `diff-files-for-recover'.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3060,6 +3060,83 @@
(basic-save-buffer-1))
'continue-save-buffer))
+(defun diff-buffer-with-file (&optional buffer)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive "bBuffer: ")
+ (with-current-buffer (get-buffer (or buffer (current-buffer)))
+ (if (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage)
+ (diff-files-for-recover "File"
+ buffer-file-name tempfile buffer-file-name tempfile
+ buffer-file-coding-system)
+ (sit-for 0))
+ (when (file-exists-p tempfile)
+ (delete-file tempfile))))
+ (message "Buffer %s has no associated file on disc" (buffer-name))
+ ;; Display that message for 1 second so that user can read it
+ ;; in the minibuffer.
+ (sit-for 1)))
+ ;; return always nil, so that save-buffers-kill-emacs will not move
+ ;; over to the next unsaved buffer when calling `d'.
+ nil)
+
+(defun diff-files-for-recover (purpose file-1 file-2
+ failed-file-1 failed-file-2
+ coding-system)
+ "Diff two files for recovering or comparing against the last saved version.
+PURPOSE is an informational string used for naming the resulting buffer.
+FILE-1 and FILE-2 are the two files to compare.
+FAILED-FILE-1 and FAILED-FILE-2 are the names of files for which we should
+generate directory listings on failure.
+CODING-SYSTEM is the coding system of the resulting buffer."
+ (with-output-to-temp-buffer (concat "*" purpose " Diff*")
+ (buffer-disable-undo standard-output)
+ (let ((coding-system-for-read coding-system))
+ (condition-case ferr
+ (progn
+ (apply #'call-process
+ recover-file-diff-program
+ nil standard-output nil
+ (append
+ recover-file-diff-arguments
+ (list file-1 file-2)))
+ (if (fboundp 'diff-mode)
+ (save-excursion
+ (set-buffer standard-output)
+ (declare-fboundp (diff-mode)))))
+ (io-error
+ (save-excursion
+ (let ((switches
+ (declare-boundp
+ dired-listing-switches)))
+ (if (file-symlink-p failed-file-2)
+ (setq switches (concat switches "L")))
+ (set-buffer standard-output)
+ ;; XEmacs had the following line, not in FSF.
+ (setq default-directory (file-name-directory failed-file-2))
+ ;; Use insert-directory-safely,
+ ;; not insert-directory, because
+ ;; these files might not exist.
+ ;; In particular, FAILED-FILE-2 might not
+ ;; exist if the auto-save file
+ ;; was for a buffer that didn't
+ ;; visit a file, such as
+ ;; "*mail*". The code in v20.x
+ ;; called `ls' directly, so we
+ ;; need to emulate what `ls' did
+ ;; in that case.
+ (insert-directory-safely failed-file-1 switches)
+ (insert-directory-safely failed-file-2 switches))
+ (terpri)
+ (princ "Error during diff: ")
+ (display-error ferr standard-output)))))))
+
(defcustom save-some-buffers-query-display-buffer t
"*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
:type 'boolean
@@ -3689,44 +3766,7 @@
'escape-quoted))
(write-region (point-min) (point-max)
temp nil 'silent)))
- (with-output-to-temp-buffer "*Autosave Diff*"
- (buffer-disable-undo standard-output)
- (let ((coding-system-for-read
- 'escape-quoted))
- (condition-case ferr
- (apply #'call-process
- recover-file-diff-program
- nil standard-output nil
- (append
- recover-file-diff-arguments
- (list temp file-name)))
- (io-error
- (save-excursion
- (let ((switches
- (declare-boundp
- dired-listing-switches)))
- (if (file-symlink-p file)
- (setq switches (concat switches "L")))
- (set-buffer standard-output)
- ;; XEmacs had the following line, not in FSF.
- (setq default-directory (file-name-directory file))
- ;; Use insert-directory-safely,
- ;; not insert-directory, because
- ;; these files might not exist.
- ;; In particular, FILE might not
- ;; exist if the auto-save file
- ;; was for a buffer that didn't
- ;; visit a file, such as
- ;; "*mail*". The code in v20.x
- ;; called `ls' directly, so we
- ;; need to emulate what `ls' did
- ;; in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))
- (terpri)
- (princ "Error during diff: ")
- (display-error ferr
- standard-output)))))))
+ (diff-files-for-recover "Autosave" temp file-name file file-name 'escape-quoted))
(ignore-errors (kill-buffer buffer))
(ignore-file-errors
(delete-file temp)))))))))))))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Add ` diff-buffer-with-file'.
14 years, 4 months
Michael Sperber
changeset: 5245:0d71bcf96ffd
tag: tip
user: Mike Sperber <sperber(a)deinprogramm.de>
date: Wed Aug 18 17:44:24 2010 +0200
files: lisp/ChangeLog lisp/files.el
description:
Add ` diff-buffer-with-file'.
2010-08-18 Mike Sperber <mike(a)xemacs.org>
* files.el (diff-files-for-recover): Abstract this out out
`recover-file'.
(diff-buffer-with-file): Add from (GPLv2) FSF Emacs.
(recover-file): Use `diff-files-for-recover'.
diff -r 04811a268716 -r 0d71bcf96ffd lisp/ChangeLog
--- a/lisp/ChangeLog Sun Aug 15 15:42:45 2010 +0100
+++ b/lisp/ChangeLog Wed Aug 18 17:44:24 2010 +0200
@@ -1,12 +1,24 @@
+<<<<<<< local
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
-
+=======
+2010-08-18 Mike Sperber <mike(a)xemacs.org>
+>>>>>>> other
+
+<<<<<<< local
* specifier.el (canonicalize-inst-pair, canonicalize-spec):
If a specifier tag set is correct, but an instantiator is not in
an accepted format, don't error with the message "Invalid
specifier tag set".
Also, when we error, use error-symbols, for better structured
error handling and more ease when testing.
-
+=======
+ * files.el (diff-files-for-recover): Abstract this out out
+ `recover-file'.
+ (diff-buffer-with-file): Add from (GPLv2) FSF Emacs.
+ (recover-file): Use `diff-files-for-recover'.
+>>>>>>> other
+
+<<<<<<< local
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (concatenate):
@@ -16,6 +28,8 @@
If TYPE is constant, don't inline #'concatenate, replace it by a
call to the appropriate C functions.
+=======
+>>>>>>> other
2010-06-13 Stephen J. Turnbull <stephen(a)xemacs.org>
* gnome.el:
diff -r 04811a268716 -r 0d71bcf96ffd lisp/files.el
--- a/lisp/files.el Sun Aug 15 15:42:45 2010 +0100
+++ b/lisp/files.el Wed Aug 18 17:44:24 2010 +0200
@@ -3059,6 +3059,83 @@
(if (not done)
(basic-save-buffer-1))
'continue-save-buffer))
+
+(defun diff-buffer-with-file (&optional buffer)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive "bBuffer: ")
+ (with-current-buffer (get-buffer (or buffer (current-buffer)))
+ (if (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage)
+ (diff-files-for-recover "File"
+ buffer-file-name tempfile buffer-file-name tempfile
+ buffer-file-coding-system)
+ (sit-for 0))
+ (when (file-exists-p tempfile)
+ (delete-file tempfile))))
+ (message "Buffer %s has no associated file on disc" (buffer-name))
+ ;; Display that message for 1 second so that user can read it
+ ;; in the minibuffer.
+ (sit-for 1)))
+ ;; return always nil, so that save-buffers-kill-emacs will not move
+ ;; over to the next unsaved buffer when calling `d'.
+ nil)
+
+(defun diff-files-for-recover (purpose file-1 file-2
+ failed-file-1 failed-file-2
+ coding-system)
+ "Diff two files for recovering or comparing against the last saved version.
+PURPOSE is an informational string used for naming the resulting buffer.
+FILE-1 and FILE-2 are the two files to compare.
+FAILED-FILE-1 and FAILED-FILE-2 are the names of files for which we should
+generate directory listings on failure.
+CODING-SYSTEM is the coding system of the resulting buffer."
+ (with-output-to-temp-buffer (concat "*" purpose " Diff*")
+ (buffer-disable-undo standard-output)
+ (let ((coding-system-for-read coding-system))
+ (condition-case ferr
+ (progn
+ (apply #'call-process
+ recover-file-diff-program
+ nil standard-output nil
+ (append
+ recover-file-diff-arguments
+ (list file-1 file-2)))
+ (if (fboundp 'diff-mode)
+ (save-excursion
+ (set-buffer standard-output)
+ (declare-fboundp (diff-mode)))))
+ (io-error
+ (save-excursion
+ (let ((switches
+ (declare-boundp
+ dired-listing-switches)))
+ (if (file-symlink-p failed-file-2)
+ (setq switches (concat switches "L")))
+ (set-buffer standard-output)
+ ;; XEmacs had the following line, not in FSF.
+ (setq default-directory (file-name-directory failed-file-2))
+ ;; Use insert-directory-safely,
+ ;; not insert-directory, because
+ ;; these files might not exist.
+ ;; In particular, FAILED-FILE-2 might not
+ ;; exist if the auto-save file
+ ;; was for a buffer that didn't
+ ;; visit a file, such as
+ ;; "*mail*". The code in v20.x
+ ;; called `ls' directly, so we
+ ;; need to emulate what `ls' did
+ ;; in that case.
+ (insert-directory-safely failed-file-1 switches)
+ (insert-directory-safely failed-file-2 switches))
+ (terpri)
+ (princ "Error during diff: ")
+ (display-error ferr standard-output)))))))
(defcustom save-some-buffers-query-display-buffer t
"*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
@@ -3689,44 +3766,7 @@
'escape-quoted))
(write-region (point-min) (point-max)
temp nil 'silent)))
- (with-output-to-temp-buffer "*Autosave Diff*"
- (buffer-disable-undo standard-output)
- (let ((coding-system-for-read
- 'escape-quoted))
- (condition-case ferr
- (apply #'call-process
- recover-file-diff-program
- nil standard-output nil
- (append
- recover-file-diff-arguments
- (list temp file-name)))
- (io-error
- (save-excursion
- (let ((switches
- (declare-boundp
- dired-listing-switches)))
- (if (file-symlink-p file)
- (setq switches (concat switches "L")))
- (set-buffer standard-output)
- ;; XEmacs had the following line, not in FSF.
- (setq default-directory (file-name-directory file))
- ;; Use insert-directory-safely,
- ;; not insert-directory, because
- ;; these files might not exist.
- ;; In particular, FILE might not
- ;; exist if the auto-save file
- ;; was for a buffer that didn't
- ;; visit a file, such as
- ;; "*mail*". The code in v20.x
- ;; called `ls' directly, so we
- ;; need to emulate what `ls' did
- ;; in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))
- (terpri)
- (princ "Error during diff: ")
- (display-error ferr
- standard-output)))))))
+ (diff-files-for-recover "Autosave" temp file-name file file-name 'escape-quoted))
(ignore-errors (kill-buffer buffer))
(ignore-file-errors
(delete-file temp)))))))))))))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
14 years, 4 months
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1281883365 -3600
# Node ID 04811a268716dbb77524e2ab2364a243a1c5c29c
# Parent 808131ba4a5737d4eb0ecee301c98cba84dab91c
Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
lisp/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.el (canonicalize-inst-pair, canonicalize-spec):
If a specifier tag set is correct, but an instantiator is not in
an accepted format, don't error with the message "Invalid
specifier tag set".
Also, when we error, use error-symbols, for better structured
error handling and more ease when testing.
tests/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
(not, not, invalid-argument, invalid-argument):
Check that error messages from the image specifier instantiator
code are clearer than they used to be.
diff -r 808131ba4a57 -r 04811a268716 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Aug 15 13:29:10 2010 +0100
+++ b/lisp/ChangeLog Sun Aug 15 15:42:45 2010 +0100
@@ -1,3 +1,12 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * specifier.el (canonicalize-inst-pair, canonicalize-spec):
+ If a specifier tag set is correct, but an instantiator is not in
+ an accepted format, don't error with the message "Invalid
+ specifier tag set".
+ Also, when we error, use error-symbols, for better structured
+ error handling and more ease when testing.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (concatenate):
diff -r 808131ba4a57 -r 04811a268716 lisp/specifier.el
--- a/lisp/specifier.el Sun Aug 15 13:29:10 2010 +0100
+++ b/lisp/specifier.el Sun Aug 15 15:42:45 2010 +0100
@@ -105,20 +105,23 @@
;; this will signal an appropriate error.
(check-valid-instantiator inst-pair specifier-type)))
- ((and (valid-specifier-tag-p (car inst-pair))
- (valid-instantiator-p (cdr inst-pair) specifier-type))
+ ((not (valid-instantiator-p (cdr inst-pair) specifier-type))
+ (if noerror
+ t
+ (check-valid-instantiator (cdr inst-pair) specifier-type)))
+
+ ((valid-specifier-tag-p (car inst-pair))
;; case (b)
(cons (list (car inst-pair)) (cdr inst-pair)))
- ((and (valid-specifier-tag-set-p (car inst-pair))
- (valid-instantiator-p (cdr inst-pair) specifier-type))
+ ((valid-specifier-tag-set-p (car inst-pair))
;; case (c)
inst-pair)
(t
(if noerror t
- (signal 'error (list "Invalid specifier tag set"
- (car inst-pair)))))))
+ (error 'invalid-argument "Invalid specifier tag set"
+ (car inst-pair))))))
(defun canonicalize-inst-list (inst-list specifier-type &optional noerror)
"Canonicalize the given INST-LIST (a list of inst-pairs).
@@ -199,9 +202,14 @@
(if (not (valid-specifier-locale-p (car spec)))
;; invalid locale.
- (if noerror t
- (signal 'error (list "Invalid specifier locale" (car spec))))
-
+ (if noerror
+ t
+ (if (consp (car spec))
+ ;; If it's a cons, they're probably not passing a locale
+ (error 'invalid-argument
+ "Not a valid instantiator list" spec)
+ (error 'invalid-argument
+ "Invalid specifier locale" (car spec))))
;; case (b)
(let ((result (canonicalize-inst-list (cdr spec) specifier-type
noerror)))
diff -r 808131ba4a57 -r 04811a268716 tests/ChangeLog
--- a/tests/ChangeLog Sun Aug 15 13:29:10 2010 +0100
+++ b/tests/ChangeLog Sun Aug 15 15:42:45 2010 +0100
@@ -1,3 +1,10 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ (not, not, invalid-argument, invalid-argument):
+ Check that error messages from the image specifier instantiator
+ code are clearer than they used to be.
+
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r 808131ba4a57 -r 04811a268716 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sun Aug 15 13:29:10 2010 +0100
+++ b/tests/automated/lisp-tests.el Sun Aug 15 15:42:45 2010 +0100
@@ -2374,6 +2374,35 @@
(garbage-collect))))))
"checking we can amputate lists without crashing #'reduce")
+(Assert (not (eq t (canonicalize-inst-list
+ `(((mswindows) . [string :data ,(make-string 20 0)])
+ ((tty) . [string :data " "])) 'image t)))
+ "checking mswindows is always available as a specifier tag")
+
+(Assert (not (eq t (canonicalize-inst-list
+ `(((mswindows) . [nothing])
+ ((tty) . [string :data " "]))
+ 'image t)))
+ "checking the correct syntax for a nothing image specifier works")
+
+(Check-Error-Message invalid-argument "^Invalid specifier tag set"
+ (canonicalize-inst-list
+ `(((,(gensym)) . [nothing])
+ ((tty) . [string :data " "]))
+ 'image))
+
+(Check-Error-Message invalid-argument "^Unrecognized keyword"
+ (canonicalize-inst-list
+ `(((mswindows) . [nothing :data "hi there"])
+ ((tty) . [string :data " "])) 'image))
+
+;; If we combine both the specifier inst list problems, we get the
+;; unrecognized keyword error first, not the invalid specifier tag set
+;; error. This is a little unintuitive; the specifier tag set thing is
+;; processed first, and would seem to be more important. But anyone writing
+;; code needs to solve both problems, it's reasonable to ask them to do it
+;; in series rather than in parallel.
+
(when (featurep 'ratio)
(Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2")))))
"checking symbols with ratio-like names are printed distinctly")
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
14 years, 4 months
Aidan Kehoe
changeset: 5244:04811a268716
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Aug 15 15:42:45 2010 +0100
files: lisp/ChangeLog lisp/specifier.el tests/ChangeLog tests/automated/lisp-tests.el
description:
Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
lisp/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.el (canonicalize-inst-pair, canonicalize-spec):
If a specifier tag set is correct, but an instantiator is not in
an accepted format, don't error with the message "Invalid
specifier tag set".
Also, when we error, use error-symbols, for better structured
error handling and more ease when testing.
tests/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
(not, not, invalid-argument, invalid-argument):
Check that error messages from the image specifier instantiator
code are clearer than they used to be.
diff -r 808131ba4a57 -r 04811a268716 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Aug 15 13:29:10 2010 +0100
+++ b/lisp/ChangeLog Sun Aug 15 15:42:45 2010 +0100
@@ -1,3 +1,12 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * specifier.el (canonicalize-inst-pair, canonicalize-spec):
+ If a specifier tag set is correct, but an instantiator is not in
+ an accepted format, don't error with the message "Invalid
+ specifier tag set".
+ Also, when we error, use error-symbols, for better structured
+ error handling and more ease when testing.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (concatenate):
diff -r 808131ba4a57 -r 04811a268716 lisp/specifier.el
--- a/lisp/specifier.el Sun Aug 15 13:29:10 2010 +0100
+++ b/lisp/specifier.el Sun Aug 15 15:42:45 2010 +0100
@@ -105,20 +105,23 @@
;; this will signal an appropriate error.
(check-valid-instantiator inst-pair specifier-type)))
- ((and (valid-specifier-tag-p (car inst-pair))
- (valid-instantiator-p (cdr inst-pair) specifier-type))
+ ((not (valid-instantiator-p (cdr inst-pair) specifier-type))
+ (if noerror
+ t
+ (check-valid-instantiator (cdr inst-pair) specifier-type)))
+
+ ((valid-specifier-tag-p (car inst-pair))
;; case (b)
(cons (list (car inst-pair)) (cdr inst-pair)))
- ((and (valid-specifier-tag-set-p (car inst-pair))
- (valid-instantiator-p (cdr inst-pair) specifier-type))
+ ((valid-specifier-tag-set-p (car inst-pair))
;; case (c)
inst-pair)
(t
(if noerror t
- (signal 'error (list "Invalid specifier tag set"
- (car inst-pair)))))))
+ (error 'invalid-argument "Invalid specifier tag set"
+ (car inst-pair))))))
(defun canonicalize-inst-list (inst-list specifier-type &optional noerror)
"Canonicalize the given INST-LIST (a list of inst-pairs).
@@ -199,9 +202,14 @@
(if (not (valid-specifier-locale-p (car spec)))
;; invalid locale.
- (if noerror t
- (signal 'error (list "Invalid specifier locale" (car spec))))
-
+ (if noerror
+ t
+ (if (consp (car spec))
+ ;; If it's a cons, they're probably not passing a locale
+ (error 'invalid-argument
+ "Not a valid instantiator list" spec)
+ (error 'invalid-argument
+ "Invalid specifier locale" (car spec))))
;; case (b)
(let ((result (canonicalize-inst-list (cdr spec) specifier-type
noerror)))
diff -r 808131ba4a57 -r 04811a268716 tests/ChangeLog
--- a/tests/ChangeLog Sun Aug 15 13:29:10 2010 +0100
+++ b/tests/ChangeLog Sun Aug 15 15:42:45 2010 +0100
@@ -1,3 +1,10 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ (not, not, invalid-argument, invalid-argument):
+ Check that error messages from the image specifier instantiator
+ code are clearer than they used to be.
+
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r 808131ba4a57 -r 04811a268716 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sun Aug 15 13:29:10 2010 +0100
+++ b/tests/automated/lisp-tests.el Sun Aug 15 15:42:45 2010 +0100
@@ -2374,6 +2374,35 @@
(garbage-collect))))))
"checking we can amputate lists without crashing #'reduce")
+(Assert (not (eq t (canonicalize-inst-list
+ `(((mswindows) . [string :data ,(make-string 20 0)])
+ ((tty) . [string :data " "])) 'image t)))
+ "checking mswindows is always available as a specifier tag")
+
+(Assert (not (eq t (canonicalize-inst-list
+ `(((mswindows) . [nothing])
+ ((tty) . [string :data " "]))
+ 'image t)))
+ "checking the correct syntax for a nothing image specifier works")
+
+(Check-Error-Message invalid-argument "^Invalid specifier tag set"
+ (canonicalize-inst-list
+ `(((,(gensym)) . [nothing])
+ ((tty) . [string :data " "]))
+ 'image))
+
+(Check-Error-Message invalid-argument "^Unrecognized keyword"
+ (canonicalize-inst-list
+ `(((mswindows) . [nothing :data "hi there"])
+ ((tty) . [string :data " "])) 'image))
+
+;; If we combine both the specifier inst list problems, we get the
+;; unrecognized keyword error first, not the invalid specifier tag set
+;; error. This is a little unintuitive; the specifier tag set thing is
+;; processed first, and would seem to be more important. But anyone writing
+;; code needs to solve both problems, it's reasonable to ask them to do it
+;; in series rather than in parallel.
+
(when (featurep 'ratio)
(Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2")))))
"checking symbols with ratio-like names are printed distinctly")
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
[COMMIT] Print symbols with ratio-like names and the associated ratios distinctly.
14 years, 4 months
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1281875350 -3600
# Node ID 808131ba4a5737d4eb0ecee301c98cba84dab91c
# Parent f3eca926258e6ae9d6a7af522c576d80a377ac2c
Print symbols with ratio-like names and the associated ratios distinctly.
src/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* print.c (print_symbol):
Escape any symbols that look like ratios, in the same way we do
symbols that look like floats or integers. Prevents confusion in
the Lisp reader.
* lread.c (isratio_string): Make this available even on builds
without HAVE_RATIO, so we can print symbols that look like ratios
with the appropriate escapes.
* lisp.h:
Make isratio_string available even if HAVE_RATIO is not defined.
tests/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Test that symbols with names that look like ratios are printed
distinctly from the equivalent ratios.
diff -r f3eca926258e -r 808131ba4a57 src/ChangeLog
--- a/src/ChangeLog Sat Jul 24 17:38:35 2010 +0100
+++ b/src/ChangeLog Sun Aug 15 13:29:10 2010 +0100
@@ -1,3 +1,15 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * print.c (print_symbol):
+ Escape any symbols that look like ratios, in the same way we do
+ symbols that look like floats or integers. Prevents confusion in
+ the Lisp reader.
+ * lread.c (isratio_string): Make this available even on builds
+ without HAVE_RATIO, so we can print symbols that look like ratios
+ with the appropriate escapes.
+ * lisp.h:
+ Make isratio_string available even if HAVE_RATIO is not defined.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
diff -r f3eca926258e -r 808131ba4a57 src/lisp.h
--- a/src/lisp.h Sat Jul 24 17:38:35 2010 +0100
+++ b/src/lisp.h Sun Aug 15 13:29:10 2010 +0100
@@ -5355,9 +5355,7 @@
int locate_file (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, int);
EXFUN (Flocate_file_clear_hashing, 1);
int isfloat_string (const char *);
-#ifdef HAVE_RATIO
int isratio_string (const char *);
-#endif
/* Well, I've decided to enable this. -- ben */
/* And I've decided to make it work right. -- sb */
diff -r f3eca926258e -r 808131ba4a57 src/lread.c
--- a/src/lread.c Sat Jul 24 17:38:35 2010 +0100
+++ b/src/lread.c Sun Aug 15 13:29:10 2010 +0100
@@ -2876,7 +2876,6 @@
|| state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
}
-#ifdef HAVE_RATIO
int
isratio_string (const char *cp)
{
@@ -2907,7 +2906,7 @@
return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
*cp == '\r' || *cp == '\f';
}
-#endif
+
static void *
sequence_reader (Lisp_Object readcharfun,
diff -r f3eca926258e -r 808131ba4a57 src/print.c
--- a/src/print.c Sat Jul 24 17:38:35 2010 +0100
+++ b/src/print.c Sun Aug 15 13:29:10 2010 +0100
@@ -2027,7 +2027,7 @@
for (; confusing < size; confusing++)
{
- if (!isdigit (data[confusing]))
+ if (!isdigit (data[confusing]) && '/' != data[confusing])
{
confusing = 0;
break;
@@ -2039,7 +2039,8 @@
/* #### Ugh, this is needlessly complex and slow for what we
need here. It might be a good idea to copy equivalent code
from FSF. --hniksic */
- confusing = isfloat_string ((char *) data);
+ confusing = isfloat_string ((char *) data)
+ || isratio_string ((char *) data);
if (confusing)
write_ascstring (printcharfun, "\\");
}
diff -r f3eca926258e -r 808131ba4a57 tests/ChangeLog
--- a/tests/ChangeLog Sat Jul 24 17:38:35 2010 +0100
+++ b/tests/ChangeLog Sun Aug 15 13:29:10 2010 +0100
@@ -1,3 +1,9 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Test that symbols with names that look like ratios are printed
+ distinctly from the equivalent ratios.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r f3eca926258e -r 808131ba4a57 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Jul 24 17:38:35 2010 +0100
+++ b/tests/automated/lisp-tests.el Sun Aug 15 13:29:10 2010 +0100
@@ -2374,4 +2374,10 @@
(garbage-collect))))))
"checking we can amputate lists without crashing #'reduce")
+(when (featurep 'ratio)
+ (Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2")))))
+ "checking symbols with ratio-like names are printed distinctly")
+ (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
+ "checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
+
;;; end of lisp-tests.el
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
commit: Print symbols with ratio-like names and the associated ratios distinctly.
14 years, 4 months
Aidan Kehoe
changeset: 5243:808131ba4a57
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Aug 15 13:29:10 2010 +0100
files: src/ChangeLog src/lisp.h src/lread.c src/print.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Print symbols with ratio-like names and the associated ratios distinctly.
src/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* print.c (print_symbol):
Escape any symbols that look like ratios, in the same way we do
symbols that look like floats or integers. Prevents confusion in
the Lisp reader.
* lread.c (isratio_string): Make this available even on builds
without HAVE_RATIO, so we can print symbols that look like ratios
with the appropriate escapes.
* lisp.h:
Make isratio_string available even if HAVE_RATIO is not defined.
tests/ChangeLog addition:
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Test that symbols with names that look like ratios are printed
distinctly from the equivalent ratios.
diff -r f3eca926258e -r 808131ba4a57 src/ChangeLog
--- a/src/ChangeLog Sat Jul 24 17:38:35 2010 +0100
+++ b/src/ChangeLog Sun Aug 15 13:29:10 2010 +0100
@@ -1,3 +1,15 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * print.c (print_symbol):
+ Escape any symbols that look like ratios, in the same way we do
+ symbols that look like floats or integers. Prevents confusion in
+ the Lisp reader.
+ * lread.c (isratio_string): Make this available even on builds
+ without HAVE_RATIO, so we can print symbols that look like ratios
+ with the appropriate escapes.
+ * lisp.h:
+ Make isratio_string available even if HAVE_RATIO is not defined.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
diff -r f3eca926258e -r 808131ba4a57 src/lisp.h
--- a/src/lisp.h Sat Jul 24 17:38:35 2010 +0100
+++ b/src/lisp.h Sun Aug 15 13:29:10 2010 +0100
@@ -5355,9 +5355,7 @@
int locate_file (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, int);
EXFUN (Flocate_file_clear_hashing, 1);
int isfloat_string (const char *);
-#ifdef HAVE_RATIO
int isratio_string (const char *);
-#endif
/* Well, I've decided to enable this. -- ben */
/* And I've decided to make it work right. -- sb */
diff -r f3eca926258e -r 808131ba4a57 src/lread.c
--- a/src/lread.c Sat Jul 24 17:38:35 2010 +0100
+++ b/src/lread.c Sun Aug 15 13:29:10 2010 +0100
@@ -2876,7 +2876,6 @@
|| state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
}
-#ifdef HAVE_RATIO
int
isratio_string (const char *cp)
{
@@ -2907,7 +2906,7 @@
return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
*cp == '\r' || *cp == '\f';
}
-#endif
+
static void *
sequence_reader (Lisp_Object readcharfun,
diff -r f3eca926258e -r 808131ba4a57 src/print.c
--- a/src/print.c Sat Jul 24 17:38:35 2010 +0100
+++ b/src/print.c Sun Aug 15 13:29:10 2010 +0100
@@ -2027,7 +2027,7 @@
for (; confusing < size; confusing++)
{
- if (!isdigit (data[confusing]))
+ if (!isdigit (data[confusing]) && '/' != data[confusing])
{
confusing = 0;
break;
@@ -2039,7 +2039,8 @@
/* #### Ugh, this is needlessly complex and slow for what we
need here. It might be a good idea to copy equivalent code
from FSF. --hniksic */
- confusing = isfloat_string ((char *) data);
+ confusing = isfloat_string ((char *) data)
+ || isratio_string ((char *) data);
if (confusing)
write_ascstring (printcharfun, "\\");
}
diff -r f3eca926258e -r 808131ba4a57 tests/ChangeLog
--- a/tests/ChangeLog Sat Jul 24 17:38:35 2010 +0100
+++ b/tests/ChangeLog Sun Aug 15 13:29:10 2010 +0100
@@ -1,3 +1,9 @@
+2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Test that symbols with names that look like ratios are printed
+ distinctly from the equivalent ratios.
+
2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r f3eca926258e -r 808131ba4a57 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sat Jul 24 17:38:35 2010 +0100
+++ b/tests/automated/lisp-tests.el Sun Aug 15 13:29:10 2010 +0100
@@ -2374,4 +2374,10 @@
(garbage-collect))))))
"checking we can amputate lists without crashing #'reduce")
+(when (featurep 'ratio)
+ (Assert (not (eql '1/2 (read (prin1-to-string (intern "1/2")))))
+ "checking symbols with ratio-like names are printed distinctly")
+ (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
+ "checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
+
;;; end of lisp-tests.el
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches