Add `diff-buffer-with-file'
                
            
            
                15 years, 2 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'.
                
            
            
                15 years, 2 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
                
            
            
                15 years, 2 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
                
            
            
                15 years, 2 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.
                
            
            
                15 years, 2 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.
                
            
            
                15 years, 2 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