Mercurial > hg > xemacs-beta

comparison lisp/glyphs.el @ 4597:7191a7b120f1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some cosmetic namespace cleanup, glyphs.el, coding.el. lisp/ChangeLog addition: 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 15 Jan 2009 19:21:43 +0000
parents 6a17ac5da3c4
children 1cecc3e9f0a0
comparison
equal deleted inserted replaced
4576:774e5c7522bf 4597:7191a7b120f1
1082 (if (featurep 'scrollbar) 1082 (if (featurep 'scrollbar)
1083 (set-glyph-face scrollbar-pointer-glyph 'pointer)) 1083 (set-glyph-face scrollbar-pointer-glyph 'pointer))
1084 (set-glyph-face gc-pointer-glyph 'pointer) 1084 (set-glyph-face gc-pointer-glyph 'pointer)
1085 1085
1086 ;; Now add the magic access/set behavior. 1086 ;; Now add the magic access/set behavior.
1087 1087 (loop
1088 (defun dontusethis-set-value-glyph-handler (sym args fun harg handler) 1088 for sym in '(define-constant-glyphs text-pointer-glyph nontext-pointer-glyph
1089 (error "Use `set-glyph-image' to set `%s'" sym)) 1089 modeline-pointer-glyph selection-pointer-glyph
1090 (defun dontusethis-make-unbound-glyph-handler (sym args fun harg handler) 1090 busy-pointer-glyph gc-pointer-glyph divider-pointer-glyph
1091 (error "Can't `makunbound' `%s'" sym)) 1091 toolbar-pointer-glyph menubar-pointer-glyph
1092 (defun dontusethis-make-local-glyph-handler (sym args fun harg handler) 1092 scrollbar-pointer-glyph octal-escape-glyph
1093 (error "Use `set-glyph-image' to make local values for `%s'" sym)) 1093 control-arrow-glyph invisible-text-glyph hscroll-glyph
1094 1094 truncation-glyph continuation-glyph frame-icon-glyph)
1095 (defun define-constant-glyph (sym) 1095 with set-value-handler = #'(lambda (sym args fun harg handler)
1096 (dontusethis-set-symbol-value-handler 1096 (error 'invalid-change
1097 sym 'set-value 1097 (format
1098 'dontusethis-set-value-glyph-handler) 1098 "Use `set-glyph-image' to set `%s'"
1099 (dontusethis-set-symbol-value-handler 1099 sym)))
1100 sym 'make-unbound 1100 with make-unbound-handler = #'(lambda (sym args fun harg handler)
1101 'dontusethis-make-unbound-glyph-handler) 1101 (error 'invalid-change
1102 (dontusethis-set-symbol-value-handler 1102 (format
1103 sym 'make-local 1103 "Can't `makunbound' `%s'" sym)))
1104 'dontusethis-make-local-glyph-handler) 1104 with make-local-handler =
1105 ;; Make frame properties magically work with glyph variables. 1105 #'(lambda (sym args fun harg handler)
1106 (error 'invalid-change
1107 (format "Use `set-glyph-image' to make local values for `%s'" sym)))
1108 do
1109 (dontusethis-set-symbol-value-handler sym 'set-value set-value-handler)
1110 (dontusethis-set-symbol-value-handler sym 'make-unbound make-unbound-handler)
1111 (dontusethis-set-symbol-value-handler sym 'make-local make-local-handler)
1106 (put sym 'const-glyph-variable t)) 1112 (put sym 'const-glyph-variable t))
1107 1113
1108 (define-constant-glyph 'text-pointer-glyph)
1109 (define-constant-glyph 'nontext-pointer-glyph)
1110 (define-constant-glyph 'modeline-pointer-glyph)
1111 (define-constant-glyph 'selection-pointer-glyph)
1112 (define-constant-glyph 'busy-pointer-glyph)
1113 (define-constant-glyph 'gc-pointer-glyph)
1114 (define-constant-glyph 'divider-pointer-glyph)
1115 (define-constant-glyph 'toolbar-pointer-glyph)
1116 (define-constant-glyph 'menubar-pointer-glyph)
1117 (define-constant-glyph 'scrollbar-pointer-glyph)
1118
1119 (define-constant-glyph 'octal-escape-glyph)
1120 (define-constant-glyph 'control-arrow-glyph)
1121 (define-constant-glyph 'invisible-text-glyph)
1122 (define-constant-glyph 'hscroll-glyph)
1123 (define-constant-glyph 'truncation-glyph)
1124 (define-constant-glyph 'continuation-glyph)
1125
1126 (define-constant-glyph 'frame-icon-glyph)
1127
1128 ;; backwards compatibility garbage 1114 ;; backwards compatibility garbage
1129
1130 (defun dontusethis-old-pointer-shape-handler (sym args fun harg handler)
1131 (let ((value (car args)))
1132 (if (null value)
1133 (remove-specifier harg 'global)
1134 (set-glyph-image (symbol-value harg) value))))
1135 1115
1136 ;; It might or might not be garbage, but it's rude. Make these 1116 ;; It might or might not be garbage, but it's rude. Make these
1137 ;; `compatible' instead of `obsolete'. -slb 1117 ;; `compatible' instead of `obsolete'. -slb
1138 (defun define-obsolete-pointer-glyph (old new) 1118 (loop
1119 for (old new) in '((x-pointer-shape text-pointer-glyph)
1120 (x-nontext-pointer-shape nontext-pointer-glyph)
1121 (x-mode-pointer-shape modeline-pointer-glyph)
1122 (x-selection-pointer-shape selection-pointer-glyph)
1123 (x-busy-pointer-shape busy-pointer-glyph)
1124 (x-gc-pointer-shape gc-pointer-glyph)
1125 (x-toolbar-pointer-shape toolbar-pointer-glyph))
1126 with set-handler = #'(lambda (sym args fun harg handler)
1127 (let ((value (car args)))
1128 (if (null value)
1129 (remove-specifier harg 'global)
1130 (set-glyph-image (symbol-value harg) value))))
1131 do
1139 (define-compatible-variable-alias old new) 1132 (define-compatible-variable-alias old new)
1140 (dontusethis-set-symbol-value-handler 1133 (dontusethis-set-symbol-value-handler old 'set-value set-handler))
1141 old 'set-value 'dontusethis-old-pointer-shape-handler new))
1142
1143 ;;; (defvar x-pointer-shape nil)
1144 (define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph)
1145
1146 ;;; (defvar x-nontext-pointer-shape nil)
1147 (define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph)
1148
1149 ;;; (defvar x-mode-pointer-shape nil)
1150 (define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph)
1151
1152 ;;; (defvar x-selection-pointer-shape nil)
1153 (define-obsolete-pointer-glyph 'x-selection-pointer-shape
1154 'selection-pointer-glyph)
1155
1156 ;;; (defvar x-busy-pointer-shape nil)
1157 (define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph)
1158
1159 ;;; (defvar x-gc-pointer-shape nil)
1160 (define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph)
1161
1162 ;;; (defvar x-toolbar-pointer-shape nil)
1163 (define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph)
1164 1134
1165 ;; for subwindows 1135 ;; for subwindows
1166 (defalias 'subwindow-xid 'image-instance-subwindow-id) 1136 (defalias 'subwindow-xid 'image-instance-subwindow-id)
1167 (defalias 'subwindow-width 'image-instance-width) 1137 (defalias 'subwindow-width 'image-instance-width)
1168 (defalias 'subwindow-height 'image-instance-height) 1138 (defalias 'subwindow-height 'image-instance-height)
1265 'global 'tty)) 1235 'global 'tty))
1266 ) 1236 )
1267 1237
1268 (init-glyphs) 1238 (init-glyphs)
1269 1239
1240 (unintern 'init-glyphs) ;; This was dump time thing, no need to keep the
1241 ;; function around.
1242
1270 ;;; glyphs.el ends here. 1243 ;;; glyphs.el ends here.