APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1303572264 -3600 # Node ID 97968d09940453d434aa438a8e0fc143ffe645f1 # Parent 4486ba63476b3cb139e197da3a5ecedf2cc08100 Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el 2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * font.el: * font.el (font-warn): Removed. * font.el (font-hex-string-to-number): Removed. * font.el (internal-facep): * font.el (font-lookup-rgb-components): * font.el (font-parse-rgb-components): Use #'string-to-number with the BASE argument instead of #'font-hex-string-to-number, #'display-warning instead of #'font-warn. This entire file smells bitrotted, with lots of functions of very little relevance to XEmacs, but addressing that is more work than I can do today. Lines beginning with 'HG:' are removed. diff -r 4486ba63476b -r 97968d099404 lisp/ChangeLog --- a/lisp/ChangeLog Sun Apr 17 16:27:02 2011 -0400 +++ b/lisp/ChangeLog Sat Apr 23 16:24:24 2011 +0100 ＠＠ -1,3 +1,18 ＠＠ +2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * font.el: + * font.el (font-warn): Removed. + * font.el (font-hex-string-to-number): Removed. + * font.el (internal-facep): + * font.el (font-lookup-rgb-components): + * font.el (font-parse-rgb-components): + Use #'string-to-number with the BASE argument instead of + #'font-hex-string-to-number, #'display-warning instead of + #'font-warn. + This entire file smells bitrotted, with lots of functions of very + little relevance to XEmacs, but addressing that is more work than + I can do today. + 2011-04-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-extra.el: diff -r 4486ba63476b -r 97968d099404 lisp/font.el --- a/lisp/font.el Sun Apr 17 16:27:02 2011 -0400 +++ b/lisp/font.el Sat Apr 23 16:24:24 2011 +0100 ＠＠ -50,9 +50,6 ＠＠ get-fontset-info mswindows-define-rgb-color cancel-function-timers mswindows-font-regexp mswindows-canonicalize-font-name mswindows-parse-font-style mswindows-construct-font-style - ;; #### perhaps we should rewrite font-warn to avoid the warning - ;; Eh, now I look at the code, we definitely should. - font-warn fc-pattern-get-family fc-pattern-get-size fc-pattern-get-weight fc-font-weight-translate-from-constant make-fc-pattern fc-pattern-add-family fc-pattern-add-size)) ＠＠ -1072,24 +1069,6 ＠＠ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Various color related things ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(cond - ((fboundp 'display-warning) - (fset 'font-warn 'display-warning)) - ((fboundp 'w3-warn) - (fset 'font-warn 'w3-warn)) - ((fboundp 'url-warn) - (fset 'font-warn 'url-warn)) - ((fboundp 'warn) - (defun font-warn (class message &optional level) - (warn "(%s/%s) %s" class (or level 'warning) message))) - (t - (defun font-warn (class message &optional level) - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer)))))) (defun font-lookup-rgb-components (color) "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. ＠＠ -1144,32 +1123,12 ＠＠ (setq r (* (read (current-buffer)) 256) g (* (read (current-buffer)) 256) b (* (read (current-buffer)) 256))) - (font-warn 'color (format "No such color: %s" color)) + (display-warning 'color (format "No such color: %s" color)) (setq r 0 g 0 b 0)) (list r g b) )))))) -(defun font-hex-string-to-number (string) - "Convert STRING to an integer by parsing it as a hexadecimal number." - (let ((conv-list '((?0 . 0) (?a . 10) (?A . 10) - (?1 . 1) (?b . 11) (?B . 11) - (?2 . 2) (?c . 12) (?C . 12) - (?3 . 3) (?d . 13) (?D . 13) - (?4 . 4) (?e . 14) (?E . 14) - (?5 . 5) (?f . 15) (?F . 15) - (?6 . 6) - (?7 . 7) - (?8 . 8) - (?9 . 9))) - (n 0) - (i 0) - (lim (length string))) - (while (< i lim) - (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0)) - i (1+ i))) - n )) - (defun font-parse-rgb-components (color) "Parse RGB color specification and return a list of integers (R G B). #FEFEFE and rgb:fe/fe/fe style specifications are parsed." ＠＠ -1178,33 +1137,33 ＠＠ (cond ((string-match "^#[0-9a-f]+$" color) (cond ((eql (length color) 4) - (setq r (font-hex-string-to-number (substring color 1 2)) - g (font-hex-string-to-number (substring color 2 3)) - b (font-hex-string-to-number (substring color 3 4)) + (setq r (string-to-number (substring color 1 2) 16) + g (string-to-number (substring color 2 3) 16) + b (string-to-number (substring color 3 4) 16) r (* r 4096) g (* g 4096) b (* b 4096))) ((eql (length color) 7) - (setq r (font-hex-string-to-number (substring color 1 3)) - g (font-hex-string-to-number (substring color 3 5)) - b (font-hex-string-to-number (substring color 5 7)) + (setq r (string-to-number (substring color 1 3) 16) + g (string-to-number (substring color 3 5) 16) + b (string-to-number (substring color 5 7) 16) r (* r 256) g (* g 256) b (* b 256))) ((eql (length color) 10) - (setq r (font-hex-string-to-number (substring color 1 4)) - g (font-hex-string-to-number (substring color 4 7)) - b (font-hex-string-to-number (substring color 7 10)) + (setq r (string-to-number (substring color 1 4) 16) + g (string-to-number (substring color 4 7) 16) + b (string-to-number (substring color 7 10) 16) r (* r 16) g (* g 16) b (* b 16))) ((eql (length color) 13) - (setq r (font-hex-string-to-number (substring color 1 5)) - g (font-hex-string-to-number (substring color 5 9)) - b (font-hex-string-to-number (substring color 9 13)))) + (setq r (string-to-number (substring color 1 5) 16) + g (string-to-number (substring color 5 9) 16) + b (string-to-number (substring color 9 13) 16))) (t - (font-warn 'color (format "Invalid RGB color specification: %s" - color)) + (display-warning 'color + (format "Invalid RGB color specification: %s" color)) (setq r 0 g 0 b 0)))) ＠＠ -1215,17 +1174,17 ＠＠ (> (- (match-end 3) (match-beginning 3)) 4)) (error "Invalid RGB color specification: %s" color) (setq str (match-string 1 color) - r (* (font-hex-string-to-number str) + r (* (string-to-number str 16) (expt 16 (- 4 (length str)))) str (match-string 2 color) - g (* (font-hex-string-to-number str) + g (* (string-to-number str 16) (expt 16 (- 4 (length str)))) str (match-string 3 color) - b (* (font-hex-string-to-number str) + b (* (string-to-number str 16) (expt 16 (- 4 (length str))))))) (t - (font-warn 'html (format "Invalid RGB color specification: %s" - color)) + (display-warning 'color (format "Invalid RGB color specification: %s" + color)) (setq r 0 g 0 b 0))) -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches