commit: Add ascii-case-table, #'with-case-table; make iso8859-1.el more comprehensible.

changeset: 4369:ef9eb714f0e4f7e3ce0b25501288563ec23a8d13 parent: 4356:cc293ef846d240af187a523bb32eb5e26a083531 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sun Dec 30 16:18:33 2007 +0100 files: lisp/ChangeLog lisp/iso8859-1.el lisp/subr.el description: Add ascii-case-table, #'with-case-table; make iso8859-1.el more comprehensible. 2007-12-30 Aidan Kehoe <kehoea(a)parhasard.net&gt; * subr.el (with-case-table): New. Idea and implementation taken from GNU's code of April 2007, before GPL V3 was implied. Thank you GNU. * iso8859-1.el (ascii-case-table): New. Idea taken from GNU. * iso8859-1.el : Change Jamie's implicit compile-time call to a macro literal into something comprehensible to and maintainable by mortals, using to cl.el's #'loop. * iso8859-1.el (ctl-arrow): Initialise it to something more comprehensible. diff -r cc293ef846d240af187a523bb32eb5e26a083531 -r ef9eb714f0e4f7e3ce0b25501288563ec23a8d13 lisp/ChangeLog --- a/lisp/ChangeLog Mon Dec 24 14:00:51 2007 +0100 +++ b/lisp/ChangeLog Sun Dec 30 16:18:33 2007 +0100 ＠＠ -1,3 +1,17 ＠＠ 2007-12-22 Stephen J. Turnbull <stephe +2007-12-30 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * subr.el (with-case-table): New. + Idea and implementation taken from GNU's code of April 2007, + before GPL V3 was implied. Thank you GNU. + * iso8859-1.el (ascii-case-table): New. + Idea taken from GNU. + * iso8859-1.el : + Change Jamie's implicit compile-time call to a macro literal into + something comprehensible to and maintainable by mortals, using to + cl.el's #'loop. + * iso8859-1.el (ctl-arrow): + Initialise it to something more comprehensible. + 2007-12-22 Stephen J. Turnbull <stephen(a)xemacs.org&gt; Factor out lists of operators specially treated by `make-autoload'. diff -r cc293ef846d240af187a523bb32eb5e26a083531 -r ef9eb714f0e4f7e3ce0b25501288563ec23a8d13 lisp/iso8859-1.el --- a/lisp/iso8859-1.el Mon Dec 24 14:00:51 2007 +0100 +++ b/lisp/iso8859-1.el Sun Dec 30 16:18:33 2007 +0100 ＠＠ -28,71 +28,60 ＠＠ ;;; Commentary: -;; created by jwz, 19-aug-92. ;; Sets the case table for the ISO-8859/1 character set. -;; Used to set the syntax table. +;; Provides ascii-case-table, for use in environments where multilingual +;; case-insensitive processing is inappropriate. ;;; Code: -(defconst iso8859/1-case-table nil - "The case table for ISO-8859/1 characters.") +(defvar ascii-case-table + (loop + for lower from (char-int ?a) to (char-int ?z) + and upper from (char-int ?A) to (char-int ?Z) + with table = (make-case-table) + do (put-case-table-pair (coerce lower 'character) + (coerce upper 'character) + table) + finally return table) + "Case table for the ASCII character set.") -;;; This macro expands into -;;; (setq iso8859/1-case-table (purecopy '("..." nil nil nil))) -;;; doing the computation of the case table at compile-time. +(loop + for (upper lower) + in '((?\xC0 ?\xE0) ;; A WITH GRAVE + (?\xC1 ?\xE1) ;; A WITH ACUTE + (?\xC2 ?\xE2) ;; A WITH CIRCUMFLEX + (?\xC3 ?\xE3) ;; A WITH TILDE + (?\xC4 ?\xE4) ;; A WITH DIAERESIS + (?\xC5 ?\xE5) ;; A WITH RING ABOVE + (?\xC6 ?\xE6) ;; AE + (?\xC7 ?\xE7) ;; C WITH CEDILLA + (?\xC8 ?\xE8) ;; E WITH GRAVE + (?\xC9 ?\xE9) ;; E WITH ACUTE + (?\xCA ?\xEA) ;; E WITH CIRCUMFLEX + (?\xCB ?\xEB) ;; E WITH DIAERESIS + (?\xCC ?\xEC) ;; I WITH GRAVE + (?\xCD ?\xED) ;; I WITH ACUTE + (?\xCE ?\xEE) ;; I WITH CIRCUMFLEX + (?\xCF ?\xEF) ;; I WITH DIAERESIS + (?\xD0 ?\xF0) ;; ETH + (?\xD1 ?\xF1) ;; N WITH TILDE + (?\xD2 ?\xF2) ;; O WITH GRAVE + (?\xD3 ?\xF3) ;; O WITH ACUTE + (?\xD4 ?\xF4) ;; O WITH CIRCUMFLEX + (?\xD5 ?\xF5) ;; O WITH TILDE + (?\xD6 ?\xF6) ;; O WITH DIAERESIS + (?\xD8 ?\xF8) ;; O WITH STROKE + (?\xD9 ?\xF9) ;; U WITH GRAVE + (?\xDA ?\xFA) ;; U WITH ACUTE + (?\xDB ?\xFB) ;; U WITH CIRCUMFLEX + (?\xDC ?\xFC) ;; U WITH DIAERESIS + (?\xDD ?\xFD) ;; Y WITH ACUTE + (?\xDE ?\xFE)) ;; THORN + with case-table = (standard-case-table) + do (put-case-table-pair upper lower case-table)) -((macro - . (lambda (&rest pairs) - (let ((downcase (make-string 256 0)) - (i 0)) - (while (< i 256) - (aset downcase i (if (and (>= i ?A) (<= i ?Z)) (+ i 32) i)) - (setq i (1+ i))) - (while pairs - (aset downcase (car (car pairs)) (car (cdr (car pairs)))) - (setq pairs (cdr pairs))) - (cons 'setq - (cons 'iso8859/1-case-table - (list - (list 'quote - (list downcase nil nil nil)))))))) - - (?\300 ?\340) ; Agrave - (?\301 ?\341) ; Aacute - (?\302 ?\342) ; Acircumflex - (?\303 ?\343) ; Atilde - (?\304 ?\344) ; Adiaeresis - (?\305 ?\345) ; Aring - (?\306 ?\346) ; AE - (?\307 ?\347) ; Ccedilla - (?\310 ?\350) ; Egrave - (?\311 ?\351) ; Eacute - (?\312 ?\352) ; Ecircumflex - (?\313 ?\353) ; Ediaeresis - (?\314 ?\354) ; Igrave - (?\315 ?\355) ; Iacute - (?\316 ?\356) ; Icircumflex - (?\317 ?\357) ; Idiaeresis - (?\320 ?\360) ; ETH - (?\321 ?\361) ; Ntilde - (?\322 ?\362) ; Ograve - (?\323 ?\363) ; Oacute - (?\324 ?\364) ; Ocircumflex - (?\325 ?\365) ; Otilde - (?\326 ?\366) ; Odiaeresis - (?\330 ?\370) ; Ooblique - (?\331 ?\371) ; Ugrave - (?\332 ?\372) ; Uacute - (?\333 ?\373) ; Ucircumflex - (?\334 ?\374) ; Udiaeresis - (?\335 ?\375) ; Yacute - (?\336 ?\376) ; THORN - ) - -(set-standard-case-table (mapcar 'copy-sequence iso8859/1-case-table)) - -(setq-default ctl-arrow 'iso-8859/1) - -(provide 'iso8859-1) +;; Everything Latin-1 and above should be displayed as its character value +;; by default. +(setq-default ctl-arrow #xA0) ;;; iso8859-1.el ends here diff -r cc293ef846d240af187a523bb32eb5e26a083531 -r ef9eb714f0e4f7e3ce0b25501288563ec23a8d13 lisp/subr.el --- a/lisp/subr.el Mon Dec 24 14:00:51 2007 +0100 +++ b/lisp/subr.el Sun Dec 30 16:18:33 2007 +0100 ＠＠ -579,6 +579,19 ＠＠ See also `with-temp-file' and `with-outp ; . ,body) ; (combine-after-change-execute))) +(defmacro with-case-table (table &rest body) + "Execute the forms in BODY with TABLE as the current case table. +The value returned is the value of the last form in BODY." + (declare (indent 1) (debug t)) + (let ((old-case-table (make-symbol "table")) + (old-buffer (make-symbol "buffer"))) + `(let ((,old-case-table (current-case-table)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn (set-case-table ,table) + ,＠body) + (with-current-buffer ,old-buffer + (set-case-table ,old-case-table)))))) (defvar delay-mode-hooks nil "If non-nil, `run-mode-hooks' should delay running the hooks.") _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches