Seiji Zenitani
zenit****@users*****
2005年 10月 24日 (月) 20:57:09 JST
Index: CarbonEmacsPackage/GPL/htmlize.el diff -u CarbonEmacsPackage/GPL/htmlize.el:1.1 CarbonEmacsPackage/GPL/htmlize.el:1.2 --- CarbonEmacsPackage/GPL/htmlize.el:1.1 Sun Oct 23 13:18:03 2005 +++ CarbonEmacsPackage/GPL/htmlize.el Mon Oct 24 20:57:09 2005 @@ -1,6 +1,6 @@ ;; htmlize.el -- Convert buffer text and decorations to HTML. -;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003 Hrvoje Niksic +;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005 Hrvoje Niksic ;; Author: Hrvoje Niksic <hniks****@xemac*****> ;; Keywords: hypermedia, extensions @@ -70,8 +70,8 @@ ;; Thanks go to the multitudes of people who have sent reports and ;; contributed comments, suggestions, and fixes. They include Ron -;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels and many -;; others. +;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri +;; Linkov, and many others. ;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" ;; -- Bill Perry, author of Emacs/W3 @@ -93,7 +93,7 @@ ;; `cl' is loaded. (load "cl-extra"))) -(defconst htmlize-version "1.16") +(defconst htmlize-version "1.21") ;; Incantations to make custom stuff work without customize, e.g. on ;; XEmacs 19.14 or GNU Emacs 19.34. @@ -159,6 +159,14 @@ :type 'string :group 'htmlize) +(defcustom htmlize-replace-form-feeds t + "*Non-nil means replace form feed characters in source code with <hr />. +If this is a string, it additionally specifies the replacement to use. +If you need more elaborate processing, set this to nil and use +htmlize-after-hook." + :type 'boolean + :group 'htmlize) + (defcustom htmlize-html-charset nil "*The charset declared by the resulting HTML documents. When non-nil, causes htmlize to insert the following in the HEAD section @@ -423,8 +431,8 @@ (setf (gethash char htmlize-extended-character-cache) (format "&#%d;" char))) ((and (fboundp 'encode-char) - ;; Have to check: encode-char fails for Arabic - ;; and possibly other chars. + ;; Must check if encode-char works for CHAR; + ;; it fails for Arabic and possibly elsewhere. (encode-char char 'ucs)) (setf (gethash char htmlize-extended-character-cache) (format "&#%d;" (encode-char char 'ucs)))) @@ -542,6 +550,16 @@ ;; <http://www.mail-archive.com/bbdb-****@xemac*****/> ;; <hniks****@xemac*****> ;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.c****@xml*****> + +(defun htmlize-defang-local-variables () + ;; Juri Linkov reports that an HTML-ized "Local variables" can lead + ;; visiting the HTML to fail with "Local variables list is not + ;; properly terminated". He suggested changing the phrase to + ;; syntactically equivalent HTML that Emacs doesn't recognize. + (goto-char (point-min)) + (while (search-forward "Local Variables:" nil t) + (replace-match "Local Variables:" nil t))) + ;;; Color handling. @@ -633,7 +651,18 @@ ;; return "unspecified-fg" or "unspecified-bg". If the face is ;; `default' and the color is unspecified, look up the color in ;; frame parameters. - (let ((color (if fg (face-foreground face) (face-background face)))) + (let* ((function (if fg #'face-foreground #'face-background)) + color) + (if (>= emacs-major-version 22) + ;; For GNU Emacs 22+ set INHERIT to get the inherited values. + (setq color (funcall function face nil t)) + (setq color (funcall function face)) + (when (and (null color) + (fboundp 'face-attribute) + (face-attribute face :inherit) + (not (eq (face-attribute face :inherit) 'unspecified))) + (setq color (htmlize-face-color-internal + (face-attribute face :inherit) fg)))) (when (and (eq face 'default) (null color)) (setq color (cdr (assq (if fg 'foreground-color 'background-color) (frame-parameters))))) @@ -776,9 +805,12 @@ (setf (htmlize-fstruct-underlinep fstruct) (face-underline-p face)))) ((fboundp 'face-attribute) - ;; GNU Emacs 21. + ;; GNU Emacs 21 and further. (dolist (attr '(:weight :slant :underline :overline :strike-through)) - (let ((value (face-attribute face attr))) + (let ((value (if (>= emacs-major-version 22) + ;; Use the INHERIT arg in GNU Emacs 22. + (face-attribute face attr nil t) + (face-attribute face attr)))) (when (and value (not (eq value 'unspecified))) (htmlize-face-emacs21-attr fstruct attr value))))) (t @@ -900,6 +932,12 @@ (push new-name css-names))))) face-map)) +(defun htmlize-unstringify-face (face) + "If FACE is a string, return it interned, otherwise return it unchanged." + (if (stringp face) + (intern face) + face)) + (defun htmlize-faces-in-buffer () "Return a list of faces used in the current buffer. Under XEmacs, this returns the set of faces specified by the extents @@ -931,16 +969,20 @@ next (or (next-single-property-change pos 'face) (point-max))) ;; FACE-PROP can be a face/attrlist or a list thereof. (setq faces (if (htmlize-face-list-p face-prop) - (union face-prop faces :test 'equal) - (adjoin face-prop faces :test 'equal))) + (union (mapcar #'htmlize-unstringify-face face-prop) + faces :test 'equal) + (adjoin (htmlize-unstringify-face 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))) ;; FACE-PROP can be a face/attrlist or a list thereof. (setq faces (if (htmlize-face-list-p face-prop) - (union face-prop faces :test 'equal) - (adjoin face-prop faces :test 'equal)))))) + (union (mapcar #'htmlize-unstringify-face face-prop) + faces :test 'equal) + (adjoin (htmlize-unstringify-face face-prop) + faces :test 'equal)))))) faces)) ;; htmlize-faces-at-point returns the faces in use at point. The @@ -968,8 +1010,9 @@ ;; Faces from text properties. (let ((face-prop (get-text-property (point) 'face))) (setq all-faces (if (htmlize-face-list-p face-prop) - (reverse face-prop) - (list face-prop)))) + (nreverse (mapcar #'htmlize-unstringify-face + face-prop)) + (list (htmlize-unstringify-face face-prop))))) ;; Faces from overlays. (let ((overlays ;; Collect overlays at point that specify `face'. @@ -991,8 +1034,11 @@ (dolist (overlay overlays) (setq face-prop (overlay-get overlay 'face)) (setq list (if (htmlize-face-list-p face-prop) - (nconc (reverse face-prop) list) - (cons face-prop list)))) + (nconc (nreverse (mapcar + #'htmlize-unstringify-face + face-prop)) + list) + (cons (htmlize-unstringify-face face-prop) list)))) (setq all-faces (nconc all-faces list))))))) ;; htmlize supports generating HTML in two several fundamentally @@ -1252,11 +1298,21 @@ (funcall insert-text-method text fstruct-list htmlbuf)) (goto-char next-change))) - ;; Insert the epilog. + ;; Insert the epilog and post-process the buffer. (with-current-buffer htmlbuf (insert "</pre>\n </body>\n</html>\n") (when htmlize-generate-hyperlinks (htmlize-make-hyperlinks)) + (htmlize-defang-local-variables) + (when htmlize-replace-form-feeds + ;; Change each "^L\n" to "\n<hr/>". + (goto-char (point-min)) + (let ((replacement + (concat "\n" (if (stringp htmlize-replace-form-feeds) + htmlize-replace-form-feeds + "<hr />")))) + (while (search-forward "\n" nil t) + (replace-match replacement t t)))) (goto-char (point-min)) (when htmlize-html-major-mode ;; What sucks about this is that the minor modes, most notably
