# HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1232047303 0 # Node ID 7191a7b120f129618f64efa567ee6b1bf746a900 # Parent 774e5c7522bf0681f0ecf0ab015d9ec8dcb35486 Some cosmetic namespace cleanup, glyphs.el, coding.el. lisp/ChangeLog addition: 2009-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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 function it uses. (init-glyphs): Untern this symbol once the associated function has been called; it's only needed at dump time, not at runtime. diff -r 774e5c7522bf -r 7191a7b120f1 lisp/ChangeLog --- a/lisp/ChangeLog Tue Jan 13 12:07:27 2009 +0000 +++ b/lisp/ChangeLog Thu Jan 15 19:21:43 2009 +0000 ＠＠ -1,3 +1,17 ＠＠ +2009-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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-01-13 Aidan Kehoe <kehoea(a)parhasard.net&gt; * mule/mule-cmds.el (set-language-environment-coding-systems): diff -r 774e5c7522bf -r 7191a7b120f1 lisp/coding.el --- a/lisp/coding.el Tue Jan 13 12:07:27 2009 +0000 +++ b/lisp/coding.el Thu Jan 15 19:21:43 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) diff -r 774e5c7522bf -r 7191a7b120f1 lisp/glyphs.el --- a/lisp/glyphs.el Tue Jan 13 12:07:27 2009 +0000 +++ b/lisp/glyphs.el Thu Jan 15 19:21:43 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 -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches