daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

94
lisp/htmlize.el
View File

@@ -5,8 +5,8 @@
;; Author: Hrvoje Niksic <hniksic@gmail.com>
;; Homepage: https://github.com/hniksic/emacs-htmlize
;; Keywords: hypermedia, extensions
;; Package-Version: 20191111.2130
;; Package-Commit: 86f22f211e9230857197c42a9823d3f05381deed
;; Package-Version: 20200816.746
;; Package-Commit: 49205105898ba8993b5253beec55d8bddd820a70
;; Version: 1.56
;; This program is free software; you can redistribute it and/or modify
@@ -84,7 +84,7 @@
;;; Code:
(require 'cl)
(require 'cl-lib)
(eval-when-compile
(defvar font-lock-auto-fontify)
(defvar font-lock-support-mode)
@@ -552,7 +552,7 @@ list."
(when (plist-get imgprops :file)
(let ((location (plist-get (cdr (find-image (list imgprops))) :file)))
(when location
(setq imgprops (plist-put (copy-list imgprops) :file location)))))
(setq imgprops (plist-put (cl-copy-list imgprops) :file location)))))
(if htmlize-force-inline-images
(let ((location (plist-get imgprops :file))
data)
@@ -599,9 +599,9 @@ list."
(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
(defun htmlize-match-inv-spec (inv)
(member* inv buffer-invisibility-spec
:key (lambda (i)
(if (symbolp i) i (car i)))))
(cl-member inv buffer-invisibility-spec
:key (lambda (i)
(if (symbolp i) i (car i)))))
(defun htmlize-decode-invisibility-spec (invisible)
;; Return t, nil, or `ellipsis', depending on how invisible text should be inserted.
@@ -621,7 +621,7 @@ list."
;; CDR, replace the invisible text with an ellipsis.
(let ((match (if (symbolp invisible)
(htmlize-match-inv-spec invisible)
(some #'htmlize-match-inv-spec invisible))))
(cl-some #'htmlize-match-inv-spec invisible))))
(cond ((null match) t)
((cdr-safe (car match)) 'ellipsis)
(t nil)))))
@@ -645,7 +645,7 @@ list."
(if additions
(let ((textlist nil)
(strpos 0))
(dolist (add (stable-sort additions #'< :key #'car))
(dolist (add (cl-stable-sort additions #'< :key #'car))
(let ((addpos (car add))
(addtext (cdr add)))
(push (substring text strpos addpos) textlist)
@@ -733,7 +733,7 @@ list."
;; Increase COLUMN by the length of the text we've
;; skipped since last tab or newline. (Encountering
;; newline resets it.)
(incf column (- match-pos last-match))
(cl-incf column (- match-pos last-match))
;; Calculate tab size based on tab-width and COLUMN.
(setq tab-size (- tab-width (% column tab-width)))
;; Expand the tab, carefully recreating the `display'
@@ -743,7 +743,7 @@ list."
(when display
(put-text-property 0 tab-size 'display display expanded-tab))
(push expanded-tab chunks))
(incf column tab-size)
(cl-incf column tab-size)
(setq chunk-start (1+ match-pos)))
(t
;; Reset COLUMN at beginning of line.
@@ -773,7 +773,7 @@ list."
(when htmlize-untabify
(setq text (htmlize-untabify-string text (current-column))))
(setq text (htmlize-string-to-html text))
(values text trailing-ellipsis)))
(cl-values text trailing-ellipsis)))
(defun htmlize-despam-address (string)
"Replace every occurrence of '@' in STRING with %40.
@@ -990,7 +990,7 @@ If no rgb.txt file is found, return nil."
;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
;; faces.
(defstruct htmlize-fstruct
(cl-defstruct htmlize-fstruct
foreground ; foreground color, #rrggbb
background ; background color, #rrggbb
size ; size
@@ -1004,7 +1004,7 @@ If no rgb.txt file is found, return nil."
(defun htmlize-face-set-from-keyword-attr (fstruct attr value)
;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
(case attr
(cl-case attr
(:foreground
(setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
(:background
@@ -1037,7 +1037,7 @@ If no rgb.txt file is found, return nil."
(while head
(let ((inherit (face-attribute (car head) :inherit)))
(cond ((listp inherit)
(setcdr tail (copy-list inherit))
(setcdr tail (cl-copy-list inherit))
(setq tail (last tail)))
((eq inherit 'unspecified))
(t
@@ -1045,11 +1045,11 @@ If no rgb.txt file is found, return nil."
(setq tail (cdr tail)))))
(pop head))
(let ((size-list
(loop
(cl-loop
for f in face-list
for h = (face-attribute f :height)
collect (if (eq h 'unspecified) nil h))))
(reduce 'htmlize-merge-size (cons nil size-list)))))
(cl-reduce 'htmlize-merge-size (cons nil size-list)))))
(defun htmlize-face-css-name (face)
;; Generate the css-name property for the given face. Emacs places
@@ -1117,10 +1117,10 @@ If no rgb.txt file is found, return nil."
;; ...)
;; for the given list of boolean attributes.
(cons 'progn
(loop for attr in attr-list
for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
collect `(when (,attr-sym ,source)
(setf (,attr-sym ,dest) (,attr-sym ,source))))))
(cl-loop for attr in attr-list
for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
collect `(when (,attr-sym ,source)
(setf (,attr-sym ,dest) (,attr-sym ,source))))))
(defun htmlize-merge-size (merged next)
;; Calculate the size of the merge of MERGED and NEXT.
@@ -1148,8 +1148,8 @@ If no rgb.txt file is found, return nil."
;; return it.
(car fstruct-list))
(t
(reduce #'htmlize-merge-two-faces
(cons (make-htmlize-fstruct) fstruct-list)))))
(cl-reduce #'htmlize-merge-two-faces
(cons (make-htmlize-fstruct) fstruct-list)))))
;; GNU Emacs 20+ supports attribute lists in `face' properties. For
;; example, you can use `(:foreground "red" :weight bold)' as an
@@ -1243,7 +1243,7 @@ If no rgb.txt file is found, return nil."
;; Uniquify the face's css-name by using NAME-1, NAME-2,
;; etc.
(while (member new-name css-names)
(setq new-name (format "%s-%s" css-name (incf i))))
(setq new-name (format "%s-%s" css-name (cl-incf i))))
(unless (equal new-name css-name)
(setf (htmlize-fstruct-css-name fstruct) new-name))
(push new-name css-names)))))
@@ -1265,14 +1265,14 @@ overlays that specify `face'."
(while (< pos (point-max))
(setq face-prop (get-text-property pos 'face)
next (or (next-single-property-change pos 'face) (point-max)))
(setq faces (nunion (htmlize-decode-face-prop face-prop)
faces :test 'equal))
(setq faces (cl-nunion (htmlize-decode-face-prop face-prop)
faces :test 'equal))
(setq pos next)))
;; Faces used by overlays.
(dolist (overlay (overlays-in (point-min) (point-max)))
(let ((face-prop (overlay-get overlay 'face)))
(setq faces (nunion (htmlize-decode-face-prop face-prop)
faces :test 'equal))))
(setq faces (cl-nunion (htmlize-decode-face-prop face-prop)
faces :test 'equal))))
faces))
(if (>= emacs-major-version 25)
@@ -1282,14 +1282,14 @@ overlays that specify `face'."
(defun htmlize-sorted-overlays-at (pos)
;; Like OVERLAYS-AT with the SORTED argument, for older Emacsen.
(let ((overlays (overlays-at pos)))
(setq overlays (sort* overlays #'<
:key (lambda (o)
(- (overlay-end o) (overlay-start o)))))
(setq overlays (cl-sort overlays #'<
:key (lambda (o)
(- (overlay-end o) (overlay-start o)))))
(setq overlays
(stable-sort overlays #'<
:key (lambda (o)
(let ((prio (overlay-get o 'priority)))
(if (numberp prio) prio 0)))))
(cl-stable-sort overlays #'<
:key (lambda (o)
(let ((prio (overlay-get o 'priority)))
(if (numberp prio) prio 0)))))
(nreverse overlays))))
@@ -1310,9 +1310,9 @@ overlays that specify `face'."
;; Faces from overlays.
(let ((overlays
;; Collect overlays at point that specify `face'.
(delete-if-not (lambda (o)
(overlay-get o 'face))
(nreverse (htmlize-sorted-overlays-at (point)))))
(cl-delete-if-not (lambda (o)
(overlay-get o 'face))
(nreverse (htmlize-sorted-overlays-at (point)))))
list face-prop)
(dolist (overlay overlays)
(setq face-prop (overlay-get overlay 'face)
@@ -1360,7 +1360,7 @@ overlays that specify `face'."
That means that GENERATOR will be evaluated and returned the first time
it's called with the same value of KEY. All other times, the cached
\(memoized) value will be returned."
(let ((value (gensym)))
(let ((value (cl-gensym)))
`(let ((,value (gethash ,key htmlize-memoization-table)))
(unless ,value
(setq ,value ,generator)
@@ -1424,9 +1424,9 @@ it's called with the same value of KEY. All other times, the cached
(htmlize-css-specs (gethash 'default face-map))
"\n ")
"\n }\n")
(dolist (face (sort* (copy-list buffer-faces) #'string-lessp
:key (lambda (f)
(htmlize-fstruct-css-name (gethash f face-map)))))
(dolist (face (cl-sort (cl-copy-list buffer-faces) #'string-lessp
:key (lambda (f)
(htmlize-fstruct-css-name (gethash f face-map)))))
(let* ((fstruct (gethash face face-map))
(cleaned-up-face-name
(let ((s
@@ -1561,8 +1561,8 @@ it's called with the same value of KEY. All other times, the cached
(completed nil))
(unwind-protect
(let* ((buffer-faces (htmlize-faces-in-buffer))
(face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
(places (gensym))
(face-map (htmlize-make-face-map (cl-adjoin 'default buffer-faces)))
(places (cl-gensym))
(title (if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))))
@@ -1623,13 +1623,13 @@ it's called with the same value of KEY. All other times, the cached
fstruct-list (delq nil (mapcar (lambda (f)
(gethash f face-map))
face-list)))
(multiple-value-setq (text trailing-ellipsis)
(cl-multiple-value-setq (text trailing-ellipsis)
(htmlize-extract-text (point) next-change trailing-ellipsis))
;; Don't bother writing anything if there's no text (this
;; happens in invisible regions).
(when (> (length text) 0)
;; Open the new markup if necessary and insert the text.
(when (not (equalp fstruct-list last-fstruct-list))
(when (not (cl-equalp fstruct-list last-fstruct-list))
(funcall close-markup)
(setq last-fstruct-list fstruct-list
close-markup (funcall text-markup fstruct-list htmlbuf)))
@@ -1878,7 +1878,7 @@ corresponding source file."
(provide 'htmlize)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions unresolved obsolete)
;; byte-compile-warnings: (not unresolved obsolete)
;; End:
;;; htmlize.el ends here