diff options
Diffstat (limited to 'lisp/htmlfontify.el')
| -rw-r--r-- | lisp/htmlfontify.el | 63 |
1 files changed, 29 insertions, 34 deletions
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index bfbe0ee165b..3b961989e3e 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -523,22 +523,10 @@ therefore no longer care about) will be invalid at any time.\n (defvar hfy-tmpfont-stack nil "An alist of derived fonts resulting from overlays.") -(defconst hfy-hex-regex "[[:xdigit:]]") - (defconst hfy-triplet-regex - (concat - "\\(" hfy-hex-regex hfy-hex-regex "\\)" - "\\(" hfy-hex-regex hfy-hex-regex "\\)" - "\\(" hfy-hex-regex hfy-hex-regex "\\)")) - -(defun hfy-interq (set-a set-b) - "Return the intersection (using `eq') of two lists SET-A and SET-B." - (let ((sa set-a) (interq nil) (elt nil)) - (while sa - (setq elt (car sa) - sa (cdr sa)) - (if (memq elt set-b) (setq interq (cons elt interq)))) - interq)) + (rx (group xdigit xdigit) + (group xdigit xdigit) + (group xdigit xdigit))) (defun hfy-color-vals (color) "Where COLOR is a color name or #XXXXXX style triplet, return a @@ -887,7 +875,9 @@ See also `hfy-display-class' for details of valid values for CLASS." (setq score 0) (ignore "t match")) ((not (cdr (assq key face-class))) ;Neither good nor bad. nil (ignore "non match, non collision")) - ((setq x (hfy-interq val (cdr (assq key face-class)))) + ((setq x (nreverse + (seq-intersection val (cdr (assq key face-class)) + #'eq))) (setq score (+ score (length x))) (ignore "intersection")) (t ;; nope. @@ -983,19 +973,18 @@ merged by the user - `hfy-flatten-style' should do this." (:italic (hfy-slant 'italic)))))) (setq that (hfy-face-to-style-i next)) ;;(lwarn t :warning "%S => %S" fn (nconc this that parent)) - (nconc this parent that))) ) + (append this parent that))) ) -(defun hfy-size-to-int (spec) +(defun hfy--size-to-int (spec) "Convert SPEC, a CSS font-size specifier, to an Emacs :height attribute value. Used while merging multiple font-size attributes." - ;;(message "hfy-size-to-int");;DBUG - (list - (if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec) - (cond ((string= "%" (match-string 2 spec)) - (/ (string-to-number (match-string 1 spec)) 100.0)) - ((string= "pt" (match-string 2 spec)) - (* (string-to-number (match-string 1 spec)) 10))) - (string-to-number spec))) ) + ;;(message "hfy--size-to-int");;DBUG + (if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec) + (cond ((string= "%" (match-string 2 spec)) + (/ (string-to-number (match-string 1 spec)) 100.0)) + ((string= "pt" (match-string 2 spec)) + (* (string-to-number (match-string 1 spec)) 10))) + (string-to-number spec)) ) ;; size is different, in that in order to get it right at all, ;; we have to trawl the inheritance path, accumulating modifiers, @@ -1006,19 +995,18 @@ any multiple attributes appropriately. Currently only font-size is merged down to a single occurrence - others may need special handling, but I haven't encountered them yet. Returns a `hfy-style-assoc'." ;;(message "(hfy-flatten-style %S)" style) ;;DBUG - (let ((n 0) - (m (list 1)) + (let ((m (list 1)) (x nil) (r nil)) (dolist (css style) (if (string= (car css) "font-size") (progn - (when (not x) (setq m (nconc m (hfy-size-to-int (cdr css))))) + (when (not x) (push (hfy--size-to-int (cdr css)) m)) (when (string-match "pt" (cdr css)) (setq x t))) - (setq r (nconc r (list css))))) + (push css r))) ;;(message "r: %S" r) - (setq n (apply #'* m)) - (nconc r (hfy-size (if x (round n) (* n 1.0)))) )) + (let ((n (apply #'* m))) + (nconc (nreverse r) (hfy-size (if x (round n) (float n))))))) (defun hfy-face-resolve-face (fn) "For FN return a face specification. @@ -1052,7 +1040,7 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'." ;; text-decoration is not inherited. ;; but it's not wrong and if this ever changes it will ;; be needed, so I think it's better to leave it in? -- v - (nconc final-style '(("text-decoration" . "none")))))) + (push '("text-decoration" . "none") final-style)))) final-style)) ;; strip redundant bits from a name. Technically, this could result in @@ -1914,7 +1902,7 @@ tree depth, as determined from FILE (a filename). START is the offset at which to start looking for the / character in FILE." ;;(message "hfy-relstub");;DBUG (let ((c "")) - (while (setq start (string-match "/" file start)) + (while (setq start (string-search "/" file start)) (setq start (1+ start)) (setq c (concat c "../"))) c)) @@ -2357,6 +2345,13 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." (let ((file (hfy-initfile))) (load file 'NOERROR nil nil) )) +;; Obsolete. + +(defun hfy-interq (set-a set-b) + "Return the intersection (using `eq') of two lists SET-A and SET-B." + (declare (obsolete seq-intersection "28.1")) + (nreverse (seq-intersection set-a set-b #'eq))) + (provide 'htmlfontify) ;;; htmlfontify.el ends here |