Mercurial > hg > xemacs-beta

changeset 4598:8891b0477058

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 04 Feb 2009 12:35:45 +0000
parents 4fc32a3a086e (current diff) 7191a7b120f1 (diff)
children 0347879667ed
files lisp/ChangeLog lisp/coding.el
diffstat 3 files changed, 76 insertions(+), 95 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Feb 04 12:14:38 2009 +0000
+++ b/lisp/ChangeLog	Wed Feb 04 12:35:45 2009 +0000
@@ -1,3 +1,17 @@
+2009-01-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* coding.el (force-coding-system-equivalency):
+	Move three functions that we don't want to advertise to being
+	anonymous lambdas instead.
+	* glyphs.el :
+	Remove #'define-constant-glyph and some functions it uses, replace
+	the latter with anonymous lambdas and the former and its uses with
+	a call to loop.
+	Do the same with #'define-obsolete-pointer-glyph and the functions
+	it uses.
+	(init-glyphs): Untern this symbol once the associated function has
+	been called; it's only needed at dump time, not at runtime.
+
 2009-02-04  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* coding.el (query-coding-region): 
--- a/lisp/coding.el	Wed Feb 04 12:14:38 2009 +0000
+++ b/lisp/coding.el	Wed Feb 04 12:35:45 2009 +0000
@@ -243,30 +243,24 @@
 	)))
 
 
-;;; Make certain variables equivalent to coding-system aliases
-(defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers)
-  (define-coding-system-alias 'file-name (or (car args) 'binary)))
-
-(dontusethis-set-symbol-value-handler
- 'file-name-coding-system
- 'set-value
- 'dontusethis-set-value-file-name-coding-system-handler)
-
-(defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers)
-  (define-coding-system-alias 'terminal (or (car args) 'binary)))
-
-(dontusethis-set-symbol-value-handler
- 'terminal-coding-system
- 'set-value
- 'dontusethis-set-value-terminal-coding-system-handler)
-
-(defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers)
-  (define-coding-system-alias 'keyboard (or (car args) 'binary)))
-
-(dontusethis-set-symbol-value-handler
- 'keyboard-coding-system
- 'set-value
- 'dontusethis-set-value-keyboard-coding-system-handler)
+;;; Make certain variables equivalent to coding-system aliases:
+(macrolet
+    ((force-coding-system-equivalency (&rest details-list)
+       (loop for (alias variable-symbol)
+         in details-list
+         with result = (list 'progn)
+         do
+         (push 
+          `(dontusethis-set-symbol-value-handler ',variable-symbol
+            'set-value #'(lambda (sym args fun harg handlers)
+                           (define-coding-system-alias ',alias
+                             (or (car args) 'binary))))
+          result)
+         finally return (nreverse result))))
+  (force-coding-system-equivalency
+   (file-name file-name-coding-system)
+   (terminal terminal-coding-system)
+   (keyboard keyboard-coding-system)))
 
 (when (not (featurep 'mule))
   (define-coding-system-alias 'escape-quoted 'binary)
--- a/lisp/glyphs.el	Wed Feb 04 12:14:38 2009 +0000
+++ b/lisp/glyphs.el	Wed Feb 04 12:35:45 2009 +0000
@@ -1084,83 +1084,53 @@
 (set-glyph-face gc-pointer-glyph 'pointer)
 
 ;; Now add the magic access/set behavior.
-
-(defun dontusethis-set-value-glyph-handler (sym args fun harg handler)
-  (error "Use `set-glyph-image' to set `%s'" sym))
-(defun dontusethis-make-unbound-glyph-handler (sym args fun harg handler)
-  (error "Can't `makunbound' `%s'" sym))
-(defun dontusethis-make-local-glyph-handler (sym args fun harg handler)
-  (error "Use `set-glyph-image' to make local values for `%s'" sym))
-
-(defun define-constant-glyph (sym)
-  (dontusethis-set-symbol-value-handler
-   sym 'set-value
-   'dontusethis-set-value-glyph-handler)
-  (dontusethis-set-symbol-value-handler
-   sym 'make-unbound
-   'dontusethis-make-unbound-glyph-handler)
-  (dontusethis-set-symbol-value-handler
-   sym 'make-local
-   'dontusethis-make-local-glyph-handler)
-  ;; Make frame properties magically work with glyph variables.
+(loop
+  for sym in '(define-constant-glyphs text-pointer-glyph nontext-pointer-glyph
+               modeline-pointer-glyph selection-pointer-glyph
+               busy-pointer-glyph gc-pointer-glyph divider-pointer-glyph
+               toolbar-pointer-glyph menubar-pointer-glyph
+               scrollbar-pointer-glyph octal-escape-glyph
+               control-arrow-glyph invisible-text-glyph hscroll-glyph
+               truncation-glyph continuation-glyph frame-icon-glyph)
+  with set-value-handler = #'(lambda (sym args fun harg handler)
+                               (error 'invalid-change
+                                      (format
+                                       "Use `set-glyph-image' to set `%s'"
+                                       sym)))
+  with make-unbound-handler = #'(lambda (sym args fun harg handler)
+                                  (error 'invalid-change
+                                         (format
+                                          "Can't `makunbound' `%s'" sym)))
+  with make-local-handler =
+       #'(lambda (sym args fun harg handler)
+           (error 'invalid-change
+            (format "Use `set-glyph-image' to make local values for `%s'" sym)))
+  do
+  (dontusethis-set-symbol-value-handler sym 'set-value set-value-handler)
+  (dontusethis-set-symbol-value-handler sym 'make-unbound make-unbound-handler)
+  (dontusethis-set-symbol-value-handler sym 'make-local make-local-handler)
   (put sym 'const-glyph-variable t))
 
-(define-constant-glyph 'text-pointer-glyph)
-(define-constant-glyph 'nontext-pointer-glyph)
-(define-constant-glyph 'modeline-pointer-glyph)
-(define-constant-glyph 'selection-pointer-glyph)
-(define-constant-glyph 'busy-pointer-glyph)
-(define-constant-glyph 'gc-pointer-glyph)
-(define-constant-glyph 'divider-pointer-glyph)
-(define-constant-glyph 'toolbar-pointer-glyph)
-(define-constant-glyph 'menubar-pointer-glyph)
-(define-constant-glyph 'scrollbar-pointer-glyph)
-
-(define-constant-glyph 'octal-escape-glyph)
-(define-constant-glyph 'control-arrow-glyph)
-(define-constant-glyph 'invisible-text-glyph)
-(define-constant-glyph 'hscroll-glyph)
-(define-constant-glyph 'truncation-glyph)
-(define-constant-glyph 'continuation-glyph)
-
-(define-constant-glyph 'frame-icon-glyph)
-
 ;; backwards compatibility garbage
 
-(defun dontusethis-old-pointer-shape-handler (sym args fun harg handler)
-  (let ((value (car args)))
-    (if (null value)
-	(remove-specifier harg 'global)
-      (set-glyph-image (symbol-value harg) value))))
-
 ;; It might or might not be garbage, but it's rude.  Make these
 ;; `compatible' instead of `obsolete'.  -slb
-(defun define-obsolete-pointer-glyph (old new)
+(loop
+  for (old new) in '((x-pointer-shape text-pointer-glyph)
+                     (x-nontext-pointer-shape nontext-pointer-glyph)
+                     (x-mode-pointer-shape modeline-pointer-glyph)
+                     (x-selection-pointer-shape selection-pointer-glyph)
+                     (x-busy-pointer-shape busy-pointer-glyph)
+                     (x-gc-pointer-shape gc-pointer-glyph)
+                     (x-toolbar-pointer-shape toolbar-pointer-glyph))
+  with set-handler = #'(lambda (sym args fun harg handler)
+                         (let ((value (car args)))
+                           (if (null value)
+                               (remove-specifier harg 'global)
+                             (set-glyph-image (symbol-value harg) value))))
+  do
   (define-compatible-variable-alias old new)
-  (dontusethis-set-symbol-value-handler
-   old 'set-value 'dontusethis-old-pointer-shape-handler new))
-
-;;; (defvar x-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph)
-
-;;; (defvar x-nontext-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph)
-
-;;; (defvar x-mode-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph)
-
-;;; (defvar x-selection-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-selection-pointer-shape
-  'selection-pointer-glyph)
-
-;;; (defvar x-busy-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph)
-
-;;; (defvar x-gc-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph)
-
-;;; (defvar x-toolbar-pointer-shape nil)
-(define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph)
+  (dontusethis-set-symbol-value-handler old 'set-value set-handler))
 
 ;; for subwindows
 (defalias 'subwindow-xid 'image-instance-subwindow-id)
@@ -1267,4 +1237,7 @@
 
 (init-glyphs)
 
-;;; glyphs.el ends here.
+(unintern 'init-glyphs) ;; This was dump time thing, no need to keep the
+			;; function around.
+
+;;; glyphs.el ends here.
\ No newline at end of file