Mercurial > hg > xemacs-beta
changeset 788:026c5bf9c134
[xemacs-hg @ 2002-03-21 07:29:57 by ben]
chartab.c: Fix bugs in implementation and doc strings.
config.h.in: Add foo_checking_assert_at_line() macros. Not clear whether these
are actually useful, though; I'll take them out if not.
symsinit.h, emacs.c: Some improvements to the timeline. Rearrange a bit the init
calls. Add call for reinit_vars_of_object_mswindows() and
declare in symsinit.h.
event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, events.c, events.h: Introduce new event methods for printing, comparing, and hashing
magic events, to avoid event-type-specific stuff that had crept
into events.c. (And was crashing, since the channel in MS Windows
magic events may be nil.) Implement the methods in
event-{tty,gtk,Xt,mswindows}.c. Make wrapping functions
event_stream_{compare,hash,format}_magic_event() to check if
everything's OK and call the actual callback. Fix events.c to use
the new methods. Add a new event-stream-operation
EVENT_STREAM_NOTHING -- event stream not actually required to be
able to do anything, just be open. (#### This
event-stream-operation stuff needs to be rethought.)
Fixed describe_event() in event-Xt.c to print its output to a
stream, not always to stderr, so it can be used
elsewhere. (e.g. in print-event when a magic event is
encountered?)
lisp.h, lrecord.h: Define new assert_at_line(), for use in asserts inside of inline
functions. The assert will report the line and file of the inline
function, which is almost certainly not what you want as it's
useless. what you want to see is where the pseudo-macro was
called from. So, when error-checking is on, we pass in the line
and file into the macros, for accurate printout using
assert_at_line(). Happens only when error-checking is defined so
doesn't slow down non-error-checking builds. Fix XCHAR, XINT,
XCHAR_OR_INT, XFOO, and wrap_foo() in this fashion.
lstream.c, lstream.h: Add resizing_buffer_to_lisp_string().
objects-gtk.c: Fix typo.
objects-msw.c: Implement a smarter way of determining whether a font matches a
charset. Formerly we just looked at the "script" element of the
font spec, converted it to a code page, and compared it with the
code page derived from the charset. Now, as well as doing this,
we ask the font for the list of unicode ranges it supports, see
what range the charset falls into (#### bogus! need to do this
char-by-char), and see if any of the font's supported ranges
include the charset's range. also do some caching in
Vfont_signature_data of previous inquiries.
charset.h, text.c, mule-charset.c: New fun; extracted out of
Fmake_char() and declare prototype in charset.h.
text.h: introduce assert_by_line() to make
REP_BYTES_BY_FIRST_BYTE report the file and line more accurately
in an assertion failure.
unicode.c: make non-static (used in objects-msw.c), declare in charset.h.
mule\mule-category.el: Start implementing a category API compatible with FSF. Not there yet.
We need improvements to char-tables.
mule\mule-charset.el: Copy translation table code from FSF 21.1 and fix up. Eventually
we'll have them in XEmacs. (used in ccl) Not here quite yet, and
we need some improvements to char-tables.
mule\cyril-util.el, mule\cyrillic.el, mule\devan-util.el, mule\ethio-util.el, mule\korea-util.el, mule\mule-tty-init.el, mule\tibet-util.el, mule\viet-util.el, mule\vietnamese.el: Fix numerous compilation warnings. Fix up code related to
translation tables and other types of char-tables.
menubar-items.el: Move the frame commands from
the View menu to the File menu, to be consistent with how most other
programs do things. Move less-used revert/recover items to a submenu.
Make "recover" not prompt for a file, but recover the current buffer.
TODO.ben-mule-21-5: Create bug list for latest problems.
| author | ben |
|---|---|
| date | Thu, 21 Mar 2002 07:31:30 +0000 |
| parents | 242b62e9fc59 |
| children | 06b73d289047 |
| files | ChangeLog TODO.ben-mule-21-5 lisp/ChangeLog lisp/menubar-items.el lisp/mule/cyril-util.el lisp/mule/cyrillic.el lisp/mule/devan-util.el lisp/mule/ethio-util.el lisp/mule/korea-util.el lisp/mule/mule-category.el lisp/mule/mule-charset.el lisp/mule/mule-tty-init.el lisp/mule/tibet-util.el lisp/mule/viet-util.el lisp/mule/vietnamese.el src/ChangeLog src/charset.h src/chartab.c src/config.h.in src/emacs.c src/event-Xt.c src/event-gtk.c src/event-msw.c src/event-stream.c src/event-tty.c src/events.c src/events.h src/lisp.h src/lrecord.h src/lstream.c src/lstream.h src/mule-charset.c src/objects-gtk.c src/objects-msw.c src/symsinit.h src/text.c src/text.h src/unicode.c |
| diffstat | 38 files changed, 1187 insertions(+), 337 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Wed Mar 20 10:21:23 2002 +0000 +++ b/ChangeLog Thu Mar 21 07:31:30 2002 +0000 @@ -1,3 +1,9 @@ +2002-03-20 Ben Wing <ben@xemacs.org> + + * TODO.ben-mule-21-5: + * TODO.ben-mule-21-5 (bugs): + Create bug list for latest problems. + 2002-03-18 Ben Wing <ben@xemacs.org> * README (http):
--- a/TODO.ben-mule-21-5 Wed Mar 20 10:21:23 2002 +0000 +++ b/TODO.ben-mule-21-5 Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,21 @@ +March 20, 2002: +bugs: -last update: August 29, 2001. +-- TTY-mode problem. When you start up in TTY mode, XEmacs goes through + the loadup process and appears to be working -- you see the startup + screen pulsing through the different screens, and it appears to be + listening (hitting a key stops the screen motion), but it's frozen -- + the screen won't get off the startup, key commands don't cause anything + to happen. STATUS: In progress. + +-- Problem loading mule-ucs/reldata/iso8859-6.el or the languages/hebrew.el + file from GNU 21 sources. Probably the escape sequences specify reverse + direction and we can't handle that yet. + +-- Memory ballooning in some cases. Not yet understood. + +August 29, 2001. This is the most current list of priorities in `ben-mule-21-5'. Updated often.
--- a/lisp/ChangeLog Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/ChangeLog Thu Mar 21 07:31:30 2002 +0000 @@ -1,3 +1,47 @@ +2002-03-20 Ben Wing <ben@xemacs.org> + + * mule\mule-category.el: + * mule\mule-category.el (with-category-table): New. + Start implementing a category API compatible with FSF. Not there yet. + We need improvements to char-tables. + + * mule\mule-charset.el: + * mule\mule-charset.el ((translation-table): New. + * mule\mule-charset.el (make-translation-table): New. + * mule\mule-charset.el (named-translation-table-hash-table): New. + * mule\mule-charset.el (define-translation-table): New. + * mule\mule-charset.el (find-translation-table): New. + * mule\mule-charset.el (get-translation-table): New. + Copy translation table code from FSF 21.1 and fix up. Eventually + we'll have them in XEmacs. (used in ccl) Not here quite yet, and + we need some improvements to char-tables. + + * mule\cyril-util.el: + * mule\cyril-util.el (cyrillic-encode-koi8-r-char): + * mule\cyril-util.el (cyrillic-encode-alternativnyj-char): + * mule\cyrillic.el: + * mule\cyrillic.el (cyrillic-koi8-r-to-external-code-table): New. + * mule\cyrillic.el (cyrillic-alternativnyj-to-external-code-table): New. + * mule\devan-util.el (devanagari-compose-string): + * mule\ethio-util.el: + * mule\korea-util.el: + * mule\mule-tty-init.el (init-mule-tty-win): + * mule\tibet-util.el (tibetan-add-components): + * mule\tibet-util.el (tibetan-compose-region): + * mule\viet-util.el: + * mule\viet-util.el (viet-encode-viscii-char): + * mule\vietnamese.el: + * mule\vietnamese.el (viet-viscii-to-external-code-table): New. + Fix numerous compilation warnings. Fix up code related to + translation tables and other types of char-tables. + +2002-03-20 Ben Wing <ben@xemacs.org> + + * menubar-items.el (default-menubar): Move the frame commands from + the View menu to the File menu, to be consistent with how most other + programs do things. Move less-used revert/recover items to a submenu. + Make "recover" not prompt for a file, but recover the current buffer. + 2002-03-20 Ben Wing <ben@xemacs.org> * dumped-lisp.el (preloaded-file-list): debug.el -> diagnose.el.
--- a/lisp/menubar-items.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/menubar-items.el Thu Mar 21 07:31:30 2002 +0000 @@ -252,6 +252,13 @@ ["%_Insert File..." insert-file] ["%_View File..." view-file] "------" + ["%_New Frame" make-frame] + ["Frame on Other %_Display..." make-frame-on-display + :active (fboundp 'make-frame-on-display)] + ["%_Close Frame" delete-frame + :active (not (eq (next-frame (selected-frame) 'nomini 'window-system) + (selected-frame)))] + "-----" ["%_Save" save-buffer :active (buffer-modified-p) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] @@ -275,7 +282,8 @@ ["%_Revert Buffer" revert-buffer :active (or buffer-file-name revert-buffer-function) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ("Rever%_t Buffer with Specified Encoding" + ("%_Rever%_t/Recover" + ("Revert Buffer with Specified %_Encoding" :filter (lambda (menu) (coding-system-menu-filter @@ -285,8 +293,11 @@ (lambda (entry) (or buffer-file-name revert-buffer-function)) t)) ) - ["Re%_cover File..." recover-file] - ["Recover Sessio%_n..." recover-session] + ["Re%_cover Buffer from Autosave" (recover-file buffer-file-name) + :active buffer-file-name + :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + ["Recover %_Session..." recover-session] + ) "-----" ["E%_xit XEmacs" save-buffers-kill-emacs] ) @@ -329,13 +340,6 @@ ) ("%_View" - ["%_New Frame" make-frame] - ["Frame on Other Displa%_y..." make-frame-on-display - :active (fboundp 'make-frame-on-display)] - ["%_Delete Frame" delete-frame - :active (not (eq (next-frame (selected-frame) 'nomini 'window-system) - (selected-frame)))] - "-----" ["%_Split Window" split-window-vertically] ["S%_plit Window (Side by Side)" split-window-horizontally] ["%_Un-Split (Keep This)" delete-other-windows
--- a/lisp/mule/cyril-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/cyril-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,7 @@ ;;; cyril-util.el --- utilities for Cyrillic scripts -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 2002 Ben Wing. ;; Keywords: mule, multilingual, Cyrillic @@ -30,12 +31,12 @@ ;;;###autoload (defun cyrillic-encode-koi8-r-char (char) "Return KOI8-R external character code of CHAR if appropriate." - (get-char-table char cyrillic-koi8-r-nonascii-translation-table)) + (get-char-table char cyrillic-koi8-r-to-external-code-table)) ;;;###autoload (defun cyrillic-encode-alternativnyj-char (char) "Return ALTERNATIVNYJ external character code of CHAR if appropriate." - (get-char-table char cyrillic-alternativnyj-nonascii-translation-table)) + (get-char-table char cyrillic-alternativnyj-to-external-code-table)) ;; Display
--- a/lisp/mule/cyrillic.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/cyrillic.el Thu Mar 21 07:31:30 2002 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko -;; Copyright (C) 2001 Ben Wing. +;; Copyright (C) 2001, 2002 Ben Wing. ;; Keywords: multilingual, Cyrillic @@ -162,9 +162,16 @@ ;; (setq font-ccl-encoder-alist ;; (cons (cons "koi8" ccl-encode-koi8-font) font-ccl-encoder-alist)) -;; (defvar cyrillic-koi8-r-nonascii-translation-table -;; (make-translation-table-from-vector cyrillic-koi8-r-decode-table) -;; "Value of `nonascii-translation-table' in Cyrillic-KOI8 language environment..") +(defvar cyrillic-koi8-r-to-external-code-table + (let ((table (make-char-table 'generic)) + (i 0) + (len (length cyrillic-koi8-r-decode-table))) + (while (< i len) + (let ((ch (aref cyrillic-koi8-r-decode-table i))) + (if (characterp ch) + (put-char-table ch i table))) + (incf i))) + "Table to convert from characters to their Koi8-R code.") (set-language-info-alist "Cyrillic-KOI8" '((charset cyrillic-iso8859-5) @@ -261,9 +268,16 @@ ;; (cons (cons "alternativnyj" ccl-encode-alternativnyj-font) ;; font-ccl-encoder-alist)) -;; (defvar cyrillic-alternativnyj-nonascii-translation-table -;; (make-translation-table-from-vector cyrillic-alternativnyj-decode-table) -;; "Value of `nonascii-translation-table' in Cyrillic-ALT language environment.") +(defvar cyrillic-alternativnyj-to-external-code-table + (let ((table (make-char-table 'generic)) + (i 0) + (len (length cyrillic-alternativnyj-decode-table))) + (while (< i len) + (let ((ch (aref cyrillic-alternativnyj-decode-table i))) + (if (characterp ch) + (put-char-table ch i table))) + (incf i))) + "Table to convert from characters to their Alternativnyj code.") (set-language-info-alist "Cyrillic-ALT" '((charset cyrillic-iso8859-5)
--- a/lisp/mule/devan-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/devan-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -1196,7 +1196,8 @@ (defun devanagari-compose-string (str &rest langs) (setq str (copy-sequence str)) (let ((idx 0) - rest match-b match-e) + ;rest match-b match-e + ) (while (string-match devanagari-composite-glyph-unit str idx) (let* ((match-b (match-beginning 0)) (match-e (match-end 0))
--- a/lisp/mule/ethio-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/ethio-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -30,6 +30,11 @@ ;;; Code: +(globally-declare-boundp '(sera-being-called-by-w3 + rmail-message-vector rmail-current-message)) +(globally-declare-fboundp '(rfc822-goto-eoh line-end-position quail-title + quail-defrule)) + ;; Information for exiting Ethiopic environment. (defvar exit-ethiopic-environment-data nil)
--- a/lisp/mule/korea-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/korea-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -27,6 +27,10 @@ ;;; Code: +(globally-declare-boundp '(input-method-function + isearch-input-method-function + isearch-input-method-local-p)) + ;;;###autoload (defvar default-korean-keyboard (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
--- a/lisp/mule/mule-category.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/mule-category.el Thu Mar 21 07:31:30 2002 +0000 @@ -133,6 +133,15 @@ ; (if (null vec) nil ; (= 1 (aref vec (- category 32)))))) +(put 'with-category-table 'lisp-indent-function 1) + +(defmacro with-category-table (category-table &rest body) + `(let ((current-category-table (category-table))) + (set-category-table ,category-table) + (unwind-protect + (progn ,@body) + (set-category-table current-category-table)))) + (defun describe-category () "Describe the category specifications in the category table. The descriptions are inserted in a buffer, which is then displayed."
--- a/lisp/mule/mule-charset.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/mule-charset.el Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,8 @@ ;;; mule-charset.el --- Charset functions for Mule. -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1992, 2001 Free Software Foundation, Inc. +;; Licensed to the Free Software Foundation. ;; Copyright (C) 1995 Amdahl Corporation. ;; Copyright (C) 1996 Sun Microsystems. ;; Copyright (C) 2002 Ben Wing. @@ -156,6 +158,138 @@ (defalias 'set-charset-plist 'setplist) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; translation tables ; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defstruct (translation-table (:constructor internal-make-translation-table)) + forward + reverse) + +(defun make-translation-table (&rest args) + "Make a translation table from arguments. +A translation table is a char table intended for for character +translation in CCL programs. + +Each argument is a list of elemnts of the form (FROM . TO), where FROM +is a character to be translated to TO. + +FROM can be a generic character (see `make-char'). In this case, TO is +a generic character containing the same number of characters, or a +ordinary character. If FROM and TO are both generic characters, all +characters belonging to FROM are translated to characters belonging to TO +without changing their position code(s). + +The arguments and forms in each argument are processed in the given +order, and if a previous form already translates TO to some other +character, say TO-ALT, FROM is also translated to TO-ALT." + (let ((table (internal-make-translation-table + :forward (make-char-table 'generic))) + revlist) + (while args + (let ((elts (car args))) + (while elts + (let* ((from (car (car elts))) + (from-i 0) ; degree of freedom of FROM + (from-rev (nreverse (split-char from))) + (to (cdr (car elts))) + (to-i 0) ; degree of freedom of TO + (to-rev (nreverse (split-char to)))) + ;; Check numbers of heading 0s in FROM-REV and TO-REV. + (while (eq (car from-rev) 0) + (setq from-i (1+ from-i) from-rev (cdr from-rev))) + (while (eq (car to-rev) 0) + (setq to-i (1+ to-i) to-rev (cdr to-rev))) + (if (and (/= from-i to-i) (/= to-i 0)) + (error "Invalid character pair (%d . %d)" from to)) + ;; If we have already translated TO to TO-ALT, FROM should + ;; also be translated to TO-ALT. But, this is only if TO + ;; is a generic character or TO-ALT is not a generic + ;; character. + (let ((to-alt (get-char-table to table))) + (if (and to-alt + (or (> to-i 0) (not (find-charset to-alt)))) + (setq to to-alt))) + (if (> from-i 0) + (set-char-table-default table from to) + (put-char-table from to table)) + ;; If we have already translated some chars to FROM, they + ;; should also be translated to TO. + (let ((l (assq from revlist))) + (if l + (let ((ch (car l))) + (setcar l to) + (setq l (cdr l)) + (while l + (put-char-table ch to table) + (setq l (cdr l)) )))) + ;; Now update REVLIST. + (let ((l (assq to revlist))) + (if l + (setcdr l (cons from (cdr l))) + (setq revlist (cons (list to from) revlist))))) + (setq elts (cdr elts)))) + (setq args (cdr args))) + ;; Return TABLE just created. + table)) + +;; Do we really need this? +; (defun make-translation-table-from-vector (vec) +; "Make translation table from decoding vector VEC. +; VEC is an array of 256 elements to map unibyte codes to multibyte characters. +; See also the variable `nonascii-translation-table'." +; (let ((table (make-char-table 'translation-table)) +; (rev-table (make-char-table 'translation-table)) +; (i 0) +; ch) +; (while (< i 256) +; (setq ch (aref vec i)) +; (aset table i ch) +; (if (>= ch 256) +; (aset rev-table ch i)) +; (setq i (1+ i))) +; (set-char-table-extra-slot table 0 rev-table) +; table)) + +(defvar named-translation-table-hash-table (make-hash-table)) + +(defun define-translation-table (symbol &rest args) + "Define SYMBOL as the name of translation table made by ARGS. +This sets up information so that the table can be used for +translations in a CCL program. + +If the first element of ARGS is a translation table, just define SYMBOL to +name it. (Note that this function does not bind SYMBOL.) + +Any other ARGS should be suitable as arguments of the function +`make-translation-table' (which see). + +Look up a named translation table using `find-translation-table' or +`get-translation-table'." + (let ((table (if (translation-table-p (car args)) + (car args) + (apply 'make-translation-table args)))) + (puthash symbol table named-translation-table-hash-table))) + +(defun find-translation-table (table-or-name) + "Retrieve the translation table of the given name. +If TABLE-OR-NAME is a translation table object, it is simply returned. +Otherwise, TABLE-OR-NAME should be a symbol. If there is no such +translation table, nil is returned. Otherwise the associated translation +table object is returned." + (if (translation-table-p table-or-name) + table-or-name + (check-argument-type 'symbolp table-or-name) + (gethash table-or-name named-translation-table-hash-table))) + +(defun get-translation-table (table-or-name) + "Retrieve the translation table of the given name. +Same as `find-translation-table' except an error is signalled if there is +no such translation table instead of returning nil." + (or (find-translation-table table-or-name) + (error 'invalid-argument "No such translation table" table-or-name))) + + ;; Setup auto-fill-chars for charsets that should invoke auto-filling. ;; SPACE and NEWLINE are already set. (let ((l '(katakana-jisx0201
--- a/lisp/mule/mule-tty-init.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/mule-tty-init.el Thu Mar 21 07:31:30 2002 +0000 @@ -41,7 +41,7 @@ (when (string-match "^kterm" (getenv "TERM")) (set-terminal-coding-system 'euc-jp) (set-keyboard-coding-system 'euc-jp)) - (set-console-tty-coding-system)))) + (declare-fboundp (set-console-tty-coding-system))))) (setq mule-tty-win-initted t))) ;;; mule-tty-init.el ends here
--- a/lisp/mule/tibet-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/tibet-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -143,14 +143,15 @@ (let ((last (last components)) (stack-upper '(tc . bc)) (stack-under '(bc . tc)) - rule comp-vowel tmp) + rule comp-vowel ;tmp + ) ;; Special treatment for 'a chung. ;; If 'a follows a consonant, turn it into the subjoined form. ;; * Disabled by Tomabechi 2000/06/09 * ;; Because in Unicode, $(7"A(B may follow directly a consonant without ;; any intervening vowel, as in 4$(7"90"914""0"""Q14"A0"A1!;(B=4$(7"90"91(B 4$(7""0""1(B 4$(7"A0"A1(B not 4$(7"90"91(B 4$(7""0""1(B $(7"Q(B 4$(7"A0"A1(B ;;(if (and (= char ?$(7"A(B) - ;; (aref (char-category-set (car last)) ?0)) + ;; (char-in-category-p (car last) ?0)) ;; (setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10 ;; Composite vowel signs are decomposed before being added @@ -165,11 +166,11 @@ tibetan-composite-vowel-alist)))) (cond ;; Compose upper vowel sign vertically over. - ((aref (char-category-set char) ?2) + ((char-in-category-p char ?2) (setq rule stack-upper)) ;; Compose lower vowel sign vertically under. - ((aref (char-category-set char) ?3) + ((char-in-category-p char ?3) (if (eq char ?$(7"Q(B) ;; `$(7"Q(B' should not visible when composed. (setq rule nil) (setq rule stack-under))) @@ -227,7 +228,7 @@ (defun tibetan-compose-region (beg end) "Compose Tibetan text the region BEG and END." (interactive "r") - (let (str result chars) + ;(let (str result chars) (save-excursion (save-restriction (narrow-to-region beg end) @@ -253,7 +254,9 @@ (while (< (point) to) (tibetan-add-components components (following-char)) (forward-char 1)) - (compose-region from to components))))))) + (compose-region from to components))))) + ;) + ) (defvar tibetan-decompose-precomposition-alist (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x))))
--- a/lisp/mule/viet-util.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/viet-util.el Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,7 @@ ;;; viet-util.el --- utilities for Vietnamese -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 2002 Ben Wing. ;; Licensed to the Free Software Foundation. ;; Keywords: mule, multilingual, Vietnamese @@ -40,7 +41,7 @@ ;;;###autoload (defun viet-encode-viscii-char (char) "Return VISCII character code of CHAR if appropriate." - (get-char-table char viet-viscii-nonascii-translation-table)) + (get-char-table char viet-viscii-to-external-code-table)) ;; VIQR is a menmonic encoding specification for Vietnamese. ;; It represents diacritical marks by ASCII characters as follows:
--- a/lisp/mule/vietnamese.el Wed Mar 20 10:21:23 2002 +0000 +++ b/lisp/mule/vietnamese.el Thu Mar 21 07:31:30 2002 +0000 @@ -3,6 +3,7 @@ ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1997 MORIOKA Tomohiko +;; Copyright (C) 2002 Ben Wing. ;; Keywords: multilingual, Vietnamese @@ -314,9 +315,16 @@ ;; (setq font-ccl-encoder-alist ;; (cons (cons "vscii" ccl-encode-vscii-font) font-ccl-encoder-alist)) -;; (defvar viet-viscii-nonascii-translation-table -;; (make-translation-table-from-vector viet-viscii-decode-table) -;; "Value of `nonascii-translation-table' in Vietnamese language environment.") +(defvar viet-viscii-to-external-code-table + (let ((table (make-char-table 'generic)) + (i 0) + (len (length viet-viscii-decode-table))) + (while (< i len) + (let ((ch (aref viet-viscii-decode-table i))) + (if (characterp ch) + (put-char-table ch i table))) + (incf i))) + "Table to convert from characters to their VISCII code.") (set-language-info-alist "Vietnamese" '((charset vietnamese-viscii-lower vietnamese-viscii-upper)
--- a/src/ChangeLog Wed Mar 20 10:21:23 2002 +0000 +++ b/src/ChangeLog Thu Mar 21 07:31:30 2002 +0000 @@ -1,3 +1,123 @@ +2002-03-20 Ben Wing <ben@xemacs.org> + + * chartab.c: + * chartab.c (Fcheck_category_at): + * chartab.c (Fchar_in_category_p): + Fix bugs in implementation and doc strings. + + * config.h.in (type_checking_assert_at_line): + Add foo_checking_assert_at_line() macros. Not clear whether these + are actually useful, though; I'll take them out if not. + + * symsinit.h: + * emacs.c: + * emacs.c (main_1): + Some improvements to the timeline. Rearrange a bit the init + calls. Add call for reinit_vars_of_object_mswindows() and + declare in symsinit.h. + + * event-Xt.c: + * event-Xt.c (emacs_Xt_format_magic_event): + * event-Xt.c (describe_event_window): + * event-Xt.c (describe_event): + * event-Xt.c (emacs_Xt_event_handler): + * event-Xt.c (reinit_vars_of_event_Xt): + * event-gtk.c: + * event-gtk.c (emacs_gtk_format_magic_event): + * event-gtk.c (reinit_vars_of_event_gtk): + * event-msw.c: + * event-msw.c (emacs_mswindows_format_magic_event): + * event-msw.c (reinit_vars_of_event_mswindows): + * event-stream.c: + * event-stream.c (event_stream_operation): + * event-stream.c (check_event_stream_ok): + * event-stream.c (event_stream_handle_magic_event): + * event-tty.c: + * event-tty.c (emacs_tty_format_magic_event): + * event-tty.c (reinit_vars_of_event_tty): + * events.c: + * events.c (event_equal): + * events.c (event_hash): + * events.c (format_event_object): + * events.h: + * events.h (struct event_stream): + * events.h (union magic_data): + + Introduce new event methods for printing, comparing, and hashing + magic events, to avoid event-type-specific stuff that had crept + into events.c. (And was crashing, since the channel in MS Windows + magic events may be nil.) Implement the methods in + event-{tty,gtk,Xt,mswindows}.c. Make wrapping functions + event_stream_{compare,hash,format}_magic_event() to check if + everything's OK and call the actual callback. Fix events.c to use + the new methods. Add a new event-stream-operation + EVENT_STREAM_NOTHING -- event stream not actually required to be + able to do anything, just be open. (#### This + event-stream-operation stuff needs to be rethought.) + + Fixed describe_event() in event-Xt.c to print its output to a + stream, not always to stderr, so it can be used + elsewhere. (e.g. in print-event when a magic event is + encountered?) + + * lisp.h: + * lisp.h (XCHAR_1): + * lisp.h (XCHAR): + * lisp.h (XINT_1): + * lisp.h (XCHAR_OR_INT_1): + * lrecord.h: + * lrecord.h (DECLARE_LRECORD): + * lrecord.h (DECLARE_EXTERNAL_LRECORD): + * lrecord.h (DECLARE_NONRECORD): + * lrecord.h (XRECORD): + * lrecord.h (wrap_record_1): + * lrecord.h (wrap_record): + Define new assert_at_line(), for use in asserts inside of inline + functions. The assert will report the line and file of the inline + function, which is almost certainly not what you want as it's + useless. what you want to see is where the pseudo-macro was + called from. So, when error-checking is on, we pass in the line + and file into the macros, for accurate printout using + assert_at_line(). Happens only when error-checking is defined so + doesn't slow down non-error-checking builds. Fix XCHAR, XINT, + XCHAR_OR_INT, XFOO, and wrap_foo() in this fashion. + + * lstream.c: + * lstream.c (resizing_buffer_stream_ptr): + * lstream.h: + Add resizing_buffer_to_lisp_string(). + + * objects-gtk.c (gtk_find_charset_font): Fix typo. + + * objects-msw.c: + * objects-msw.c (create_hfont_from_font_spec): + * objects-msw.c (initialize_font_instance): + * objects-msw.c (mswindows_font_spec_matches_charset_stage_1): + * objects-msw.c (mswindows_font_spec_matches_charset): + * objects-msw.c (reinit_vars_of_object_mswindows): + * objects-msw.c (vars_of_objects_mswindows): + Implement a smarter way of determining whether a font matches a + charset. Formerly we just looked at the "script" element of the + font spec, converted it to a code page, and compared it with the + code page derived from the charset. Now, as well as doing this, + we ask the font for the list of unicode ranges it supports, see + what range the charset falls into (#### bogus! need to do this + char-by-char), and see if any of the font's supported ranges + include the charset's range. also do some caching in + Vfont_signature_data of previous inquiries. + + * charset.h: + * text.c (Fmake_char): + * mule-charset.c (get_charset_limits): New fun; extracted out of + Fmake_char() and declare prototype in charset.h. + + * text.h: introduce assert_by_line() to make + REP_BYTES_BY_FIRST_BYTE report the file and line more accurately + in an assertion failure. + + * unicode.c (char_to_unicode): + make non-static (used in objects-msw.c), declare in charset.h. + 2002-03-18 Ben Wing <ben@xemacs.org> * process.c:
--- a/src/charset.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/charset.h Thu Mar 21 07:31:30 2002 +0000 @@ -533,6 +533,9 @@ #define BREAKUP_CHAR(c, charset, c1, c2) \ breakup_char_1 (c, &(charset), &(c1), &(c2)) +void get_charset_limits (Lisp_Object charset, int *low, int *high); +int char_to_unicode (Emchar chr); + #endif /* MULE */ #endif /* INCLUDED_charset_h_ */
--- a/src/chartab.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/chartab.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* XEmacs routines to deal with char tables. Copyright (C) 1992, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2002 Ben Wing. Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. Licensed to the Free Software Foundation. @@ -1648,15 +1648,15 @@ CHECK_INT (position); CHECK_CATEGORY_DESIGNATOR (designator); des = XCHAR (designator); - ctbl = check_category_table (category_table, Vstandard_category_table); + ctbl = check_category_table (category_table, buf->category_table); ch = BUF_FETCH_CHAR (buf, XINT (position)); return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; } DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* -Return t if category of CHARACTER includes DESIGNATOR, else nil. +Return non-nil if category of CHARACTER includes DESIGNATOR. Optional third arg CATEGORY-TABLE specifies the category table to use, -and defaults to the standard category table. +and defaults to the current buffer's category table. */ (character, designator, category_table)) { @@ -1668,7 +1668,7 @@ des = XCHAR (designator); CHECK_CHAR (character); ch = XCHAR (character); - ctbl = check_category_table (category_table, Vstandard_category_table); + ctbl = check_category_table (category_table, current_buffer->category_table); return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; }
--- a/src/config.h.in Wed Mar 20 10:21:23 2002 +0000 +++ b/src/config.h.in Thu Mar 21 07:31:30 2002 +0000 @@ -941,18 +941,27 @@ set them. */ #ifdef ERROR_CHECK_TYPECHECK #define type_checking_assert(assertion) assert (assertion) +#define type_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) #else #define type_checking_assert(assertion) +#define type_checking_assert_at_line(assertion, file, line) #endif #ifdef ERROR_CHECK_CHARBPOS #define charbpos_checking_assert(assertion) assert (assertion) +#define charbpos_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) #else #define charbpos_checking_assert(assertion) +#define charbpos_checking_assert_at_line(assertion, file, line) #endif #ifdef ERROR_CHECK_GC #define gc_checking_assert(assertion) assert (assertion) +#define gc_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) #else #define gc_checking_assert(assertion) +#define gc_checking_assert_at_line(assertion, file, line) #endif #endif /* _SRC_CONFIG_H_ */
--- a/src/emacs.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/emacs.c Thu Mar 21 07:31:30 2002 +0000 @@ -71,9 +71,9 @@ version 21.0.65 released March 5, 1999. version 21.0.66 released March 12, 1999. version 21.0.67 released March 25, 1999. -version 21.1.2 released May 14, 1999. (This is the followup to 21.0.67. -The second version number was bumped to indicate the beginning of the -"stable" series.) +version 21.1.2 released May 14, 1999; on comp.emacs, May 28. (This is + the followup to 21.0.67. The second version number was bumped to indicate + the beginning of the "stable" series.) version 21.1.3 released June 26, 1999. version 21.1.4 released July 8, 1999. version 21.1.6 released August 14, 1999. (There was no 21.1.5.) @@ -118,12 +118,19 @@ version 21.2.38 released December 5, 2000. version 21.2.39 released December 31, 2000. version 21.2.40 released January 8, 2001. -version 21.2.41 released January 17, 2001. -version 21.2.42 released January 20, 2001. -version 21.2.43 released January 26, 2001. -version 21.2.44 released February 8, 2001. -version 21.2.45 released February 23, 2001. -version 21.2.46 released March 21, 2001. +version 21.2.41 "Polyhymnia" released January 17, 2001. +version 21.2.42 "Poseidon" released January 20, 2001. +version 21.2.43 "Terspichore" released January 26, 2001. +version 21.2.44 "Thalia" released February 8, 2001. +version 21.2.45 "Thelxepeia" released February 23, 2001. +version 21.2.46 "Urania" released March 21, 2001. +version 21.5.0 "alfalfa" released April 18, 2001. +version 21.5.1 "anise" released May 9, 2001. +version 21.5.2 "artichoke" released July 28, 2001. +version 21.5.3 "asparagus" released September 7, 2001. +version 21.5.4 "bamboo" released January 8, 2002. +version 21.5.5 "beets" released March 5, 2002. + -- A time line for GNU Emacs version 19 is @@ -144,7 +151,7 @@ version 19.20 (beta) released November 17, 1993. version 19.21 (beta) released November 17, 1993. version 19.22 (beta) released November 28, 1993. -version 19.23 (beta) released May 17, 1994. +version 19.23 (beta) released on comp.emacs, May 17, 1994. version 19.24 (beta) released May 16, 1994. version 19.25 (beta) released June 3, 1994. version 19.26 (beta) released September 11, 1994. @@ -155,15 +162,17 @@ version 19.31 released May 25, 1996. version 19.32 released July 31, 1996. version 19.33 released August 11, 1996. -version 19.34 released August 21, 1996. +version 19.34 released August 21, 1996; on comp.emacs, August 22. version 19.34b released September 6, 1996. --- A time line for GNU Emacs version 20 is +-- A time line for GNU Emacs versions 20 and 21 is version 20.1 released September 17, 1997. version 20.2 released September 20, 1997. version 20.3 released August 19, 1998. +version 20.4 released July 12, 1999; on comp.emacs, July 27. +version 21.1 released October 20, 2001. -- A time line for GNU Emacs version 18 and older is @@ -2070,18 +2079,9 @@ #endif reinit_vars_of_device (); reinit_vars_of_eval (); -#ifdef HAVE_X_WINDOWS - reinit_vars_of_event_Xt (); -#endif -#ifdef HAVE_GTK - reinit_vars_of_event_gtk (); -#endif #if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS)) reinit_vars_of_event_tty (); #endif -#ifdef HAVE_MS_WINDOWS - reinit_vars_of_event_mswindows (); -#endif reinit_vars_of_event_stream (); reinit_vars_of_events (); reinit_vars_of_extents (); @@ -2106,15 +2106,19 @@ reinit_vars_of_window (); #ifdef HAVE_MS_WINDOWS + reinit_vars_of_event_mswindows (); reinit_vars_of_frame_mswindows (); + reinit_vars_of_object_mswindows (); #endif #ifdef HAVE_GTK + reinit_vars_of_event_gtk (); reinit_vars_of_menubar_gtk (); #endif #ifdef HAVE_X_WINDOWS reinit_vars_of_device_x (); + reinit_vars_of_event_Xt (); #ifdef HAVE_SCROLLBARS reinit_vars_of_scrollbar_x (); #endif
--- a/src/event-Xt.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/event-Xt.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for X11 with Xt, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001 Ben Wing. + Copyright (C) 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -1868,6 +1868,37 @@ } static void +emacs_Xt_format_magic_event (Lisp_Event *event, Lisp_Object pstream) +{ + Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); + if (CONSOLE_X_P (XCONSOLE (console))) + write_c_string (x_event_name (event->event.magic.underlying_x_event.type), + pstream); +} + +static int +emacs_Xt_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +{ + if (CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) && + CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + return (e1->event.magic.underlying_x_event.xany.serial == + e2->event.magic.underlying_x_event.xany.serial); + if (CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) || + CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + return 0; + return 1; +} + +static Hashcode +emacs_Xt_hash_magic_event (Lisp_Event *e) +{ + Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (e)); + if (CONSOLE_X_P (XCONSOLE (console))) + return e->event.magic.underlying_x_event.xany.serial; + return 0; +} + +static void emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) { /* This function can GC */ @@ -2435,18 +2466,19 @@ #include <X11/Xproto.h> /* only describe_event() needs this */ static void -describe_event_window (Window window, Display *display) +describe_event_window (Window window, Display *display, Lisp_Object pstream) { struct frame *f; Widget w; - stderr_out (" window: 0x%lx", (unsigned long) window); + write_fmt_string (pstream, " window: 0x%lx", (unsigned long) window); w = XtWindowToWidget (display, window); if (w) - stderr_out (" %s", w->core.widget_class->core_class.class_name); + write_fmt_string (pstream, " %s", + w->core.widget_class->core_class.class_name); f = x_any_window_to_frame (get_device_from_display (display), window); if (f) - stderr_out_lisp (" \"%s\"", 1, f->name); - stderr_out ("\n"); + write_fmt_string_lisp (pstream, " \"%s\"", 1, f->name); + write_fmt_string (pstream, "\n"); } static const char * @@ -2491,23 +2523,25 @@ } static void -describe_event (XEvent *event) +describe_event (XEvent *event, Lisp_Object pstream) { char buf[100]; struct device *d = get_device_from_display (event->xany.display); sprintf (buf, "%s%s", x_event_name (event->type), event->xany.send_event ? " (send)" : ""); - stderr_out ("%-30s", buf); + write_fmt_string (pstream, "%-30s", buf); switch (event->type) { case FocusIn: case FocusOut: { XFocusChangeEvent *ev = &event->xfocus; - describe_event_window (ev->window, ev->display); - stderr_out (" mode: %s\n", XEvent_mode_to_string (ev->mode)); - stderr_out (" detail: %s\n", XEvent_detail_to_string(ev->detail)); + describe_event_window (ev->window, ev->display, pstream); + write_fmt_string (pstream, " mode: %s\n", + XEvent_mode_to_string (ev->mode)); + write_fmt_string (pstream, " detail: %s\n", + XEvent_detail_to_string (ev->detail)); break; } @@ -2516,26 +2550,26 @@ XKeyEvent *ev = &event->xkey; unsigned int state = ev->state; - describe_event_window (ev->window, ev->display); - stderr_out (" subwindow: %ld\n", ev->subwindow); - stderr_out (" state: "); + describe_event_window (ev->window, ev->display, pstream); + write_fmt_string (pstream, " subwindow: %ld\n", ev->subwindow); + write_fmt_string (pstream, " state: "); /* Complete list of modifier key masks */ - if (state & ShiftMask) stderr_out ("Shift "); - if (state & LockMask) stderr_out ("Lock "); - if (state & ControlMask) stderr_out ("Control "); - if (state & Mod1Mask) stderr_out ("Mod1 "); - if (state & Mod2Mask) stderr_out ("Mod2 "); - if (state & Mod3Mask) stderr_out ("Mod3 "); - if (state & Mod4Mask) stderr_out ("Mod4 "); - if (state & Mod5Mask) stderr_out ("Mod5 "); + if (state & ShiftMask) write_fmt_string (pstream, "Shift "); + if (state & LockMask) write_fmt_string (pstream, "Lock "); + if (state & ControlMask) write_fmt_string (pstream, "Control "); + if (state & Mod1Mask) write_fmt_string (pstream, "Mod1 "); + if (state & Mod2Mask) write_fmt_string (pstream, "Mod2 "); + if (state & Mod3Mask) write_fmt_string (pstream, "Mod3 "); + if (state & Mod4Mask) write_fmt_string (pstream, "Mod4 "); + if (state & Mod5Mask) write_fmt_string (pstream, "Mod5 "); if (! state) - stderr_out ("vanilla\n"); + write_fmt_string (pstream, "vanilla\n"); else - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); if (x_key_is_modifier_p (ev->keycode, d)) - stderr_out (" Modifier key"); - stderr_out (" keycode: 0x%x\n", ev->keycode); + write_fmt_string (pstream, " Modifier key"); + write_fmt_string (pstream, " keycode: 0x%x\n", ev->keycode); } break; @@ -2543,29 +2577,31 @@ if (debug_x_events > 1) { XExposeEvent *ev = &event->xexpose; - describe_event_window (ev->window, ev->display); - stderr_out (" region: x=%d y=%d width=%d height=%d\n", + describe_event_window (ev->window, ev->display, pstream); + write_fmt_string (pstream, + " region: x=%d y=%d width=%d height=%d\n", ev->x, ev->y, ev->width, ev->height); - stderr_out (" count: %d\n", ev->count); + write_fmt_string (pstream, " count: %d\n", ev->count); } else - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); break; case GraphicsExpose: if (debug_x_events > 1) { XGraphicsExposeEvent *ev = &event->xgraphicsexpose; - describe_event_window (ev->drawable, ev->display); - stderr_out (" major: %s\n", + describe_event_window (ev->drawable, ev->display, pstream); + write_fmt_string (pstream, " major: %s\n", (ev ->major_code == X_CopyArea ? "CopyArea" : (ev->major_code == X_CopyPlane ? "CopyPlane" : "?"))); - stderr_out (" region: x=%d y=%d width=%d height=%d\n", + write_fmt_string (pstream, + " region: x=%d y=%d width=%d height=%d\n", ev->x, ev->y, ev->width, ev->height); - stderr_out (" count: %d\n", ev->count); + write_fmt_string (pstream, " count: %d\n", ev->count); } else - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); break; case EnterNotify: @@ -2573,65 +2609,71 @@ if (debug_x_events > 1) { XCrossingEvent *ev = &event->xcrossing; - describe_event_window (ev->window, ev->display); + describe_event_window (ev->window, ev->display, pstream); #if 0 - stderr_out(" subwindow: 0x%x\n", ev->subwindow); - stderr_out(" pos: %d %d\n", ev->x, ev->y); - stderr_out(" root pos: %d %d\n", ev->x_root, ev->y_root); + write_fmt_string (pstream, " subwindow: 0x%x\n", ev->subwindow); + write_fmt_string (pstream, " pos: %d %d\n", ev->x, ev->y); + write_fmt_string (pstream, " root pos: %d %d\n", ev->x_root, + ev->y_root); #endif - stderr_out(" mode: %s\n", XEvent_mode_to_string(ev->mode)); - stderr_out(" detail: %s\n", XEvent_detail_to_string(ev->detail)); - stderr_out(" focus: %d\n", ev->focus); + write_fmt_string (pstream, " mode: %s\n", + XEvent_mode_to_string(ev->mode)); + write_fmt_string (pstream, " detail: %s\n", + XEvent_detail_to_string(ev->detail)); + write_fmt_string (pstream, " focus: %d\n", ev->focus); #if 0 - stderr_out(" state: 0x%x\n", ev->state); + write_fmt_string (pstream, " state: 0x%x\n", ev->state); #endif } else - stderr_out("\n"); + write_fmt_string (pstream, "\n"); break; case ConfigureNotify: if (debug_x_events > 1) { XConfigureEvent *ev = &event->xconfigure; - describe_event_window (ev->window, ev->display); - stderr_out(" above: 0x%lx\n", ev->above); - stderr_out(" size: %d %d %d %d\n", ev->x, ev->y, + describe_event_window (ev->window, ev->display, pstream); + write_fmt_string (pstream, " above: 0x%lx\n", ev->above); + write_fmt_string (pstream, " size: %d %d %d %d\n", ev->x, ev->y, ev->width, ev->height); - stderr_out(" redirect: %d\n", ev->override_redirect); + write_fmt_string (pstream, " redirect: %d\n", + ev->override_redirect); } else - stderr_out("\n"); + write_fmt_string (pstream, "\n"); break; case VisibilityNotify: if (debug_x_events > 1) { XVisibilityEvent *ev = &event->xvisibility; - describe_event_window (ev->window, ev->display); - stderr_out(" state: %s\n", XEvent_visibility_to_string(ev->state)); + describe_event_window (ev->window, ev->display, pstream); + write_fmt_string (pstream, " state: %s\n", + XEvent_visibility_to_string (ev->state)); } else - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); break; case ClientMessage: { XClientMessageEvent *ev = &event->xclient; char *name = XGetAtomName (ev->display, ev->message_type); - stderr_out ("%s", name); - if (!strcmp (name, "WM_PROTOCOLS")) { - char *protname = XGetAtomName (ev->display, ev->data.l[0]); - stderr_out ("(%s)", protname); - XFree (protname); - } + write_fmt_string (pstream, "%s", name); + if (!strcmp (name, "WM_PROTOCOLS")) + { + char *protname = XGetAtomName (ev->display, ev->data.l[0]); + write_fmt_string (pstream, "(%s)", protname); + XFree (protname); + } XFree (name); - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); break; } default: - stderr_out ("\n"); + write_fmt_string (pstream, "\n"); break; } @@ -2769,9 +2811,7 @@ #ifdef DEBUG_XEMACS if (debug_x_events > 0) - { - describe_event (event); - } + describe_event (event, Qexternal_debugging_output); #endif /* DEBUG_XEMACS */ if (x_event_to_emacs_event (event, XEVENT (emacs_event))) enqueue_Xt_dispatch_event (emacs_event); @@ -3286,6 +3326,9 @@ Xt_event_stream->force_event_pending = emacs_Xt_force_event_pending; Xt_event_stream->next_event_cb = emacs_Xt_next_event; Xt_event_stream->handle_magic_event_cb = emacs_Xt_handle_magic_event; + Xt_event_stream->format_magic_event_cb = emacs_Xt_format_magic_event; + Xt_event_stream->compare_magic_event_cb= emacs_Xt_compare_magic_event; + Xt_event_stream->hash_magic_event_cb = emacs_Xt_hash_magic_event; Xt_event_stream->add_timeout_cb = emacs_Xt_add_timeout; Xt_event_stream->remove_timeout_cb = emacs_Xt_remove_timeout; Xt_event_stream->select_console_cb = emacs_Xt_select_console;
--- a/src/event-gtk.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/event-gtk.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for X11 with gtk, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001 Ben Wing. + Copyright (C) 1996, 2001, 2002 Ben Wing. Copyright (C) 2000 William Perry. This file is part of XEmacs. @@ -209,6 +209,39 @@ } static void +emacs_gtk_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) +{ + Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); + if (CONSOLE_GTK_P (XCONSOLE (console))) + write_c_string (gtk_event_name (event->event.magic.underlying_gdk_event. + type)); +} + +static int +emacs_gtk_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +{ + if (CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) && + CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + return (!memcmp (&e1->event.magic.underlying_gdk_event, + &e2->event.magic.underlying_gdk_event, + sizeof (GdkEvent))); + if (CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) || + CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + return 0; + return 1; +} + +static Hashcode +emacs_gtk_hash_magic_event (Lisp_Event *e) +{ + Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (e)); + if (CONSOLE_GTK_P (XCONSOLE (console))) + return memory_hash (&e->event.magic.underlying_gdk_event, + sizeof (GdkEvent)); + return 0; +} + +static void emacs_gtk_handle_magic_event (struct Lisp_Event *emacs_event) { /* This function can GC */ @@ -1713,6 +1746,9 @@ gtk_event_stream->event_pending_p = emacs_gtk_event_pending_p; gtk_event_stream->next_event_cb = emacs_gtk_next_event; gtk_event_stream->handle_magic_event_cb= emacs_gtk_handle_magic_event; + gtk_event_stream->format_magic_event_cb= emacs_gtk_format_magic_event; + gtk_event_stream->compare_magic_event_cb= emacs_gtk_compare_magic_event; + gtk_event_stream->hash_magic_event_cb = emacs_gtk_hash_magic_event; gtk_event_stream->add_timeout_cb = emacs_gtk_add_timeout; gtk_event_stream->remove_timeout_cb = emacs_gtk_remove_timeout; gtk_event_stream->select_console_cb = emacs_gtk_select_console;
--- a/src/event-msw.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/event-msw.c Thu Mar 21 07:31:30 2002 +0000 @@ -3975,6 +3975,45 @@ Fdeallocate_event (event); } +static void +emacs_mswindows_format_magic_event (Lisp_Event *emacs_event, + Lisp_Object pstream) +{ +#define FROB(msg) case msg: write_c_string ("type=" #msg, pstream); break + + switch (EVENT_MSWINDOWS_MAGIC_TYPE (emacs_event)) + { + FROB (XM_BUMPQUEUE); + FROB (WM_PAINT); + FROB (WM_SETFOCUS); + FROB (WM_KILLFOCUS); + FROB (XM_MAPFRAME); + FROB (XM_UNMAPFRAME); + + default: abort (); + } +#undef FROB + + if (!NILP (EVENT_CHANNEL (emacs_event))) + { + write_c_string (" ", pstream); + print_internal (EVENT_CHANNEL (emacs_event), pstream, 1); + } +} + +static int +emacs_mswindows_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +{ + return (e1->event.magic.underlying_mswindows_event == + e2->event.magic.underlying_mswindows_event); +} + +static Hashcode +emacs_mswindows_hash_magic_event (Lisp_Event *e) +{ + return e->event.magic.underlying_mswindows_event; +} + /* * Handle a magic event off the dispatch queue. */ @@ -4616,6 +4655,9 @@ mswindows_event_stream->force_event_pending = 0; mswindows_event_stream->next_event_cb = emacs_mswindows_next_event; mswindows_event_stream->handle_magic_event_cb = emacs_mswindows_handle_magic_event; + mswindows_event_stream->format_magic_event_cb = emacs_mswindows_format_magic_event; + mswindows_event_stream->compare_magic_event_cb= emacs_mswindows_compare_magic_event; + mswindows_event_stream->hash_magic_event_cb = emacs_mswindows_hash_magic_event; mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; mswindows_event_stream->remove_timeout_cb = emacs_mswindows_remove_timeout; mswindows_event_stream->quit_p_cb = emacs_mswindows_quit_p;
--- a/src/event-stream.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/event-stream.c Thu Mar 21 07:31:30 2002 +0000 @@ -468,7 +468,8 @@ EVENT_STREAM_PROCESS, EVENT_STREAM_TIMEOUT, EVENT_STREAM_CONSOLE, - EVENT_STREAM_READ + EVENT_STREAM_READ, + EVENT_STREAM_NOTHING, }; static void @@ -487,6 +488,8 @@ invalid_operation ("Can't add consoles in -batch mode", Qunbound); case EVENT_STREAM_READ: invalid_operation ("Can't read events in -batch mode", Qunbound); + case EVENT_STREAM_NOTHING: + break; default: abort (); } @@ -582,6 +585,27 @@ event_stream->handle_magic_event_cb (event); } +void +event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream) +{ + check_event_stream_ok (EVENT_STREAM_NOTHING); + event_stream->format_magic_event_cb (event, pstream); +} + +int +event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +{ + check_event_stream_ok (EVENT_STREAM_NOTHING); + return event_stream->compare_magic_event_cb (e1, e2); +} + +Hashcode +event_stream_hash_magic_event (Lisp_Event *e) +{ + check_event_stream_ok (EVENT_STREAM_NOTHING); + return event_stream->hash_magic_event_cb (e); +} + static int event_stream_add_timeout (EMACS_TIME timeout) {
--- a/src/event-tty.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/event-tty.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for tty's. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. + Copyright (C) 1995, 2002 Ben Wing. This file is part of XEmacs. @@ -187,6 +187,24 @@ } static void +emacs_tty_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) +{ + /* Nothing to do currently */ +} + +static int +emacs_tty_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +{ + return 1; +} + +static Hashcode +emacs_tty_hash_magic_event (Lisp_Event *e) +{ + return 0; +} + +static void emacs_tty_handle_magic_event (Lisp_Event *emacs_event) { /* Nothing to do currently */ @@ -252,6 +270,9 @@ tty_event_stream->force_event_pending = 0; tty_event_stream->next_event_cb = emacs_tty_next_event; tty_event_stream->handle_magic_event_cb = emacs_tty_handle_magic_event; + tty_event_stream->format_magic_event_cb = emacs_tty_format_magic_event; + tty_event_stream->compare_magic_event_cb= emacs_tty_compare_magic_event; + tty_event_stream->hash_magic_event_cb = emacs_tty_hash_magic_event; tty_event_stream->add_timeout_cb = emacs_tty_add_timeout; tty_event_stream->remove_timeout_cb = emacs_tty_remove_timeout; tty_event_stream->select_console_cb = emacs_tty_select_console;
--- a/src/events.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/events.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* Events: printing them, converting them to and from characters. Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2001 Ben Wing. + Copyright (C) 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -30,13 +30,12 @@ #include "console.h" #include "console-tty.h" /* for stuff in character_to_event */ #include "device.h" -#include "console-x.h" /* for x_event_name prototype */ -#include "console-gtk.h" /* for gtk_event_name prototype */ -#include "extents.h" /* Just for the EXTENTP abort check... */ +#include "extents.h" #include "events.h" #include "frame.h" #include "glyphs.h" #include "keymap.h" /* for key_desc_list_to_event() */ +#include "lstream.h" #include "redisplay.h" #include "window.h" @@ -268,34 +267,7 @@ e2->event.magic_eval.object, 0)); case magic_event: - { - struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel)); - -#ifdef HAVE_GTK - if (CONSOLE_GTK_P (con)) - return (!memcmp (&e1->event.magic.underlying_gdk_event, - &e2->event.magic.underlying_gdk_event, - sizeof (GdkEvent))); -#endif -#ifdef HAVE_X_WINDOWS - if (CONSOLE_X_P (con)) - return (e1->event.magic.underlying_x_event.xany.serial == - e2->event.magic.underlying_x_event.xany.serial); -#endif -#ifdef HAVE_TTY - if (CONSOLE_TTY_P (con)) - return (e1->event.magic.underlying_tty_event == - e2->event.magic.underlying_tty_event); -#endif -#ifdef HAVE_MS_WINDOWS - if (CONSOLE_MSWINDOWS_P (con)) - return (!memcmp(&e1->event.magic.underlying_mswindows_event, - &e2->event.magic.underlying_mswindows_event, - sizeof (union magic_data))); -#endif - abort (); - return 1; /* not reached */ - } + return event_stream_compare_magic_event (e1, e2); case empty_event: /* Empty and deallocated events are equal. */ case dead_event: @@ -345,27 +317,7 @@ internal_hash (e->event.magic_eval.object, depth + 1)); case magic_event: - { - struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e))); -#ifdef HAVE_GTK - if (CONSOLE_GTK_P (con)) - return HASH2 (hash, e->event.magic.underlying_gdk_event.type); -#endif -#ifdef HAVE_X_WINDOWS - if (CONSOLE_X_P (con)) - return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial); -#endif -#ifdef HAVE_TTY - if (CONSOLE_TTY_P (con)) - return HASH2 (hash, e->event.magic.underlying_tty_event); -#endif -#ifdef HAVE_MS_WINDOWS - if (CONSOLE_MSWINDOWS_P (con)) - return HASH2 (hash, e->event.magic.underlying_mswindows_event); -#endif - abort (); - return 0; - } + return HASH2 (hash, event_stream_hash_magic_event (e)); case empty_event: case dead_event: @@ -1308,24 +1260,17 @@ } case magic_event: { - const char *name = NULL; + Lisp_Object stream; + struct gcpro gcpro1; + GCPRO1 (stream); -#ifdef HAVE_GTK - { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); - if (CONSOLE_GTK_P (XCONSOLE (console))) - name = gtk_event_name (event->event.magic.underlying_gdk_event.type); - } -#endif -#ifdef HAVE_X_WINDOWS - { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); - if (CONSOLE_X_P (XCONSOLE (console))) - name = x_event_name (event->event.magic.underlying_x_event.type); - } -#endif /* HAVE_X_WINDOWS */ - if (name) strcpy (buf, name); - else strcpy (buf, "???"); + stream = make_resizing_buffer_output_stream (); + event_stream_format_magic_event (event, stream); + Lstream_flush (XLSTREAM (stream)); + strncpy (buf, resizing_buffer_stream_ptr (XLSTREAM (stream)), + Lstream_byte_count (XLSTREAM (stream))); + Lstream_delete (XLSTREAM (stream)); + UNGCPRO; return; } case magic_eval_event: strcpy (buf, "magic-eval"); return;
--- a/src/events.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/events.h Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* Definitions for the new event model; created 16-jul-91 by Jamie Zawinski Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2002 Ben Wing. This file is part of XEmacs. @@ -83,6 +83,15 @@ happen in order. If the next_event_cb never returns an event of type "magic", this will never be used. + format_magic_event_cb Called with a magic event; print a representation of + the innards of the event to PSTREAM. + + compare_magic_event_cb Called with two magic events; return non-zero if + the innards of the two are equal, zero otherwise. + + hash_magic_event_cb Called with a magic event; return a hash of the + innards of the event. + add_timeout_cb Called with an EMACS_TIME, the absolute time at which a wakeup event should be generated; and a void *, which is an arbitrary value that will be @@ -187,6 +196,9 @@ int (*event_pending_p) (int); void (*next_event_cb) (Lisp_Event *); void (*handle_magic_event_cb) (Lisp_Event *); + void (*format_magic_event_cb) (Lisp_Event *, Lisp_Object pstream); + int (*compare_magic_event_cb) (Lisp_Event *, Lisp_Event *); + Hashcode (*hash_magic_event_cb)(Lisp_Event *); int (*add_timeout_cb) (EMACS_TIME); void (*remove_timeout_cb) (int); void (*select_console_cb) (struct console *); @@ -409,9 +421,6 @@ aspect of this event model. */ -#ifdef HAVE_TTY - char underlying_tty_event; -#endif #ifdef HAVE_GTK GdkEvent underlying_gdk_event; #endif @@ -617,6 +626,9 @@ void enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object); void event_stream_next_event (Lisp_Event *event); void event_stream_handle_magic_event (Lisp_Event *event); +void event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream); +int event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2); +Hashcode event_stream_hash_magic_event (Lisp_Event *e); void event_stream_select_console (struct console *con); void event_stream_unselect_console (struct console *con); void event_stream_select_process (Lisp_Process *proc);
--- a/src/lisp.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/lisp.h Thu Mar 21 07:31:30 2002 +0000 @@ -417,9 +417,12 @@ time the assert checks take is measurable so let's not include them in production binaries. - assert() returns 1 if the assert succeeded (or wasn't tried), 0 if - failed. (Normally, it would have aborted here, but with - ASSERTIONS_DONT_ABORT defined, it will continue. */ + If ASSERTIONS_DONT_ABORT defined, we will continue after assertion + failures. + + assert_at_line() is used for asserts inside of inline functions called + from error-checking macros. If we're not tricky, we just get the file + and line of the inline function, which is not very useful. */ #ifdef USE_ASSERTIONS /* Highly dubious kludge */ @@ -427,11 +430,15 @@ void assert_failed (const char *, int, const char *); # define abort() (assert_failed (__FILE__, __LINE__, "abort()")) # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x)) +# define assert_at_line(x, file, line) \ + ((x) ? (void) 0 : assert_failed (file, line, #x)) #else # ifdef DEBUG_XEMACS # define assert(x) ((x) ? (void) 0 : (void) abort ()) +# define assert_at_line(x, file, line) assert (x) # else # define assert(x) ((void) 0) +# define assert_at_line(x, file, line) assert (x) # endif #endif @@ -1733,19 +1740,21 @@ #ifdef ERROR_CHECK_TYPECHECK -INLINE_HEADER Emchar XCHAR (Lisp_Object obj); +INLINE_HEADER Emchar XCHAR_1 (Lisp_Object obj, const char *file, int line); INLINE_HEADER Emchar -XCHAR (Lisp_Object obj) +XCHAR_1 (Lisp_Object obj, const char *file, int line) { - assert (CHARP (obj)); + assert_at_line (CHARP (obj), file, line); return XCHARVAL (obj); } -#else - -#define XCHAR(x) ((Emchar)XCHARVAL (x)) - -#endif +#define XCHAR(x) XCHAR_1 (x, __FILE__, __LINE__) + +#else /* no error checking */ + +#define XCHAR(x) ((Emchar) XCHARVAL (x)) + +#endif /* no error checking */ #define CHECK_CHAR(x) CHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp) #define CONCHECK_CHAR(x) CONCHECK_NONRECORD (x, Lisp_Type_Char, Qcharacterp) @@ -1813,19 +1822,23 @@ #ifdef ERROR_CHECK_TYPECHECK -INLINE_HEADER EMACS_INT XINT (Lisp_Object obj); +#define XCHAR_OR_INT(x) XCHAR_OR_INT_1 (x, __FILE__, __LINE__) +#define XINT(x) XINT_1 (x, __FILE__, __LINE__) + +INLINE_HEADER EMACS_INT XINT_1 (Lisp_Object obj, const char *file, int line); INLINE_HEADER EMACS_INT -XINT (Lisp_Object obj) +XINT_1 (Lisp_Object obj, const char *file, int line) { - assert (INTP (obj)); + assert_at_line (INTP (obj), file, line); return XREALINT (obj); } -INLINE_HEADER EMACS_INT XCHAR_OR_INT (Lisp_Object obj); +INLINE_HEADER EMACS_INT XCHAR_OR_INT_1 (Lisp_Object obj, const char *file, + int line); INLINE_HEADER EMACS_INT -XCHAR_OR_INT (Lisp_Object obj) +XCHAR_OR_INT_1 (Lisp_Object obj, const char *file, int line) { - assert (INTP (obj) || CHARP (obj)); + assert_at_line (INTP (obj) || CHARP (obj), file, line); return CHARP (obj) ? XCHAR (obj) : XINT (obj); }
--- a/src/lrecord.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/lrecord.h Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,6 @@ /* The "lrecord" structure (header of a compound lisp object). Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996, 2001 Ben Wing. + Copyright (C) 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -750,44 +750,46 @@ #ifdef ERROR_CHECK_TYPECHECK -# define DECLARE_LRECORD(c_name, structtype) \ -extern const struct lrecord_implementation lrecord_##c_name; \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj); \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj) \ -{ \ - assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \ - return (structtype *) XPNTR (obj); \ -} \ +# define DECLARE_LRECORD(c_name, structtype) \ +extern const struct lrecord_implementation lrecord_##c_name; \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line); \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +{ \ + assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ + return (structtype *) XPNTR (obj); \ +} \ extern Lisp_Object Q##c_name##p -# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ -extern int lrecord_type_##c_name; \ -extern struct lrecord_implementation lrecord_##c_name; \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj); \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj) \ -{ \ - assert (RECORD_TYPEP (obj, lrecord_type_##c_name)); \ - return (structtype *) XPNTR (obj); \ -} \ +# define DECLARE_EXTERNAL_LRECORD(c_name, structtype) \ +extern int lrecord_type_##c_name; \ +extern struct lrecord_implementation lrecord_##c_name; \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line); \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +{ \ + assert_at_line (RECORD_TYPEP (obj, lrecord_type_##c_name), file, line); \ + return (structtype *) XPNTR (obj); \ +} \ extern Lisp_Object Q##c_name##p -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj); \ -INLINE_HEADER structtype * \ -error_check_##c_name (Lisp_Object obj) \ -{ \ - assert (XTYPE (obj) == type_enum); \ - return (structtype *) XPNTR (obj); \ -} \ +# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line); \ +INLINE_HEADER structtype * \ +error_check_##c_name (Lisp_Object obj, const char *file, int line) \ +{ \ + assert_at_line (XTYPE (obj) == type_enum, file, line); \ + return (structtype *) XPNTR (obj); \ +} \ extern Lisp_Object Q##c_name##p -# define XRECORD(x, c_name, structtype) error_check_##c_name (x) -# define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) +# define XRECORD(x, c_name, structtype) \ + error_check_##c_name (x, __FILE__, __LINE__) +# define XNONRECORD(x, c_name, type_enum, structtype) \ + error_check_##c_name (x, __FILE__, __LINE__) # define XSETRECORD(var, p, c_name) do \ { \ @@ -795,17 +797,19 @@ assert (RECORD_TYPEP (var, lrecord_type_##c_name)); \ } while (0) -INLINE_HEADER Lisp_Object wrap_record_1 (void *ptr, enum lrecord_type ty); +INLINE_HEADER Lisp_Object wrap_record_1 (void *ptr, enum lrecord_type ty, + const char *file, int line); INLINE_HEADER Lisp_Object -wrap_record_1 (void *ptr, enum lrecord_type ty) +wrap_record_1 (void *ptr, enum lrecord_type ty, const char *file, int line) { Lisp_Object obj; XSETOBJ (obj, ptr); - assert (RECORD_TYPEP (obj, ty)); + assert_at_line (RECORD_TYPEP (obj, ty), file, line); return obj; } -#define wrap_record(ptr, ty) wrap_record_1 (ptr, lrecord_type_##ty) +#define wrap_record(ptr, ty) \ + wrap_record_1 (ptr, lrecord_type_##ty, __FILE__, __LINE__) #else /* not ERROR_CHECK_TYPECHECK */
--- a/src/lstream.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/lstream.c Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* Generic stream implementation. Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001 Ben Wing. + Copyright (C) 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -1491,6 +1491,13 @@ return RESIZING_BUFFER_STREAM_DATA (stream)->buf; } +Lisp_Object +resizing_buffer_to_lisp_string (Lstream *stream) +{ + return make_string (resizing_buffer_stream_ptr (stream), + Lstream_byte_count (stream)); +} + /*********** write to an unsigned-char dynarr ***********/ /* Note: If you have a dynarr whose type is not unsigned_char_dynarr
--- a/src/lstream.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/lstream.h Thu Mar 21 07:31:30 2002 +0000 @@ -1,6 +1,6 @@ /* Generic stream implementation -- header file. Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1996, 2001 Ben Wing. + Copyright (C) 1996, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -445,6 +445,7 @@ unsigned char *fixed_buffer_output_stream_ptr (Lstream *stream); Lisp_Object make_resizing_buffer_output_stream (void); unsigned char *resizing_buffer_stream_ptr (Lstream *stream); +Lisp_Object resizing_buffer_to_lisp_string (Lstream *stream); Lisp_Object make_dynarr_output_stream (unsigned_char_dynarr *dyn); #define LSTR_SELECTIVE 1 #define LSTR_IGNORE_ACCESSIBLE 2
--- a/src/mule-charset.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/mule-charset.c Thu Mar 21 07:31:30 2002 +0000 @@ -324,6 +324,17 @@ /* Basic charset Lisp functions */ /************************************************************************/ +void +get_charset_limits (Lisp_Object charset, int *low, int *high) +{ + Lisp_Charset *cs = XCHARSET (charset); + + if (EQ (charset, Vcharset_ascii)) *low = 0, *high = 127; + else if (EQ (charset, Vcharset_control_1)) *low = 0, *high = 31; + else if (CHARSET_CHARS (cs) == 94) *low = 33, *high = 126; + else /* CHARSET_CHARS (cs) == 96) */ *low = 32, *high = 127; +} + DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /* Return non-nil if OBJECT is a charset. */
--- a/src/objects-gtk.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/objects-gtk.c Thu Mar 21 07:31:30 2002 +0000 @@ -499,7 +499,7 @@ names = XListFonts (GDK_DISPLAY (), patternext, MAX_FONT_COUNT, &count); - /* ### This code seems awfully bogus -- mrb */ + /* #### This code seems awfully bogus -- mrb */ for (i = 0; i < count; i ++) { const Intbyte *intname;
--- a/src/objects-msw.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/objects-msw.c Thu Mar 21 07:31:30 2002 +0000 @@ -2,7 +2,7 @@ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems. - Copyright (C) 1995, 1996, 2000, 2001 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1997 Jonathan Harris. @@ -38,14 +38,15 @@ #include <config.h> #include "lisp.h" -#include "hash.h" #include "console-msw.h" #include "objects-msw.h" #include "buffer.h" #include "charset.h" #include "device.h" +#include "elhash.h" #include "insdel.h" +#include "opaque.h" typedef struct colormap_t { @@ -775,6 +776,139 @@ {"OEM/DOS" , OEM_CHARSET} }; +#ifdef MULE + +typedef struct unicode_subrange_raw_t +{ + int subrange_bit; + int start; /* first Unicode codepoint */ + int end; /* last Unicode codepoint */ +} unicode_subrange_raw_t; + +/* This table comes from MSDN, Unicode Subset Bitfields [Platform SDK + Documentation, Base Services, International Features, Unicode and + Character Sets, Unicode and Character Set Reference, Unicode and + Character Set Constants]. We preprocess it at startup time into an + array of unicode_subrange_t. + */ + +static const unicode_subrange_raw_t unicode_subrange_raw_map[] = +{ + {0, 0x0020, 0x007e}, /* Basic Latin */ + {1, 0x00a0, 0x00ff}, /* Latin-1 Supplement */ + {2, 0x0100, 0x017f}, /* Latin Extended-A */ + {3, 0x0180, 0x024f}, /* Latin Extended-B */ + {4, 0x0250, 0x02af}, /* IPA Extensions */ + {5, 0x02b0, 0x02ff}, /* Spacing Modifier Letters */ + {6, 0x0300, 0x036f}, /* Combining Diacritical Marks */ + {7, 0x0370, 0x03ff}, /* Basic Greek */ + /* 8 Reserved */ + {9, 0x0400, 0x04ff}, /* Cyrillic */ + {10, 0x0530, 0x058f}, /* Armenian */ + {11, 0x0590, 0x05ff}, /* Basic Hebrew */ + /* 12 Reserved */ + {13, 0x0600, 0x06ff}, /* Basic Arabic */ + /* 14 Reserved */ + {15, 0x0900, 0x097f}, /* Devanagari */ + {16, 0x0980, 0x09ff}, /* Bengali */ + {17, 0x0a00, 0x0a7f}, /* Gurmukhi */ + {18, 0x0a80, 0x0aff}, /* Gujarati */ + {19, 0x0b00, 0x0b7f}, /* Oriya */ + {20, 0x0b80, 0x0bff}, /* Tamil */ + {21, 0x0c00, 0x0c7f}, /* Telugu */ + {22, 0x0c80, 0x0cff}, /* Kannada */ + {23, 0x0d00, 0x0d7f}, /* Malayalam */ + {24, 0x0e00, 0x0e7f}, /* Thai */ + {25, 0x0e80, 0x0eff}, /* Lao */ + {26, 0x10a0, 0x10ff}, /* Basic Georgian */ + /* 27 Reserved */ + {28, 0x1100, 0x11ff}, /* Hangul Jamo */ + {29, 0x1e00, 0x1eff}, /* Latin Extended Additional */ + {30, 0x1f00, 0x1fff}, /* Greek Extended */ + {31, 0x2000, 0x206f}, /* General Punctuation */ + {32, 0x2070, 0x209f}, /* Subscripts and Superscripts */ + {33, 0x20a0, 0x20cf}, /* Currency Symbols */ + {34, 0x20d0, 0x20ff}, /* Combining Diacritical Marks for Symbols */ + {35, 0x2100, 0x214f}, /* Letter-like Symbols */ + {36, 0x2150, 0x218f}, /* Number Forms */ + {37, 0x2190, 0x21ff}, /* Arrows */ + {38, 0x2200, 0x22ff}, /* Mathematical Operators */ + {39, 0x2300, 0x23ff}, /* Miscellaneous Technical */ + {40, 0x2400, 0x243f}, /* Control Pictures */ + {41, 0x2440, 0x245f}, /* Optical Character Recognition */ + {42, 0x2460, 0x24ff}, /* Enclosed Alphanumerics */ + {43, 0x2500, 0x257f}, /* Box Drawing */ + {44, 0x2580, 0x259f}, /* Block Elements */ + {45, 0x25a0, 0x25ff}, /* Geometric Shapes */ + {46, 0x2600, 0x26ff}, /* Miscellaneous Symbols */ + {47, 0x2700, 0x27bf}, /* Dingbats */ + {48, 0x3000, 0x303f}, /* Chinese, Japanese, and Korean (CJK) Symbols and Punctuation */ + {49, 0x3040, 0x309f}, /* Hiragana */ + {50, 0x30a0, 0x30ff}, /* Katakana */ + {51, 0x3100, 0x312f}, /* Bopomofo */ + {51, 0x31a0, 0x31bf}, /* Extended Bopomofo */ + {52, 0x3130, 0x318f}, /* Hangul Compatibility Jamo */ + {53, 0x3190, 0x319f}, /* CJK Miscellaneous */ + {54, 0x3200, 0x32ff}, /* Enclosed CJK Letters and Months */ + {55, 0x3300, 0x33ff}, /* CJK Compatibility */ + {56, 0xac00, 0xd7a3}, /* Hangul */ + {57, 0xd800, 0xdfff}, /* Surrogates. Note that setting this bit implies that there is at least one codepoint beyond the Basic Multilingual Plane that is supported by this font. */ + /* 58 Reserved */ + {59, 0x4e00, 0x9fff}, /* CJK Unified Ideographs */ + {59, 0x2e80, 0x2eff}, /* CJK Radicals Supplement */ + {59, 0x2f00, 0x2fdf}, /* Kangxi Radicals */ + {59, 0x2ff0, 0x2fff}, /* Ideographic Description */ + {59, 0x3400, 0x4dbf}, /* CJK Unified Ideograph Extension A */ + {60, 0xe000, 0xf8ff}, /* Private Use Area */ + {61, 0xf900, 0xfaff}, /* CJK Compatibility Ideographs */ + {62, 0xfb00, 0xfb4f}, /* Alphabetic Presentation Forms */ + {63, 0xfb50, 0xfdff}, /* Arabic Presentation Forms-A */ + {64, 0xfe20, 0xfe2f}, /* Combining Half Marks */ + {65, 0xfe30, 0xfe4f}, /* CJK Compatibility Forms */ + {66, 0xfe50, 0xfe6f}, /* Small Form Variants */ + {67, 0xfe70, 0xfefe}, /* Arabic Presentation Forms-B */ + {68, 0xff00, 0xffef}, /* Halfwidth and Fullwidth Forms */ + {69, 0xfff0, 0xfffd}, /* Specials */ + {70, 0x0f00, 0x0fcf}, /* Tibetan */ + {71, 0x0700, 0x074f}, /* Syriac */ + {72, 0x0780, 0x07bf}, /* Thaana */ + {73, 0x0d80, 0x0dff}, /* Sinhala */ + {74, 0x1000, 0x109f}, /* Myanmar */ + {75, 0x1200, 0x12bf}, /* Ethiopic */ + {76, 0x13a0, 0x13ff}, /* Cherokee */ + {77, 0x1400, 0x14df}, /* Canadian Aboriginal Syllabics */ + {78, 0x1680, 0x169f}, /* Ogham */ + {79, 0x16a0, 0x16ff}, /* Runic */ + {80, 0x1780, 0x17ff}, /* Khmer */ + {81, 0x1800, 0x18af}, /* Mongolian */ + {82, 0x2800, 0x28ff}, /* Braille */ + {83, 0xa000, 0xa48c}, /* Yi, Yi Radicals */ + /* 84-122 Reserved */ + /* 123 Windows 2000/XP: Layout progress: horizontal from right to left */ + /* 124 Windows 2000/XP: Layout progress: vertical before horizontal */ + /* 125 Windows 2000/XP: Layout progress: vertical bottom to top */ + /* 126 Reserved; must be 0 */ + /* 127 Reserved; must be 1 */ +}; + +typedef struct unicode_subrange_t +{ + int no_subranges; + const unicode_subrange_raw_t *subranges; +} unicode_subrange_t; + +unicode_subrange_t *unicode_subrange_table; + +/* Hash table mapping font specs (strings) to font signature data + (FONTSIGNATURE structures stored in opaques), as determined by + GetTextCharsetInfo(). I presume this is somewhat expensive because it + involves creating a font object. At the very least, with no hashing, it + definitely took awhile (a few seconds) when encountering characters from + charsets needing stage 2 processing. */ +Lisp_Object Vfont_signature_data; + +#endif /* MULE */ + /************************************************************************/ /* helpers */ @@ -1187,14 +1321,12 @@ static void mswindows_finalize_font_instance (Lisp_Font_Instance *f); -/* - * This is a work horse for both mswindows_initialize_font_instance and - * msprinter_initialize_font_instance. - */ -static int -initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, - Lisp_Object device_font_list, HDC hdc, - Error_Behavior errb) +static HFONT +create_hfont_from_font_spec (const Intbyte *namestr, + HDC hdc, + Lisp_Object name_for_errors, + Lisp_Object device_font_list, + Error_Behavior errb) { LOGFONTW logfont; int fields, i; @@ -1202,9 +1334,7 @@ Intbyte fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8]; Intbyte effects[LF_FACESIZE], charset[LF_FACESIZE]; Intbyte *c; - HFONT hfont, hfont2; - TEXTMETRICW metrics; - Intbyte *namestr = XSTRING_DATA (name); + HFONT hfont; /* * mswindows fonts look like: @@ -1230,9 +1360,9 @@ if (fields < 0) { - maybe_signal_error (Qinvalid_argument, "Invalid font", name, + maybe_signal_error (Qinvalid_argument, "Invalid font", name_for_errors, Qfont, errb); - return (0); + return NULL; } if (fields > 0 && qxestrlen (fontname)) @@ -1246,8 +1376,8 @@ else { maybe_signal_error (Qinvalid_argument, "Must specify a font name", - name, Qfont, errb); - return (0); + name_for_errors, Qfont, errb); + return NULL; } /* weight */ @@ -1278,9 +1408,9 @@ } else { - maybe_signal_error (Qinvalid_constant, "Invalid font weight", name, - Qfont, errb); - return (0); + maybe_signal_error (Qinvalid_constant, "Invalid font weight", + name_for_errors, Qfont, errb); + return NULL; } } @@ -1290,10 +1420,11 @@ if (qxestrcasecmp_c (style, "italic") == 0) logfont.lfItalic = TRUE; else - { - maybe_signal_error (Qinvalid_constant, "Invalid font weight or style", - name, Qfont, errb); - return (0); + { + maybe_signal_error (Qinvalid_constant, + "Invalid font weight or style", + name_for_errors, Qfont, errb); + return NULL; } /* Glue weight and style together again */ @@ -1307,9 +1438,9 @@ pt = 10; /* #### Should we reject strings that don't specify a size? */ else if ((pt = qxeatoi (points)) == 0) { - maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", name, - Qfont, errb); - return (0); + maybe_signal_error (Qinvalid_argument, "Invalid font pointsize", + name_for_errors, Qfont, errb); + return NULL; } /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */ @@ -1338,9 +1469,9 @@ logfont.lfStrikeOut = TRUE; else { - maybe_signal_error (Qinvalid_constant, "Invalid font effect", name, - Qfont, errb); - return (0); + maybe_signal_error (Qinvalid_constant, "Invalid font effect", + name_for_errors, Qfont, errb); + return NULL; } if (effects2 && effects2[0] != '\0') @@ -1352,8 +1483,8 @@ else { maybe_signal_error (Qinvalid_constant, "Invalid font effect", - name, Qfont, errb); - return (0); + name_for_errors, Qfont, errb); + return NULL; } } @@ -1394,9 +1525,9 @@ if (i == countof (charset_map)) /* No matching charset */ { - maybe_signal_error (Qinvalid_argument, "Invalid charset", name, Qfont, - errb); - return 0; + maybe_signal_error (Qinvalid_argument, "Invalid charset", + name_for_errors, Qfont, errb); + return NULL; } /* Misc crud */ @@ -1434,18 +1565,38 @@ } if (NILP (fonttail)) { - maybe_signal_error (Qinvalid_argument, "No matching font", name, - Qfont, errb); - return 0; + maybe_signal_error (Qinvalid_argument, "No matching font", + name_for_errors, Qfont, errb); + return NULL; } } if ((hfont = qxeCreateFontIndirect (&logfont)) == NULL) - { - maybe_signal_error (Qgui_error, "Couldn't create font", name, Qfont, errb); - return 0; - } + { + maybe_signal_error (Qgui_error, "Couldn't create font", + name_for_errors, Qfont, errb); + return NULL; + } + + return hfont; +} + +/* + * This is a work horse for both mswindows_initialize_font_instance and + * msprinter_initialize_font_instance. + */ +static int +initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, + Lisp_Object device_font_list, HDC hdc, + Error_Behavior errb) +{ + HFONT hfont, hfont2; + TEXTMETRICW metrics; + Intbyte *namestr = XSTRING_DATA (name); + + hfont = create_hfont_from_font_spec (namestr, hdc, name, device_font_list, + errb); f->data = xnew_and_zero (struct mswindows_font_instance_data); FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0) = hfont; @@ -1612,45 +1763,18 @@ #ifdef MULE static int -mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, - const Intbyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, Bytecount length) +mswindows_font_spec_matches_charset_stage_1 (const Intbyte *font_charset, + Lisp_Object charset) { - const Intbyte *the_nonreloc = nonreloc; int i, ms_charset = 0; - const Intbyte *c; - Bytecount the_length = length; CHARSETINFO info; int font_code_page; Lisp_Object charset_code_page; - if (UNBOUNDP (charset)) - return 1; - - if (!the_nonreloc) - the_nonreloc = XSTRING_DATA (reloc); - fixup_internal_substring (nonreloc, reloc, offset, &the_length); - the_nonreloc += offset; - /* Get code page from the font spec */ - c = the_nonreloc; - for (i = 0; i < 4; i++) - { - Intbyte *newc = (Intbyte *) memchr (c, ':', the_length); - if (!newc) - break; - newc++; - the_length -= (newc - c); - c = newc; - } - - if (i < 4) - return 0; - for (i = 0; i < countof (charset_map); i++) - if (qxestrcasecmp_c (c, charset_map[i].name) == 0) + if (qxestrcasecmp_c (font_charset, charset_map[i].name) == 0) { ms_charset = charset_map[i].value; break; @@ -1675,6 +1799,151 @@ return font_code_page == XINT (charset_code_page); } +static int +mswindows_font_spec_matches_charset (struct device *d, Lisp_Object charset, + const Intbyte *nonreloc, + Lisp_Object reloc, + Bytecount offset, Bytecount length) +{ + const Intbyte *the_nonreloc = nonreloc; + int i; + const Intbyte *c; + Bytecount the_length = length; + +/* The idea is that, when trying to find a suitable font for a character, + we first see if the character comes from one of the known charsets + listed above; if so, we try to find a font which is declared as being of + that charset (that's the last element of the font spec). If so, this + means that the font is specifically designed for the charset, and we + prefer it. However, there are only a limited number of defined + charsets, and new ones aren't being defined; so if we fail the first + stage, we search through each font looking at the Unicode subranges it + supports, to see if the character comes from that subrange. +*/ + + if (UNBOUNDP (charset)) + return 1; + + if (!the_nonreloc) + the_nonreloc = XSTRING_DATA (reloc); + fixup_internal_substring (nonreloc, reloc, offset, &the_length); + the_nonreloc += offset; + + c = the_nonreloc; + for (i = 0; i < 4; i++) + { + Intbyte *newc = (Intbyte *) memchr (c, ':', the_length); + if (!newc) + break; + newc++; + the_length -= (newc - c); + c = newc; + } + + if (i >= 4 && mswindows_font_spec_matches_charset_stage_1 (c, charset)) + return 1; + + /* Stage 2. */ + { + FONTSIGNATURE fs; + FONTSIGNATURE *fsp = &fs; + struct gcpro gcpro1; + Lisp_Object fontsig; + + /* Get the list of Unicode subranges corresponding to the font. This + is contained inside of FONTSIGNATURE data, obtained by calling + GetTextCharsetInfo on a font object, which we need to create from the + spec. See if the FONTSIGNATURE data is already cached. If not, get + it and cache it. */ + if (!STRINGP (reloc) || the_nonreloc != XSTRING_DATA (reloc)) + reloc = build_intstring (the_nonreloc); + GCPRO1 (reloc); + fontsig = Fgethash (reloc, Vfont_signature_data, Qunbound); + + if (!UNBOUNDP (fontsig)) + { + fsp = (FONTSIGNATURE *) XOPAQUE_DATA (fontsig); + UNGCPRO; + } + else + { + HDC hdc = CreateCompatibleDC (NULL); + Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (d); + HFONT hfont = create_hfont_from_font_spec (the_nonreloc, hdc, Qnil, + font_list, ERROR_ME_NOT); + + if (!hfont || !(hfont = (HFONT) SelectObject (hdc, hfont))) + { + nope: + DeleteDC (hdc); + UNGCPRO; + return 0; + } + + if (GetTextCharsetInfo (hdc, &fs, 0) == DEFAULT_CHARSET) + { + SelectObject (hdc, hfont); + goto nope; + } + SelectObject (hdc, hfont); + DeleteDC (hdc); + Fputhash (reloc, make_opaque (&fs, sizeof (fs)), Vfont_signature_data); + UNGCPRO; + } + + { + int lowlim, highlim; + int dim, j, cp = -1; + + /* Try to find a Unicode char in the charset. #### This is somewhat + bogus. We should really be doing these checks on the char level, + not the charset level. There's no guarantee that a charset covers + a single Unicode range. Furthermore, this is extremely wasteful. + We should be doing this when we're about to redisplay and already + have the Unicode codepoints in hand. + + #### Cache me baby!!!!!!!!!!!!! + */ + get_charset_limits (charset, &lowlim, &highlim); + dim = XCHARSET_DIMENSION (charset); + + if (dim == 1) + { + for (i = lowlim; i <= highlim; i++) + if ((cp = char_to_unicode (MAKE_CHAR (charset, i, 0))) >= 0) + break; + } + else + { + for (i = lowlim; i <= highlim; i++) + for (j = lowlim; j <= highlim; j++) + if ((cp = char_to_unicode (MAKE_CHAR (charset, i, j))) >= 0) + break; + } + + if (cp < 0) + return 0; + + /* Check to see, for each subrange supported by the font, + whether the Unicode char is within that subrange. If any match, + the font supports the char (whereby, the charset, bogusly). */ + + for (i = 0; i < 128; i++) + { + if (fsp->fsUsb[i >> 5] & (1 << (i & 32))) + { + for (j = 0; j < unicode_subrange_table[i].no_subranges; j++) + if (cp >= unicode_subrange_table[i].subranges[j].start && + cp <= unicode_subrange_table[i].subranges[j].end) + return 1; + } + } + + return 0; + } + } +} + /* find a font spec that matches font spec FONT and also matches (the registry of) CHARSET. */ static Lisp_Object @@ -1775,6 +2044,32 @@ } void +reinit_vars_of_object_mswindows (void) +{ +#ifdef MULE + int i; + + unicode_subrange_table = xnew_array_and_zero (unicode_subrange_t, 128); + for (i = 0; i < countof (unicode_subrange_raw_map); i++) + { + const unicode_subrange_raw_t *el = &unicode_subrange_raw_map[i]; + if (unicode_subrange_table[el->subrange_bit].subranges == 0) + unicode_subrange_table[el->subrange_bit].subranges = el; + unicode_subrange_table[el->subrange_bit].no_subranges++; + } + + Fclrhash (Vfont_signature_data); +#endif /* MULE */ +} + +void vars_of_objects_mswindows (void) { +#ifdef MULE + Vfont_signature_data = + make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + staticpro (&Vfont_signature_data); +#endif /* MULE */ + + reinit_vars_of_object_mswindows (); }
--- a/src/symsinit.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/symsinit.h Thu Mar 21 07:31:30 2002 +0000 @@ -378,6 +378,7 @@ void reinit_vars_of_objects (void); void vars_of_objects_tty (void); void vars_of_objects_mswindows (void); +void reinit_vars_of_object_mswindows (void); void vars_of_objects_x (void); void vars_of_print (void); void reinit_vars_of_print (void);
--- a/src/text.c Wed Mar 20 10:21:23 2002 +0000 +++ b/src/text.c Thu Mar 21 07:31:30 2002 +0000 @@ -3123,10 +3123,7 @@ charset = Fget_charset (charset); cs = XCHARSET (charset); - if (EQ (charset, Vcharset_ascii)) lowlim = 0, highlim = 127; - else if (EQ (charset, Vcharset_control_1)) lowlim = 0, highlim = 31; - else if (CHARSET_CHARS (cs) == 94) lowlim = 33, highlim = 126; - else /* CHARSET_CHARS (cs) == 96) */ lowlim = 32, highlim = 127; + get_charset_limits (charset, &lowlim, &highlim); CHECK_INT (arg1); /* It is useful (and safe, according to Olivier Galibert) to strip
--- a/src/text.h Wed Mar 20 10:21:23 2002 +0000 +++ b/src/text.h Thu Mar 21 07:31:30 2002 +0000 @@ -1,7 +1,7 @@ /* Header file for text manipulation primitives and macros. Copyright (C) 1985-1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001 Ben Wing. + Copyright (C) 2000, 2001, 2002 Ben Wing. This file is part of XEmacs. @@ -82,14 +82,27 @@ extern const Bytecount rep_bytes_by_first_byte[0xA0]; /* Number of bytes in the string representation of a character. */ -INLINE_HEADER int REP_BYTES_BY_FIRST_BYTE (int fb); + +#ifdef ERROR_CHECK_TYPECHECK + +INLINE_HEADER int REP_BYTES_BY_FIRST_BYTE_1 (int fb, const char *file, + int line); INLINE_HEADER int -REP_BYTES_BY_FIRST_BYTE (int fb) +REP_BYTES_BY_FIRST_BYTE_1 (int fb, const char *file, int line) { - type_checking_assert (fb < 0xA0); + assert_at_line (fb < 0xA0, file, line); return rep_bytes_by_first_byte[fb]; } +#define REP_BYTES_BY_FIRST_BYTE(fb) \ + REP_BYTES_BY_FIRST_BYTE_1 (fb, __FILE__, __LINE__) + +#else /* ERROR_CHECK_TYPECHECK */ + +#define REP_BYTES_BY_FIRST_BYTE(fb) (rep_bytes_by_first_byte[fb]) + +#endif /* ERROR_CHECK_TYPECHECK */ + /* Is this character represented by more than one byte in a string? */ #define CHAR_MULTIBYTE_P(c) ((c) >= 0x80)