Mercurial > hg > xemacs-beta

comparison lisp/font.el @ 5366:f00192e1cd49

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Examining the result of #'length: `eql', not `=', it's better style & cheaper 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * buff-menu.el (list-buffers-noselect): * byte-optimize.el (byte-optimize-identity): * byte-optimize.el (byte-optimize-if): * byte-optimize.el (byte-optimize-nth): * byte-optimize.el (byte-optimize-nthcdr): * bytecomp.el (byte-compile-warn-wrong-args): * bytecomp.el (byte-compile-two-args-19->20): * bytecomp.el (byte-compile-list): * bytecomp.el (byte-compile-beginning-of-line): * bytecomp.el (byte-compile-set): * bytecomp.el (byte-compile-set-default): * bytecomp.el (byte-compile-values): * bytecomp.el (byte-compile-values-list): * bytecomp.el (byte-compile-integerp): * bytecomp.el (byte-compile-multiple-value-list-internal): * bytecomp.el (byte-compile-throw): * cl-macs.el (cl-do-arglist): * cl-macs.el (cl-parse-loop-clause): * cl-macs.el (multiple-value-bind): * cl-macs.el (multiple-value-setq): * cl-macs.el (get-setf-method): * cmdloop.el (command-error): * cmdloop.el (y-or-n-p-minibuf): * cmdloop.el (yes-or-no-p-minibuf): * coding.el (unencodable-char-position): * cus-edit.el (custom-face-prompt): * cus-edit.el (custom-buffer-create-internal): * cus-edit.el (widget-face-action): * cus-edit.el (custom-group-value-create): * descr-text.el (describe-char-unicode-data): * dialog-gtk.el (popup-builtin-question-dialog): * dragdrop.el (experimental-dragdrop-drop-log-function): * dragdrop.el (experimental-dragdrop-drop-mime-default): * easymenu.el (easy-menu-add): * easymenu.el (easy-menu-remove): * faces.el (read-face-name): * faces.el (set-face-stipple): * files.el (file-name-non-special): * font.el (font-combine-fonts): * font.el (font-set-face-font): * font.el (font-parse-rgb-components): * font.el (font-rgb-color-p): * font.el (font-color-rgb-components): * gnuserv.el (gnuserv-edit-files): * help.el (key-or-menu-binding): * help.el (function-documentation-1): * help.el (function-documentation): * info.el (info): * isearch-mode.el (isearch-exit): * isearch-mode.el (isearch-edit-string): * isearch-mode.el (isearch-*-char): * isearch-mode.el (isearch-complete1): * ldap.el (ldap-encode-country-string): * ldap.el (ldap-decode-string): * minibuf.el (read-file-name-internal-1): * minibuf.el (read-non-nil-coding-system): * minibuf.el (get-user-response): * mouse.el (drag-window-divider): * mule/ccl.el: * mule/ccl.el (ccl-compile-if): * mule/ccl.el (ccl-compile-break): * mule/ccl.el (ccl-compile-repeat): * mule/ccl.el (ccl-compile-write-repeat): * mule/ccl.el (ccl-compile-call): * mule/ccl.el (ccl-compile-end): * mule/ccl.el (ccl-compile-read-multibyte-character): * mule/ccl.el (ccl-compile-write-multibyte-character): * mule/ccl.el (ccl-compile-translate-character): * mule/ccl.el (ccl-compile-mule-to-unicode): * mule/ccl.el (ccl-compile-unicode-to-mule): * mule/ccl.el (ccl-compile-lookup-integer): * mule/ccl.el (ccl-compile-lookup-character): * mule/ccl.el (ccl-compile-map-multiple): * mule/ccl.el (ccl-compile-map-single): * mule/devan-util.el (devanagari-compose-to-one-glyph): * mule/devan-util.el (devanagari-composition-component): * mule/mule-cmds.el (finish-set-language-environment): * mule/viet-util.el: * mule/viet-util.el (viet-encode-viscii-char): * multicast.el (open-multicast-group): * newcomment.el (comment-quote-nested): * newcomment.el (comment-region): * newcomment.el (comment-dwim): * regexp-opt.el (regexp-opt-group): * replace.el (map-query-replace-regexp): * specifier.el (derive-device-type-from-tag-set): * subr.el (skip-chars-quote): * test-harness.el (test-harness-from-buffer): * test-harness.el (batch-test-emacs): * wid-edit.el (widget-choice-action): * wid-edit.el (widget-symbol-prompt-internal): * wid-edit.el (widget-color-action): * window-xemacs.el (push-window-configuration): * window-xemacs.el (pop-window-configuration): * window.el (quit-window): * x-compose.el (electric-diacritic): It's better style, and cheaper (often one assembler instruction vs. a C funcall in the byte code), to use `eql' instead of `=' when it's clear what numerical type a given result will be. Change much of our code to do this, with the help of a byte-compiler change (not comitted) that looked for calls to #'length (which always returns an integer) in its args.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 23:41:52 +0000
parents cd167465bf69
children 97968d099404 ac37a5f7e5be
comparison
equal deleted inserted replaced
5365:dbae25a8949d 5366:f00192e1cd49
426 426
427 (defun font-combine-fonts (&rest args) 427 (defun font-combine-fonts (&rest args)
428 (cond 428 (cond
429 ((null args) 429 ((null args)
430 (error "Wrong number of arguments to font-combine-fonts")) 430 (error "Wrong number of arguments to font-combine-fonts"))
431 ((= (length args) 1) 431 ((eql (length args) 1)
432 (car args)) 432 (car args))
433 (t 433 (t
434 (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) 434 (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args))))
435 (setq args (cdr (cdr args))) 435 (setq args (cdr (cdr args)))
436 (while args 436 (while args
988 ;;; can deal with either syntax. 988 ;;; can deal with either syntax.
989 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 989 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
990 ;;; ###autoload 990 ;;; ###autoload
991 (defun font-set-face-font (&optional face font &rest args) 991 (defun font-set-face-font (&optional face font &rest args)
992 (cond 992 (cond
993 ((and (vectorp font) (= (length font) 12)) 993 ((and (vectorp font) (eql (length font) 12))
994 (let ((font-name (font-create-name font))) 994 (let ((font-name (font-create-name font)))
995 (set-face-property face 'font-specification font) 995 (set-face-property face 'font-specification font)
996 (cond 996 (cond
997 ((null font-name) ; No matching font! 997 ((null font-name) ; No matching font!
998 nil) 998 nil)
1175 #FEFEFE and rgb:fe/fe/fe style specifications are parsed." 1175 #FEFEFE and rgb:fe/fe/fe style specifications are parsed."
1176 (let ((case-fold-search t) 1176 (let ((case-fold-search t)
1177 r g b str) 1177 r g b str)
1178 (cond ((string-match "^#[0-9a-f]+$" color) 1178 (cond ((string-match "^#[0-9a-f]+$" color)
1179 (cond 1179 (cond
1180 ((= (length color) 4) 1180 ((eql (length color) 4)
1181 (setq r (font-hex-string-to-number (substring color 1 2)) 1181 (setq r (font-hex-string-to-number (substring color 1 2))
1182 g (font-hex-string-to-number (substring color 2 3)) 1182 g (font-hex-string-to-number (substring color 2 3))
1183 b (font-hex-string-to-number (substring color 3 4)) 1183 b (font-hex-string-to-number (substring color 3 4))
1184 r (* r 4096) 1184 r (* r 4096)
1185 g (* g 4096) 1185 g (* g 4096)
1186 b (* b 4096))) 1186 b (* b 4096)))
1187 ((= (length color) 7) 1187 ((eql (length color) 7)
1188 (setq r (font-hex-string-to-number (substring color 1 3)) 1188 (setq r (font-hex-string-to-number (substring color 1 3))
1189 g (font-hex-string-to-number (substring color 3 5)) 1189 g (font-hex-string-to-number (substring color 3 5))
1190 b (font-hex-string-to-number (substring color 5 7)) 1190 b (font-hex-string-to-number (substring color 5 7))
1191 r (* r 256) 1191 r (* r 256)
1192 g (* g 256) 1192 g (* g 256)
1193 b (* b 256))) 1193 b (* b 256)))
1194 ((= (length color) 10) 1194 ((eql (length color) 10)
1195 (setq r (font-hex-string-to-number (substring color 1 4)) 1195 (setq r (font-hex-string-to-number (substring color 1 4))
1196 g (font-hex-string-to-number (substring color 4 7)) 1196 g (font-hex-string-to-number (substring color 4 7))
1197 b (font-hex-string-to-number (substring color 7 10)) 1197 b (font-hex-string-to-number (substring color 7 10))
1198 r (* r 16) 1198 r (* r 16)
1199 g (* g 16) 1199 g (* g 16)
1200 b (* b 16))) 1200 b (* b 16)))
1201 ((= (length color) 13) 1201 ((eql (length color) 13)
1202 (setq r (font-hex-string-to-number (substring color 1 5)) 1202 (setq r (font-hex-string-to-number (substring color 1 5))
1203 g (font-hex-string-to-number (substring color 5 9)) 1203 g (font-hex-string-to-number (substring color 5 9))
1204 b (font-hex-string-to-number (substring color 9 13)))) 1204 b (font-hex-string-to-number (substring color 9 13))))
1205 (t 1205 (t
1206 (font-warn 'color (format "Invalid RGB color specification: %s" 1206 (font-warn 'color (format "Invalid RGB color specification: %s"
1231 b 0))) 1231 b 0)))
1232 (list r g b) )) 1232 (list r g b) ))
1233 1233
1234 (defun font-rgb-color-p (obj) 1234 (defun font-rgb-color-p (obj)
1235 (or (and (vectorp obj) 1235 (or (and (vectorp obj)
1236 (= (length obj) 4) 1236 (eql (length obj) 4)
1237 (eq (aref obj 0) 'rgb)))) 1237 (eq (aref obj 0) 'rgb))))
1238 1238
1239 (defun font-rgb-color-red (obj) (aref obj 1)) 1239 (defun font-rgb-color-red (obj) (aref obj 1))
1240 (defun font-rgb-color-green (obj) (aref obj 2)) 1240 (defun font-rgb-color-green (obj) (aref obj 2))
1241 (defun font-rgb-color-blue (obj) (aref obj 3)) 1241 (defun font-rgb-color-blue (obj) (aref obj 3))
1255 (* 65535 (aref color 2)))) 1255 (* 65535 (aref color 2))))
1256 ((font-rgb-color-p color) 1256 ((font-rgb-color-p color)
1257 (list (font-rgb-color-red color) 1257 (list (font-rgb-color-red color)
1258 (font-rgb-color-green color) 1258 (font-rgb-color-green color)
1259 (font-rgb-color-blue color))) 1259 (font-rgb-color-blue color)))
1260 ((and (vectorp color) (= 3 (length color))) 1260 ((and (vectorp color) (eql 3 (length color)))
1261 (list (aref color 0) (aref color 1) (aref color 2))) 1261 (list (aref color 0) (aref color 1) (aref color 2)))
1262 ((and (listp color) (= 3 (length color)) (floatp (car color))) 1262 ((and (listp color) (eql 3 (length color)) (floatp (car color)))
1263 (mapcar #'(lambda (x) (* x 65535)) color)) 1263 (mapcar #'(lambda (x) (* x 65535)) color))
1264 ((and (listp color) (= 3 (length color))) 1264 ((and (listp color) (eql 3 (length color)))
1265 color) 1265 color)
1266 ((or (string-match "^#" color) 1266 ((or (string-match "^#" color)
1267 (string-match "^rgb:" color)) 1267 (string-match "^rgb:" color))
1268 (font-parse-rgb-components color)) 1268 (font-parse-rgb-components color))
1269 ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)" 1269 ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)"