changeset 4369:ef9eb714f0e4

Add ascii-case-table, #'with-case-table; make iso8859-1.el more comprehensible. 2007-12-30 Aidan Kehoe <kehoea@parhasard.net> * 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 30 Dec 2007 16:18:33 +0100
parents cc293ef846d2
children b94710365f92
files lisp/ChangeLog lisp/iso8859-1.el lisp/subr.el
diffstat 3 files changed, 76 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- 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-30  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* 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@xemacs.org>
 
 	Factor out lists of operators specially treated by `make-autoload'.
--- 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.")
-
-;;; This macro expands into
-;;;  (setq iso8859/1-case-table (purecopy '("..." nil nil nil)))
-;;; doing the computation of the case table at compile-time.
+(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.")
 
-((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
- )
+(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))
 
-(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
--- 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 @@
 ; 	 . ,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.")