carbon2-commit: Make Lisp reader errors more informative with over-long hex, octal characters
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Aidan Kehoe
                
 
                
                    
                        
                            changeset:   5303:02d875ebd1ea
parent:      5300:04811a268716
user:        Aidan Kehoe <kehoea(a)parhasard.net>
date:        Sat Aug 21 19:02:44 2010 +0100
files:       man/ChangeLog man/lispref/objects.texi src/ChangeLog src/lread.c
description:
Make Lisp reader errors more informative with over-long hex, octal characters
src/ChangeLog addition:
2010-08-21  Aidan Kehoe  <kehoea(a)parhasard.net>
	* lread.c (read_escape):
	Make error messages better reflect the text that was encountered,
	when overlong hex character escapes or non-Latin-1 octal character
	escapes are encountered.
man/ChangeLog addition:
2010-08-21  Aidan Kehoe  <kehoea(a)parhasard.net>
	* lispref/objects.texi (Character Type):
	Go into more detail here on the specific type of error provoked on
	overlong hex character escapes and non-Latin-1 octal character
	escapes; give details of why the latter may be encountered, and
	what to do with such code.
diff -r 04811a268716 -r 02d875ebd1ea man/ChangeLog
--- a/man/ChangeLog	Sun Aug 15 15:42:45 2010 +0100
+++ b/man/ChangeLog	Sat Aug 21 19:02:44 2010 +0100
@@ -1,3 +1,11 @@
+2010-08-21  Aidan Kehoe  <kehoea(a)parhasard.net>
+
+	* lispref/objects.texi (Character Type):
+	Go into more detail here on the specific type of error provoked on
+	overlong hex character escapes and non-Latin-1 octal character
+	escapes; give details of why the latter may be encountered, and
+	what to do with such code.
+
 2010-06-13  Stephen J. Turnbull  <stephen(a)xemacs.org>
 
 	* external-widget.texi: Correct FSF address in permission notice.
diff -r 04811a268716 -r 02d875ebd1ea man/lispref/objects.texi
--- a/man/lispref/objects.texi	Sun Aug 15 15:42:45 2010 +0100
+++ b/man/lispref/objects.texi	Sat Aug 21 19:02:44 2010 +0100
@@ -623,6 +623,8 @@
 @cindex backslash in character constant
 @cindex octal character code
 @cindex hexadecimal character code
+@cindex Overlong hex character escape
+@cindex Non-ISO-8859-1 octal character escape
 
   Finally, there are two read syntaxes involving character codes.
 It is not possible to represent multibyte or wide characters in this
@@ -643,14 +645,21 @@
 @samp{?\001} for the character @kbd{C-a}, and @code{?\002} for the
 character @kbd{C-b}.  The reader will finalize the character and start
 reading the next token when a non-octal-digit is encountered or three
-octal digits are read. 
+octal digits are read.  When a given character code is above
+@code{#o377}, the Lisp reader signals an @code{invalid-read-syntax}
+error.  Such errors are typically provoked by code written for older
+versions of GNU Emacs, where the absence of the #o octal syntax for
+integers made the character syntax convenient for non-character
+values.  Those older versions of GNU Emacs are long obsolete, so
+changing the code to use the #o integer escape is the best
+solution. @pxref{Numbers}.
 
   The second consists of a question mark followed by a backslash, the
 character @samp{x}, and the character code in hexadecimal (up to two
 hexadecimal digits); thus, @samp{?\x41} for the character @kbd{A},
 @samp{?\x1} for the character @kbd{C-a}, and @code{?\x2} for the
 character @kbd{C-b}.  If more than two hexadecimal codes are given, the
-reader signals an error.
+reader signals an @code{invalid-read-syntax} error.
 
 @example
 @group
diff -r 04811a268716 -r 02d875ebd1ea src/ChangeLog
--- a/src/ChangeLog	Sun Aug 15 15:42:45 2010 +0100
+++ b/src/ChangeLog	Sat Aug 21 19:02:44 2010 +0100
@@ -1,3 +1,10 @@
+2010-08-21  Aidan Kehoe  <kehoea(a)parhasard.net>
+
+	* lread.c (read_escape):
+	Make error messages better reflect the text that was encountered,
+	when overlong hex character escapes or non-Latin-1 octal character
+	escapes are encountered.
+
 2010-08-15  Aidan Kehoe  <kehoea(a)parhasard.net>
 
 	* print.c (print_symbol):
diff -r 04811a268716 -r 02d875ebd1ea src/lread.c
--- a/src/lread.c	Sun Aug 15 15:42:45 2010 +0100
+++ b/src/lread.c	Sat Aug 21 19:02:44 2010 +0100
@@ -1818,8 +1818,12 @@
 	      }
 	  }
 	if (i >= 0400)
-	  syntax_error ("Non-ISO-8859-1 character specified with octal escape",
-			make_int (i));
+	  {
+	    read_syntax_error ((Ascbyte *) emacs_sprintf_malloc
+			       (NULL,
+				"Non-ISO-8859-1 octal character escape, "
+				"?\\%.3o", i));
+	  }
 	return i;
       }
 
@@ -1827,13 +1831,23 @@
       /* A hex escape, as in ANSI C, except that we only allow latin-1
 	 characters to be read this way.  What is "\x4e03" supposed to
 	 mean, anyways, if the internal representation is hidden?
-         This is also consistent with the treatment of octal escapes. */
+         This is also consistent with the treatment of octal escapes.
+
+         Note that we don't accept ?\XAB as specifying the character with
+         numeric value 171; it must be ?\xAB. */
       {
+#define OVERLONG_INFO "Overlong hex character escape, ?\\x"
+
 	REGISTER Ichar i = 0;
 	REGISTER int count = 0;
+	Ascbyte seen[] = OVERLONG_INFO "\0\0\0\0\0";
+	REGISTER Ascbyte *seenp = seen + sizeof (OVERLONG_INFO) - 1;
+
+#undef OVERLONG_INFO
+
 	while (++count <= 2)
 	  {
-	    c = readchar (readcharfun);
+	    c = readchar (readcharfun), *seenp = c, ++seenp;
 	    /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
 	    if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
 	    else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
@@ -1847,21 +1861,12 @@
 
         if (count == 3)
           {
-            c = readchar (readcharfun);
+            c = readchar (readcharfun), *seenp = c, ++seenp;
             if ((c >= '0' && c <= '9') ||
                 (c >= 'a' && c <= 'f') ||
                 (c >= 'A' && c <= 'F'))
               {
-                Lisp_Object args[2];
-
-                if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
-                else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
-                else if (c >= 'A' && c <= 'F')  i = (i << 4) + (c - 'A') + 10;
-
-                args[0] = build_ascstring ("?\\x%x");
-                args[1] = make_int (i);
-                syntax_error ("Overlong hex character escape",
-                              Fformat (2, args));
+		read_syntax_error (seen);
               }
             unreadchar (readcharfun, c);
           }
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Recover from merge SNAFU.
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Michael Sperber
                
 
                
                    
                        
                            changeset:   5302:bf93bff989d8
user:        Mike Sperber <sperber(a)deinprogramm.de>
date:        Fri Aug 20 11:35:58 2010 +0200
files:       lisp/ChangeLog
description:
Recover from merge SNAFU.
diff -r 0d71bcf96ffd -r bf93bff989d8 lisp/ChangeLog
--- a/lisp/ChangeLog	Wed Aug 18 17:44:24 2010 +0200
+++ b/lisp/ChangeLog	Fri Aug 20 11:35:58 2010 +0200
@@ -1,24 +1,19 @@
-<<<<<<< local
+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'.
+
 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):
@@ -28,8 +23,6 @@
 	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:
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Add ` diff-buffer-with-file'.
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Michael Sperber
                
 
                
                    
                        
                            changeset:   5301:0d71bcf96ffd
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://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Aidan Kehoe
                
 
                
                    
                        
                            changeset:   5300:04811a268716
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://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Print symbols with ratio-like names and the associated ratios distinctly.
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Aidan Kehoe
                
 
                
                    
                        
                            changeset:   5299:808131ba4a57
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://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Bit vectors are also sequences; enforce this in some CL functions.
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Aidan Kehoe
                
 
                
                    
                        
                            changeset:   5298:f3eca926258e
user:        Aidan Kehoe <kehoea(a)parhasard.net>
date:        Sat Jul 24 17:38:35 2010 +0100
files:       lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el lisp/cl-seq.el
description:
Bit vectors are also sequences; enforce this in some CL functions.
lisp/ChangeLog addition:
2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
	* cl-extra.el (concatenate):
	* cl-seq.el (remove*, cl-delete-duplicates):
	Bit vectors are also sequences; enforce this in these functions.
	* cl-macs.el (concatenate):
	If TYPE is constant, don't inline #'concatenate, replace it by a
	call to the appropriate C functions.
diff -r d579d76f3dcc -r f3eca926258e lisp/ChangeLog
--- a/lisp/ChangeLog	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/ChangeLog	Sat Jul 24 17:38:35 2010 +0100
@@ -1,3 +1,12 @@
+2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
+
+	* cl-extra.el (concatenate):
+	* cl-seq.el (remove*, cl-delete-duplicates):
+	Bit vectors are also sequences; enforce this in these functions.
+	* cl-macs.el (concatenate):
+	If TYPE is constant, don't inline #'concatenate, replace it by a
+	call to the appropriate C functions.
+
 2010-06-13  Stephen J. Turnbull  <stephen(a)xemacs.org>
 
 	* gnome.el:
diff -r d579d76f3dcc -r f3eca926258e lisp/cl-extra.el
--- a/lisp/cl-extra.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-extra.el	Sat Jul 24 17:38:35 2010 +0100
@@ -392,6 +392,7 @@
     (vector (apply 'vconcat seqs))
     (string (apply 'concat seqs))
     (list   (apply 'append (append seqs '(nil))))
+    (bit-vector (apply 'bvconcat seqs))
     (t (error 'invalid-argument "Not a sequence type name" type))))
 
 ;;; List functions.
diff -r d579d76f3dcc -r f3eca926258e lisp/cl-macs.el
--- a/lisp/cl-macs.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-macs.el	Sat Jul 24 17:38:35 2010 +0100
@@ -3751,6 +3751,16 @@
                                     :test #'equal))
         ,stack-depth))))
 
+(define-compiler-macro concatenate (&whole form type &rest seqs)
+  (if (and (cl-const-expr-p type) (memq (cl-const-expr-val type)
+                                        '(vector bit-vector list string)))
+      (case (cl-const-expr-val type)
+        (list (append (list 'append) (cddr form) '(nil)))
+        (vector (cons 'vconcat (cddr form)))
+        (bit-vector (cons 'bvconcat (cddr form)))
+        (string (cons 'concat (cddr form))))
+    form))
+
 (mapc
  #'(lambda (y)
      (put (car y) 'side-effect-free t)
diff -r d579d76f3dcc -r f3eca926258e lisp/cl-seq.el
--- a/lisp/cl-seq.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-seq.el	Sat Jul 24 17:38:35 2010 +0100
@@ -215,8 +215,11 @@
 						 (list :end (1+ cl-i))
 					       (list :start cl-i))
 					     cl-keys))))
-		  (if (listp cl-seq) cl-res
-		    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
+                  (typecase cl-seq
+                    (list cl-res)
+                    (string (concat cl-res))
+                    (vector (vconcat cl-res))
+                    (bit-vector (bvconcat cl-res))))
 	      cl-seq))
 	(setq cl-end (- (or cl-end 8000000) cl-start))
 	(if (= cl-start 0)
@@ -382,7 +385,10 @@
 	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
 	    cl-seq)))
     (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
-      (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
+      (typecase cl-seq
+        (string (concat cl-res))
+        (vector (vconcat cl-res))
+        (bit-vector (bvconcat cl-res))))))
 
 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
   "Substitute NEW for OLD in SEQ.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Be more careful about side-effects from Lisp code, #'reduce
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Aidan Kehoe
                
 
                
                    
                        
                            changeset:   5297:d579d76f3dcc
user:        Aidan Kehoe <kehoea(a)parhasard.net>
date:        Sat Jul 24 15:56:57 2010 +0100
files:       src/ChangeLog src/fns.c src/lisp.h tests/ChangeLog tests/automated/lisp-tests.el
description:
Be more careful about side-effects from Lisp code, #'reduce
src/ChangeLog addition:
2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
	* lisp.h (PARSE_KEYWORDS):
	Always accept a nil :allow-other-keys keyword argument, as
	described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup,
	and as necessary for Paul Dietz' tests for #'reduce.
	* fns.c (mapping_interaction_error): New.
	(Freduce): Call mapping_interaction_error when KEY or FUNCTION
	have modified a string SEQUENCE such that the byte length of the
	string has changed, or such that the current cursor pointer
	doesn't point to the beginning of a character.
	Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue
	writeup.
	When traversing a list, GCPRO the part of it we still have to
	traverse, to avoid any crashes if FUNCTION or KEY amputate it
	behind us and force a garbage collection.
tests/ChangeLog addition:
2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
	* automated/lisp-tests.el:
	Test a couple of things #'reduce was just made more careful
	about.
diff -r fca0cf0971de -r d579d76f3dcc src/ChangeLog
--- a/src/ChangeLog	Tue Jul 13 10:20:22 2010 +0200
+++ b/src/ChangeLog	Sat Jul 24 15:56:57 2010 +0100
@@ -1,3 +1,21 @@
+2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
+
+	* lisp.h (PARSE_KEYWORDS):
+	Always accept a nil :allow-other-keys keyword argument, as
+	described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup,
+	and as necessary for Paul Dietz' tests for #'reduce.
+
+	* fns.c (mapping_interaction_error): New.
+	(Freduce): Call mapping_interaction_error when KEY or FUNCTION
+	have modified a string SEQUENCE such that the byte length of the
+	string has changed, or such that the current cursor pointer
+	doesn't point to the beginning of a character.
+	Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue
+	writeup.
+	When traversing a list, GCPRO the part of it we still have to
+	traverse, to avoid any crashes if FUNCTION or KEY amputate it
+	behind us and force a garbage collection.
+
 2010-06-05  Marcus Crestani  <crestani(a)informatik.uni-tuebingen.de>
 
 	* gc.c:
diff -r fca0cf0971de -r d579d76f3dcc src/fns.c
--- a/src/fns.c	Tue Jul 13 10:20:22 2010 +0200
+++ b/src/fns.c	Sat Jul 24 15:56:57 2010 +0100
@@ -64,6 +64,12 @@
 
 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
+
+static DOESNT_RETURN
+mapping_interaction_error (Lisp_Object func, Lisp_Object object)
+{
+  invalid_state_2 ("object modified while traversing it", func, object);
+}
 
 static Lisp_Object
 mark_bit_vector (Lisp_Object UNUSED (obj))
@@ -4995,21 +5001,31 @@
               starting++;
               startp = XSTRING_DATA (sequence);
               cursor = startp + cursor_offset;
+
+              if (byte_len != XSTRING_LENGTH (sequence)
+                  || !valid_ibyteptr_p (cursor))
+                {
+                  mapping_interaction_error (Qreduce, sequence);
+                }
+
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
             }
 
           while (cursor_offset < byte_len && starting < ending)
             {
-              if (cursor_offset > XSTRING_LENGTH (sequence))
-                {
-                  invalid_state ("sequence modified during reduce", sequence);
-                }
-
-              startp = XSTRING_DATA (sequence);
-              cursor = startp + cursor_offset;
-              accum = call2 (function, accum,
+              accum = call2 (function, accum, 
                              KEY (key, make_char (itext_ichar (cursor))));
+
+	      startp = XSTRING_DATA (sequence);
+	      cursor = startp + cursor_offset;
+
+              if (byte_len != XSTRING_LENGTH (sequence)
+                  || !valid_ibyteptr_p (cursor))
+                {
+                  mapping_interaction_error (Qreduce, sequence);
+                }
+
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
               ++starting;
@@ -5018,7 +5034,7 @@
       else
         {
           Elemcount len = string_char_length (sequence);
-          Bytecount cursor_offset;
+          Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
           const Ibyte *cursor;
 
           ending = min (ending, len);
@@ -5035,6 +5051,13 @@
               ending--;
               if (ending > 0)
                 {
+		  cursor = XSTRING_DATA (sequence) + cursor_offset;
+
+                  if (!valid_ibyteptr_p (cursor))
+                    {
+                      mapping_interaction_error (Qreduce, sequence);
+                    }
+
                   DEC_IBYTEPTR (cursor);
                   cursor_offset = cursor - XSTRING_DATA (sequence);
                 }
@@ -5042,18 +5065,19 @@
 
           for (ii = ending - 1; ii >= starting; --ii)
             {
-              if (cursor_offset > XSTRING_LENGTH (sequence))
-                {
-                  invalid_state ("sequence modified during reduce", sequence);
-                }
-
-              cursor = XSTRING_DATA (sequence) + cursor_offset;
               accum = call2 (function, KEY (key,
                                             make_char (itext_ichar (cursor))),
                              accum);
-              if (ii > 1)
+              if (ii > 0)
                 {
                   cursor = XSTRING_DATA (sequence) + cursor_offset;
+
+                  if (byte_len != XSTRING_LENGTH (sequence)
+                      || !valid_ibyteptr_p (cursor))
+                    {
+                      mapping_interaction_error (Qreduce, sequence);
+                    }
+
                   DEC_IBYTEPTR (cursor);
                   cursor_offset = cursor - XSTRING_DATA (sequence);
                 }
@@ -5064,6 +5088,11 @@
     {
       if (NILP (from_end))
         {
+	  struct gcpro gcpro1;
+	  Lisp_Object tailed = Qnil;
+
+	  GCPRO1 (tailed);
+
           if (!UNBOUNDP (initial_value))
             {
               accum = initial_value;
@@ -5073,6 +5102,9 @@
               Elemcount counting = 0;
               EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
                 {
+		  /* KEY may amputate the list behind us; make sure what
+		     remains to be processed is still reachable.  */
+		  tailed = tail;
                   if (counting == starting)
                     {
                       accum = KEY (key, elt);
@@ -5089,6 +5121,10 @@
 
               EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
                 {
+		  /* KEY or FUNCTION may amputate the list behind us; make
+		     sure what remains to be processed is still
+		     reachable.  */
+		  tailed = tail;
                   if (counting >= starting)
                     {
                       if (counting < ending)
@@ -5103,6 +5139,8 @@
                   ++counting;
                 }
             }
+
+	  UNGCPRO;
         }
       else
         {
diff -r fca0cf0971de -r d579d76f3dcc src/lisp.h
--- a/src/lisp.h	Tue Jul 13 10:20:22 2010 +0200
+++ b/src/lisp.h	Sat Jul 24 15:56:57 2010 +0100
@@ -3577,9 +3577,18 @@
             {                                                           \
               continue;                                                 \
             }                                                           \
-          else if (!(pk_allow_other_keys                                \
-                     = non_nil_allow_other_keys_p (keywords_offset,     \
-                                                   nargs, args)))       \
+          else if ((pk_allow_other_keys                                 \
+                    = non_nil_allow_other_keys_p (keywords_offset,      \
+                                                  nargs, args)))        \
+            {                                                           \
+              continue;                                                 \
+            }                                                           \
+          else if (EQ (pk_key, Q_allow_other_keys) &&                   \
+                   NILP (pk_value))                                     \
+            {                                                           \
+              continue;                                                 \
+            }                                                           \
+          else                                                          \
             {                                                           \
               invalid_keyword_argument (function, pk_key);              \
             }                                                           \
diff -r fca0cf0971de -r d579d76f3dcc tests/ChangeLog
--- a/tests/ChangeLog	Tue Jul 13 10:20:22 2010 +0200
+++ b/tests/ChangeLog	Sat Jul 24 15:56:57 2010 +0100
@@ -1,3 +1,9 @@
+2010-07-24  Aidan Kehoe  <kehoea(a)parhasard.net>
+
+	* automated/lisp-tests.el:
+	Test a couple of things #'reduce was just made more careful
+	about.
+
 2010-06-13  Stephen J. Turnbull  <stephen(a)xemacs.org>
 
 	* gtk/event-stream-tests.el:
diff -r fca0cf0971de -r d579d76f3dcc tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el	Tue Jul 13 10:20:22 2010 +0200
+++ b/tests/automated/lisp-tests.el	Sat Jul 24 15:56:57 2010 +0100
@@ -2341,4 +2341,37 @@
 	       (gethash hashed-bignum hashing))
 	      "checking hashing works correctly with #'eql tests and bignums"))))
 
+;; 
+(when (decode-char 'ucs #x0192)
+  (Check-Error
+   invalid-state
+   (let ((str "aaaaaaaaaaaaa")
+	 (called 0)
+	 modified)
+     (reduce #'+ str
+	     :key #'(lambda (object)
+		      (prog1
+			  object
+			(incf called) 
+			(or modified
+			    (and (> called 5)
+				 (setq modified
+				       (fill str (read #r"?\u0192")))))))))))
+
+(Assert
+ (eql 55
+      (let ((sequence '(1 2 3 4 5 6 7 8 9 10))
+	    (called 0)
+	    modified)
+	(reduce #'+
+		sequence
+		:key
+		#'(lambda (object) (prog1
+				       object
+				     (incf called)
+				     (and (eql called 5)
+					  (setcdr (nthcdr 3 sequence) nil))
+				     (garbage-collect))))))
+ "checking we can amputate lists without crashing #'reduce")
+
 ;;; end of lisp-tests.el
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Merge.
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Michael Sperber
                
 
                
                    
                        
                            changeset:   5296:fca0cf0971de
parent:      5294:2cc24c69446c
parent:      5295:f19e6bc25969
user:        Mike Sperber <sperber(a)deinprogramm.de>
date:        Tue Jul 13 10:20:22 2010 +0200
files:       src/ChangeLog
description:
Merge.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
                        
                     
                    
                 
             
         
        
        
            
        
        
            
                
                    
                    
                    carbon2-commit: Backed out changeset 6466bc9ebf15
                
            
            
                15 years
            
            
                
                    
                    
                    
                    
                    Michael Sperber
                
 
                
                    
                        
                            changeset:   5295:f19e6bc25969
parent:      5293:6466bc9ebf15
user:        Mike Sperber <sperber(a)deinprogramm.de>
date:        Tue Jul 13 10:19:33 2010 +0200
files:       lisp/gtk-widget-accessors.el src/ChangeLog src/console-x-impl.h src/device-x.c src/frame-x.c src/redisplay-xlike-inc.c
description:
Backed out changeset 6466bc9ebf15
This would leave all but the first frame blank.
diff -r 6466bc9ebf15 -r f19e6bc25969 lisp/gtk-widget-accessors.el
--- a/lisp/gtk-widget-accessors.el	Wed Jun 23 08:04:18 2010 -0400
+++ b/lisp/gtk-widget-accessors.el	Tue Jul 13 10:19:33 2010 +0200
@@ -20,28 +20,28 @@
 
 (require 'gtk-ffi)
 
-(defconst G_TYPE_INVALID 0)
-(defconst G_TYPE_NONE 1)
-(defconst G_TYPE_CHAR 2)
-(defconst G_TYPE_UCHAR 3)
-(defconst G_TYPE_BOOL 4)
-(defconst G_TYPE_INT 5)
-(defconst G_TYPE_UINT 6)
-(defconst G_TYPE_LONG 7)
-(defconst G_TYPE_ULONG 8)
-(defconst G_TYPE_FLOAT 9)
-(defconst G_TYPE_DOUBLE 10)
-(defconst G_TYPE_STRING 11)
-(defconst G_TYPE_ENUM 12)
-(defconst G_TYPE_FLAGS 13)
-(defconst G_TYPE_BOXED 14)
-(defconst G_TYPE_POINTER 15)
-(defconst G_TYPE_SIGNAL 16)
-(defconst G_TYPE_ARGS 17)
-(defconst G_TYPE_CALLBACK 18)
-(defconst G_TYPE_C_CALLBACK 19)
-(defconst G_TYPE_FOREIGN 20)
-(defconst G_TYPE_OBJECT 21)
+(defconst GTK_TYPE_INVALID 0)
+(defconst GTK_TYPE_NONE 1)
+(defconst GTK_TYPE_CHAR 2)
+(defconst GTK_TYPE_UCHAR 3)
+(defconst GTK_TYPE_BOOL 4)
+(defconst GTK_TYPE_INT 5)
+(defconst GTK_TYPE_UINT 6)
+(defconst GTK_TYPE_LONG 7)
+(defconst GTK_TYPE_ULONG 8)
+(defconst GTK_TYPE_FLOAT 9)
+(defconst GTK_TYPE_DOUBLE 10)
+(defconst GTK_TYPE_STRING 11)
+(defconst GTK_TYPE_ENUM 12)
+(defconst GTK_TYPE_FLAGS 13)
+(defconst GTK_TYPE_BOXED 14)
+(defconst GTK_TYPE_POINTER 15)
+(defconst GTK_TYPE_SIGNAL 16)
+(defconst GTK_TYPE_ARGS 17)
+(defconst GTK_TYPE_CALLBACK 18)
+(defconst GTK_TYPE_C_CALLBACK 19)
+(defconst GTK_TYPE_FOREIGN 20)
+(defconst GTK_TYPE_OBJECT 21)
 
 (defconst gtk-value-accessor-names
   '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE"
@@ -88,8 +88,8 @@
        "\n"
        (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper)
 
-       (format "\targ.type = g_type_from_name (\"%s\");\n" (symbol-name (car arg))))
-;       (format "\targ.type = G_TYPE_%s;\n" (or
+       (format "\targ.type = gtk_type_from_name (\"%s\");\n" (symbol-name (car arg))))
+;       (format "\targ.type = GTK_TYPE_%s;\n" (or
 ;					       (nth (gtk-fundamental-type (car arg))
 ;						    gtk-value-accessor-names)
 ;					       (case (car arg)
@@ -100,12 +100,12 @@
 
       (setq base-arg-type (gtk-fundamental-type (car arg)))
       (cond
-       ((= base-arg-type G_TYPE_OBJECT)
+       ((= base-arg-type GTK_TYPE_OBJECT)
 	(insert
 	 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);"
 		 (cdr arg))))
-       ((or (= base-arg-type G_TYPE_POINTER)
-	    (= base-arg-type G_TYPE_BOXED))
+       ((or (= base-arg-type GTK_TYPE_POINTER)
+	    (= base-arg-type GTK_TYPE_BOXED))
 	(insert
 	 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;"
 		 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names)
@@ -117,7 +117,7 @@
 		 (cdr arg)))))
       (insert
        "\n"
-       "\treturn (g_type_to_lisp (&arg));\n"
+       "\treturn (gtk_type_to_lisp (&arg));\n"
        "}\n\n")
       (push c-func-name func-names))
     func-names))
diff -r 6466bc9ebf15 -r f19e6bc25969 src/ChangeLog
--- a/src/ChangeLog	Wed Jun 23 08:04:18 2010 -0400
+++ b/src/ChangeLog	Tue Jul 13 10:19:33 2010 +0200
@@ -1,19 +1,3 @@
-2010-06-21  Jeff Sparkes  <jsparkes(a)gmail.com>
-
-	* console-x-impl.h (DEVICE_X_XFTDRAW): Define, instead of
-	FRAME_X_FTDRAW.
-	(struct x_device): Add XftDraw field.
-	(struct x_frame): Remove XftDraw field.
-	Move XftDraw from frame to device for improved caching.
-
-	* device-x.c (x_delete_device): Free XftDraw here.
-
-	* frame-x.c (x_delete_frame): Remove freeing of XftDraw.
-
-	* redisplay-xlike-inc.c (XLIKE_output_string): Use
-	DEVICE_X_XFTDRAW instead of FRAME_X_XFTDRAW when lazily creating
-	XftDraw structure.
-
 2010-06-13  Stephen J. Turnbull  <stephen(a)xemacs.org>
 
 	* elhash.c:
diff -r 6466bc9ebf15 -r f19e6bc25969 src/console-x-impl.h
--- a/src/console-x-impl.h	Wed Jun 23 08:04:18 2010 -0400
+++ b/src/console-x-impl.h	Tue Jul 13 10:19:33 2010 +0200
@@ -67,17 +67,6 @@
 
   /* Used by x_bevel_modeline in redisplay-x.c */
   Pixmap gray_pixmap;
-
-#ifdef HAVE_XFT
-  /* The Xft Drawable wrapper for this device. */
-  /* This is persistent to take advantage of the ability of Xft's glyph
-     cache in the server, and avoid rendering the font again and again... 
-
-     This is created the first time through redisplay, and destroyed when our 
-     connection to the X display is destroyed. */
-  XftDraw *xftDraw;
-#endif
-  
 
   /* Atoms associated with this device. */
   /* allocated in Xatoms_of_device_x */
@@ -198,7 +187,6 @@
 #define DEVICE_XT_APP_SHELL(d) 	(DEVICE_X_DATA (d)->Xt_app_shell)
 #define DEVICE_X_GC_CACHE(d) 	(DEVICE_X_DATA (d)->gc_cache)
 #define DEVICE_X_GRAY_PIXMAP(d) (DEVICE_X_DATA (d)->gray_pixmap)
-#define DEVICE_X_XFTDRAW(d) 	(DEVICE_X_DATA (d)->xftDraw)
 #define DEVICE_X_WM_COMMAND_FRAME(d) (DEVICE_X_DATA (d)->WM_COMMAND_frame)
 #define DEVICE_X_MOUSE_TIMESTAMP(d)  (DEVICE_X_DATA (d)->mouse_timestamp)
 #define DEVICE_X_GLOBAL_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->global_mouse_timestamp)
@@ -331,6 +319,17 @@
 #endif /* XIM_XLIB */
 #endif /* HAVE_XIM */
 
+#ifdef HAVE_XFT
+  /* The Xft Drawable wrapper for this device.
+     #### Should this be per-device, or per-frame? */
+  /* This is persistent to take advantage of the ability of Xft's glyph
+     cache in the server, and avoid rendering the font again and again... 
+
+     This is created the first time through redisplay, and destroyed when our 
+     connection to the X display is destroyed. */
+  XftDraw *xftDraw;
+#endif
+
   /* 1 if the frame is completely visible on the display, 0 otherwise.
      if 0 the frame may have been iconified or may be totally
      or partially hidden by another X window */
@@ -392,6 +391,10 @@
 
 #define FRAME_X_GEOM_FREE_ME_PLEASE(f) (FRAME_X_DATA (f)->geom_free_me_please)
 
+#ifdef HAVE_XFT
+#define FRAME_X_XFTDRAW(f)   (FRAME_X_DATA (f)->xftDraw)
+#endif
+
 #define FRAME_X_TOTALLY_VISIBLE_P(f) (FRAME_X_DATA (f)->totally_visible_p)
 #define FRAME_X_TOP_LEVEL_FRAME_P(f) (FRAME_X_DATA (f)->top_level_frame_p)
 
diff -r 6466bc9ebf15 -r f19e6bc25969 src/device-x.c
--- a/src/device-x.c	Wed Jun 23 08:04:18 2010 -0400
+++ b/src/device-x.c	Tue Jul 13 10:19:33 2010 +0200
@@ -944,18 +944,6 @@
 #ifdef FREE_CHECKING
   extern void (*__free_hook) (void *);
   int checking_free;
-#endif
-
-#ifdef HAVE_XFT
-  /* If we have an XftDraw structure, we need to free it here.
-     We can't ever have an XftDraw without a Display, so we are safe
-     to free it in here, and we avoid too much playing around with the 
-     malloc checking hooks this way. */
-  if (DEVICE_X_XFTDRAW (d)) 
-    {
-      XftDrawDestroy (DEVICE_X_XFTDRAW (d));
-      DEVICE_X_XFTDRAW (d) = NULL;
-    }
 #endif
 
   display = DEVICE_X_DISPLAY (d);
diff -r 6466bc9ebf15 -r f19e6bc25969 src/frame-x.c
--- a/src/frame-x.c	Wed Jun 23 08:04:18 2010 -0400
+++ b/src/frame-x.c	Tue Jul 13 10:19:33 2010 +0200
@@ -2614,6 +2614,19 @@
   DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f));
 #endif /* HAVE_CDE */
 
+#ifdef HAVE_XFT
+  /* If we have an XftDraw structure, we need to free it here.
+     We can't ever have an XftDraw without a Display, so we are safe
+     to free it in here, and we avoid too much playing around with the 
+     malloc checking hooks this way. */
+  if (FRAME_X_XFTDRAW (f)) 
+    {
+      XftDrawDestroy (FRAME_X_XFTDRAW (f));
+      FRAME_X_XFTDRAW (f) = NULL;
+    }
+#endif
+
+
   assert (FRAME_X_SHELL_WIDGET (f) != 0);
   dpy = XtDisplay (FRAME_X_SHELL_WIDGET (f));
 
diff -r 6466bc9ebf15 -r f19e6bc25969 src/redisplay-xlike-inc.c
--- a/src/redisplay-xlike-inc.c	Wed Jun 23 08:04:18 2010 -0400
+++ b/src/redisplay-xlike-inc.c	Tue Jul 13 10:19:33 2010 +0200
@@ -1028,10 +1028,10 @@
   XftDraw *xftDraw;
 
   /* Lazily initialize frame's xftDraw member. */
-  if (!DEVICE_X_XFTDRAW (d)) {
-    DEVICE_X_XFTDRAW (d) = XftDrawCreate (dpy, x_win, visual, cmap);
+  if (!FRAME_X_XFTDRAW (f)) {
+    FRAME_X_XFTDRAW (f) = XftDrawCreate (dpy, x_win, visual, cmap);
   }
-  xftDraw = DEVICE_X_XFTDRAW (d);
+  xftDraw = FRAME_X_XFTDRAW (f);
 
   /* #### This will probably cause asserts when passed a Lisp integer for a
      color.  See ca. line 759 this file.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches