carbon2-commit: Automated merge with ssh://sperber-guest@hg.debian.org//hg/xemacs/xemacs
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5304:9d8aaa5ac16e
parent: 5302:bf93bff989d8
parent: 5303:02d875ebd1ea
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Aug 21 19:03:15 2010 +0100
description:
Automated merge with ssh://sperber-guest＠hg.debian.org//hg/xemacs/xemacs
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
carbon2-commit: Make Lisp reader errors more informative with over-long hex, octal characters
14 years, 1 month
Aidan Kehoe
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
- 1 participants
- 0 comments
carbon2-commit: Recover from merge SNAFU.
14 years, 1 month
Michael Sperber
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
- 1 participants
- 0 comments
carbon2-commit: Add ` diff-buffer-with-file'.
14 years, 1 month
Michael Sperber
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
- 1 participants
- 0 comments
carbon2-commit: Be clearer in our error messages, #'canonicalize-inst-pair, #'canonicalize-spec
14 years, 1 month
Aidan Kehoe
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
- 1 participants
- 0 comments
carbon2-commit: Print symbols with ratio-like names and the associated ratios distinctly.
14 years, 1 month
Aidan Kehoe
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
- 1 participants
- 0 comments
carbon2-commit: Bit vectors are also sequences; enforce this in some CL functions.
14 years, 1 month
Aidan Kehoe
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
- 1 participants
- 0 comments
carbon2-commit: Be more careful about side-effects from Lisp code, #'reduce
14 years, 1 month
Aidan Kehoe
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
- 1 participants
- 0 comments
carbon2-commit: Merge.
14 years, 1 month
Michael Sperber
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
- 1 participants
- 0 comments
carbon2-commit: Backed out changeset 6466bc9ebf15
14 years, 1 month
Michael Sperber
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
- 1 participants
- 0 comments