Re: Code blocks (partially) inherit buffer colors

[Richard Stanton <stanton@haas.berkeley.edu>]

Thanks for the suggestion, Eric. Following the instructions, I fired up Emacs, loaded files of various types, then ran the command

org-html-htmlize-generate-css

Unfortunately, this resulted in an error dump:

Debugger entered--Lisp error: (error "Invalid face" popup-mouse-face)
  internal-get-lisp-face-attribute(popup-mouse-face :height nil)
  face-attribute(popup-mouse-face :height)
  (setq h (face-attribute f :height))
  (while (progn (setq f (if --cl-var-- face (face-attribute f :inherit))) (not (or (not f) (eq f (quote unspecified))))) (setq h (face-attribute f :height)) (push (if (eq h (quote unspecified)) nil h) --cl-var--) (setq --cl-var-- nil))
  (let* ((f nil) (h nil) (--cl-var-- nil) (--cl-var-- t)) (while (progn (setq f (if --cl-var-- face (face-attribute f :inherit))) (not (or (not f) (eq f (quote unspecified))))) (setq h (face-attribute f :height)) (push (if (eq h (quote unspecified)) nil h) --cl-var--) (setq --cl-var-- nil)) (nreverse --cl-var--))
  (catch (quote --cl-block-nil--) (let* ((f nil) (h nil) (--cl-var-- nil) (--cl-var-- t)) (while (progn (setq f (if --cl-var-- face (face-attribute f :inherit))) (not (or (not f) (eq f (quote unspecified))))) (setq h (face-attribute f :height)) (push (if (eq h (quote unspecified)) nil h) --cl-var--) (setq --cl-var-- nil)) (nreverse --cl-var--)))
  (cl-block-wrapper (catch (quote --cl-block-nil--) (let* ((f nil) (h nil) (--cl-var-- nil) (--cl-var-- t)) (while (progn (setq f (if --cl-var-- face (face-attribute f :inherit))) (not (or (not f) (eq f ...)))) (setq h (face-attribute f :height)) (push (if (eq h (quote unspecified)) nil h) --cl-var--) (setq --cl-var-- nil)) (nreverse --cl-var--))))
  (block nil (let* ((f nil) (h nil) (--cl-var-- nil) (--cl-var-- t)) (while (progn (setq f (if --cl-var-- face (face-attribute f :inherit))) (not (or (not f) (eq f (quote unspecified))))) (setq h (face-attribute f :height)) (push (if (eq h (quote unspecified)) nil h) --cl-var--) (setq --cl-var-- nil)) (nreverse --cl-var--)))
  (loop for f = face then (face-attribute f :inherit) until (or (not f) (eq f (quote unspecified))) for h = (face-attribute f :height) collect (if (eq h (quote unspecified)) nil h))
  (let ((size-list (loop for f = face then (face-attribute f :inherit) until (or (not f) (eq f (quote unspecified))) for h = (face-attribute f :height) collect (if (eq h (quote unspecified)) nil h)))) (reduce (quote htmlize-merge-size) (cons nil size-list)))
  htmlize-face-size(ac-candidate-mouse-face)
  (let ((size (htmlize-face-size face))) (unless (eql size 1.0) (setf (htmlize-fstruct-size fstruct) size)))
  (if htmlize-running-xemacs (let* ((font-instance (face-font-instance face)) (props (font-instance-properties font-instance))) (when (equalp (cdr (assq (quote WEIGHT_NAME) props)) "bold") (setf (htmlize-fstruct-boldp fstruct) t)) (when (or (equalp (cdr (assq (quote SLANT) props)) "i") (equalp (cdr (assq (quote SLANT) props)) "o")) (setf (htmlize-fstruct-italicp fstruct) t)) (setf (htmlize-fstruct-strikep fstruct) (face-strikethru-p face)) (setf (htmlize-fstruct-underlinep fstruct) (face-underline-p face))) (dolist (attr (quote (:weight :slant :underline :overline :strike-through))) (let ((value (if (>= emacs-major-version 22) (face-attribute face attr nil t) (let (...) (while ... ...) (face-attribute face attr))))) (when (and value (not (eq value (quote unspecified)))) (htmlize-face-emacs21-attr fstruct attr value)))) (let ((size (htmlize-face-size face))) (unless (eql size 1.0) (setf (htmlize-fstruct-size fstruct) size))))
  (let ((fstruct (make-htmlize-fstruct :foreground (htmlize-color-to-rgb (htmlize-face-foreground face)) :background (htmlize-color-to-rgb (htmlize-face-background face))))) (if htmlize-running-xemacs (let* ((font-instance (face-font-instance face)) (props (font-instance-properties font-instance))) (when (equalp (cdr (assq (quote WEIGHT_NAME) props)) "bold") (setf (htmlize-fstruct-boldp fstruct) t)) (when (or (equalp (cdr (assq ... props)) "i") (equalp (cdr (assq ... props)) "o")) (setf (htmlize-fstruct-italicp fstruct) t)) (setf (htmlize-fstruct-strikep fstruct) (face-strikethru-p face)) (setf (htmlize-fstruct-underlinep fstruct) (face-underline-p face))) (dolist (attr (quote (:weight :slant :underline :overline :strike-through))) (let ((value (if (>= emacs-major-version 22) (face-attribute face attr nil t) (let ... ... ...)))) (when (and value (not (eq value ...))) (htmlize-face-emacs21-attr fstruct attr value)))) (let ((size (htmlize-face-size face))) (unless (eql size 1.0) (setf (htmlize-fstruct-size fstruct) size)))) (setf (htmlize-fstruct-css-name fstruct) (htmlize-face-css-name face)) fstruct)
  htmlize-face-to-fstruct(ac-candidate-mouse-face)
  (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face))
  (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name (incf i)))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names)))
  (if (gethash face face-map) nil (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name (incf i)))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names))))
  (unless (gethash face face-map) (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name (incf i)))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names))))
  (while --cl-dolist-temp-- (setq face (car --cl-dolist-temp--)) (unless (gethash face face-map) (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name (incf i)))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names)))) (setq --cl-dolist-temp-- (cdr --cl-dolist-temp--)))
  (let ((--cl-dolist-temp-- faces) face) (while --cl-dolist-temp-- (setq face (car --cl-dolist-temp--)) (unless (gethash face face-map) (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name ...))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names)))) (setq --cl-dolist-temp-- (cdr --cl-dolist-temp--))))
  (catch (quote --cl-block-nil--) (let ((--cl-dolist-temp-- faces) face) (while --cl-dolist-temp-- (setq face (car --cl-dolist-temp--)) (unless (gethash face face-map) (let ((fstruct (if ... ... ...))) (setf (gethash face face-map) fstruct) (let* ((css-name ...) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name ...)) (unless (equal new-name css-name) (setf ... new-name)) (push new-name css-names)))) (setq --cl-dolist-temp-- (cdr --cl-dolist-temp--)))))
  (cl-block-wrapper (catch (quote --cl-block-nil--) (let ((--cl-dolist-temp-- faces) face) (while --cl-dolist-temp-- (setq face (car --cl-dolist-temp--)) (unless (gethash face face-map) (let ((fstruct ...)) (setf (gethash face face-map) fstruct) (let* (... ... ...) (while ... ...) (unless ... ...) (push new-name css-names)))) (setq --cl-dolist-temp-- (cdr --cl-dolist-temp--))))))
  (block nil (let ((--cl-dolist-temp-- faces) face) (while --cl-dolist-temp-- (setq face (car --cl-dolist-temp--)) (unless (gethash face face-map) (let ((fstruct (if ... ... ...))) (setf (gethash face face-map) fstruct) (let* ((css-name ...) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name ...)) (unless (equal new-name css-name) (setf ... new-name)) (push new-name css-names)))) (setq --cl-dolist-temp-- (cdr --cl-dolist-temp--)))))
  (dolist (face faces) (unless (gethash face face-map) (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name (incf i)))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names)))))
  (let ((face-map (make-hash-table :test (quote equal))) css-names) (dolist (face faces) (unless (gethash face face-map) (let ((fstruct (if (symbolp face) (htmlize-face-to-fstruct face) (htmlize-attrlist-to-fstruct face)))) (setf (gethash face face-map) fstruct) (let* ((css-name (htmlize-fstruct-css-name fstruct)) (new-name css-name) (i 0)) (while (member new-name css-names) (setq new-name (format "%s-%s" css-name ...))) (unless (equal new-name css-name) (setf (htmlize-fstruct-css-name fstruct) new-name)) (push new-name css-names))))) face-map)
  htmlize-make-face-map((default monky-header monky-section-title monky-branch monky-diff-hunk-header monky-diff-add monky-diff-none monky-diff-del monky-log-sha1 monky-log-message monky-log-head-label-local monky-log-head-label-tags monky-log-head-label-bookmarks monky-log-head-label-phase monky-queue-active monky-queue-positive-guard monky-queue-negative-guard yas--field-debug-face dropdown-list-face dropdown-list-selection-face dvc-revision-name dvc-repository-name dvc-local-directory dvc-buffer dvc-marked dvc-excluded dvc-bookmark-name dvc-id dvc-separator dvc-keyword dvc-comment dvc-ignored dvc-unrecognized dvc-duplicate dvc-source dvc-nested-tree dvc-to-add dvc-broken-link dvc-unmerged dvc-header dvc-conflict dvc-unknown dvc-modified dvc-copy dvc-move dvc-deleted dvc-added dvc-meta-info dvc-messages dvc-highlight ...))
  (let* ((buffer-faces (htmlize-faces-in-buffer)) (face-map (htmlize-make-face-map (adjoin (quote default) buffer-faces))) (places (gensym)) (title (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name)))) (when htmlize-generate-hyperlinks (htmlize-create-auto-links)) (when htmlize-replace-form-feeds (htmlize-shadow-form-feeds)) (with-current-buffer htmlbuf (buffer-disable-undo) (insert (htmlize-method doctype) 10 (format "<!-- Created by htmlize-%s in %s mode. -->\n" htmlize-version htmlize-output-type) "<html>\n  ") (put places (quote head-start) (point-marker)) (insert "<head>\n" "    <title>" (htmlize-protect-string title) "</title>\n" (if htmlize-html-charset (format (concat "    <meta http-equiv=\"Content-Type\" " "content=\"text/html; charset=%s\">\n") htmlize-html-charset) "") htmlize-head-tags) (htmlize-method insert-head buffer-faces face-map) (insert "  </head>") (put places (quote head-end) (point-marker)) (insert "\n  ") (put places (quote body-start) (point-marker)) (insert (htmlize-method body-tag face-map) "\n    ") (put places (quote content-start) (point-marker)) (insert "<pre>\n")) (let ((text-markup (htmlize-method-function (quote text-markup))) next-change text face-list trailing-ellipsis fstruct-list last-fstruct-list (close-markup (lambda nil))) (goto-char (point-min)) (while (not (eobp)) (setq next-change (htmlize-next-face-change (point))) (setq face-list (htmlize-faces-at-point) fstruct-list (delq nil (mapcar (lambda (f) (gethash f face-map)) face-list))) (multiple-value-setq (text trailing-ellipsis) (htmlize-extract-text (point) next-change trailing-ellipsis)) (when (> (length text) 0) (when (not (equalp fstruct-list last-fstruct-list)) (funcall close-markup) (setq last-fstruct-list fstruct-list close-markup (funcall text-markup fstruct-list htmlbuf))) (princ text htmlbuf)) (goto-char next-change)) (funcall close-markup)) (with-current-buffer htmlbuf (insert "</pre>") (put places (quote content-end) (point-marker)) (insert "\n  </body>") (put places (quote body-end) (point-marker)) (insert "\n</html>\n") (htmlize-defang-local-variables) (goto-char (point-min)) (when htmlize-html-major-mode (funcall htmlize-html-major-mode)) (set (make-local-variable (quote htmlize-buffer-places)) (symbol-plist places)) (run-hooks (quote htmlize-after-hook)) (buffer-enable-undo)) (setq completed t) htmlbuf)
  (unwind-protect (let* ((buffer-faces (htmlize-faces-in-buffer)) (face-map (htmlize-make-face-map (adjoin (quote default) buffer-faces))) (places (gensym)) (title (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name)))) (when htmlize-generate-hyperlinks (htmlize-create-auto-links)) (when htmlize-replace-form-feeds (htmlize-shadow-form-feeds)) (with-current-buffer htmlbuf (buffer-disable-undo) (insert (htmlize-method doctype) 10 (format "<!-- Created by htmlize-%s in %s mode. -->\n" htmlize-version htmlize-output-type) "<html>\n  ") (put places (quote head-start) (point-marker)) (insert "<head>\n" "    <title>" (htmlize-protect-string title) "</title>\n" (if htmlize-html-charset (format (concat "    <meta http-equiv=\"Content-Type\" " "content=\"text/html; charset=%s\">\n") htmlize-html-charset) "") htmlize-head-tags) (htmlize-method insert-head buffer-faces face-map) (insert "  </head>") (put places (quote head-end) (point-marker)) (insert "\n  ") (put places (quote body-start) (point-marker)) (insert (htmlize-method body-tag face-map) "\n    ") (put places (quote content-start) (point-marker)) (insert "<pre>\n")) (let ((text-markup (htmlize-method-function (quote text-markup))) next-change text face-list trailing-ellipsis fstruct-list last-fstruct-list (close-markup (lambda nil))) (goto-char (point-min)) (while (not (eobp)) (setq next-change (htmlize-next-face-change (point))) (setq face-list (htmlize-faces-at-point) fstruct-list (delq nil (mapcar (lambda ... ...) face-list))) (multiple-value-setq (text trailing-ellipsis) (htmlize-extract-text (point) next-change trailing-ellipsis)) (when (> (length text) 0) (when (not (equalp fstruct-list last-fstruct-list)) (funcall close-markup) (setq last-fstruct-list fstruct-list close-markup (funcall text-markup fstruct-list htmlbuf))) (princ text htmlbuf)) (goto-char next-change)) (funcall close-markup)) (with-current-buffer htmlbuf (insert "</pre>") (put places (quote content-end) (point-marker)) (insert "\n  </body>") (put places (quote body-end) (point-marker)) (insert "\n</html>\n") (htmlize-defang-local-variables) (goto-char (point-min)) (when htmlize-html-major-mode (funcall htmlize-html-major-mode)) (set (make-local-variable (quote htmlize-buffer-places)) (symbol-plist places)) (run-hooks (quote htmlize-after-hook)) (buffer-enable-undo)) (setq completed t) htmlbuf) (when (not completed) (kill-buffer htmlbuf)) (htmlize-delete-tmp-overlays))
  (let ((htmlbuf (generate-new-buffer (if (buffer-file-name) (htmlize-make-file-name (file-name-nondirectory (buffer-file-name))) "*html*"))) (completed nil)) (unwind-protect (let* ((buffer-faces (htmlize-faces-in-buffer)) (face-map (htmlize-make-face-map (adjoin (quote default) buffer-faces))) (places (gensym)) (title (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name)))) (when htmlize-generate-hyperlinks (htmlize-create-auto-links)) (when htmlize-replace-form-feeds (htmlize-shadow-form-feeds)) (with-current-buffer htmlbuf (buffer-disable-undo) (insert (htmlize-method doctype) 10 (format "<!-- Created by htmlize-%s in %s mode. -->\n" htmlize-version htmlize-output-type) "<html>\n  ") (put places (quote head-start) (point-marker)) (insert "<head>\n" "    <title>" (htmlize-protect-string title) "</title>\n" (if htmlize-html-charset (format (concat "    <meta http-equiv=\"Content-Type\" " "content=\"text/html; charset=%s\">\n") htmlize-html-charset) "") htmlize-head-tags) (htmlize-method insert-head buffer-faces face-map) (insert "  </head>") (put places (quote head-end) (point-marker)) (insert "\n  ") (put places (quote body-start) (point-marker)) (insert (htmlize-method body-tag face-map) "\n    ") (put places (quote content-start) (point-marker)) (insert "<pre>\n")) (let ((text-markup (htmlize-method-function (quote text-markup))) next-change text face-list trailing-ellipsis fstruct-list last-fstruct-list (close-markup (lambda nil))) (goto-char (point-min)) (while (not (eobp)) (setq next-change (htmlize-next-face-change (point))) (setq face-list (htmlize-faces-at-point) fstruct-list (delq nil (mapcar ... face-list))) (multiple-value-setq (text trailing-ellipsis) (htmlize-extract-text (point) next-change trailing-ellipsis)) (when (> (length text) 0) (when (not ...) (funcall close-markup) (setq last-fstruct-list fstruct-list close-markup ...)) (princ text htmlbuf)) (goto-char next-change)) (funcall close-markup)) (with-current-buffer htmlbuf (insert "</pre>") (put places (quote content-end) (point-marker)) (insert "\n  </body>") (put places (quote body-end) (point-marker)) (insert "\n</html>\n") (htmlize-defang-local-variables) (goto-char (point-min)) (when htmlize-html-major-mode (funcall htmlize-html-major-mode)) (set (make-local-variable (quote htmlize-buffer-places)) (symbol-plist places)) (run-hooks (quote htmlize-after-hook)) (buffer-enable-undo)) (setq completed t) htmlbuf) (when (not completed) (kill-buffer htmlbuf)) (htmlize-delete-tmp-overlays)))
  (save-excursion (save-excursion (run-hooks (quote htmlize-before-hook))) (htmlize-ensure-fontified) (clrhash htmlize-extended-character-cache) (clrhash htmlize-memoization-table) (let ((htmlbuf (generate-new-buffer (if (buffer-file-name) (htmlize-make-file-name (file-name-nondirectory ...)) "*html*"))) (completed nil)) (unwind-protect (let* ((buffer-faces (htmlize-faces-in-buffer)) (face-map (htmlize-make-face-map (adjoin ... buffer-faces))) (places (gensym)) (title (if (buffer-file-name) (file-name-nondirectory ...) (buffer-name)))) (when htmlize-generate-hyperlinks (htmlize-create-auto-links)) (when htmlize-replace-form-feeds (htmlize-shadow-form-feeds)) (with-current-buffer htmlbuf (buffer-disable-undo) (insert (htmlize-method doctype) 10 (format "<!-- Created by htmlize-%s in %s mode. -->\n" htmlize-version htmlize-output-type) "<html>\n  ") (put places (quote head-start) (point-marker)) (insert "<head>\n" "    <title>" (htmlize-protect-string title) "</title>\n" (if htmlize-html-charset (format ... htmlize-html-charset) "") htmlize-head-tags) (htmlize-method insert-head buffer-faces face-map) (insert "  </head>") (put places (quote head-end) (point-marker)) (insert "\n  ") (put places (quote body-start) (point-marker)) (insert (htmlize-method body-tag face-map) "\n    ") (put places (quote content-start) (point-marker)) (insert "<pre>\n")) (let ((text-markup (htmlize-method-function ...)) next-change text face-list trailing-ellipsis fstruct-list last-fstruct-list (close-markup (lambda nil))) (goto-char (point-min)) (while (not (eobp)) (setq next-change (htmlize-next-face-change ...)) (setq face-list (htmlize-faces-at-point) fstruct-list (delq nil ...)) (multiple-value-setq (text trailing-ellipsis) (htmlize-extract-text ... next-change trailing-ellipsis)) (when (> ... 0) (when ... ... ...) (princ text htmlbuf)) (goto-char next-change)) (funcall close-markup)) (with-current-buffer htmlbuf (insert "</pre>") (put places (quote content-end) (point-marker)) (insert "\n  </body>") (put places (quote body-end) (point-marker)) (insert "\n</html>\n") (htmlize-defang-local-variables) (goto-char (point-min)) (when htmlize-html-major-mode (funcall htmlize-html-major-mode)) (set (make-local-variable (quote htmlize-buffer-places)) (symbol-plist places)) (run-hooks (quote htmlize-after-hook)) (buffer-enable-undo)) (setq completed t) htmlbuf) (when (not completed) (kill-buffer htmlbuf)) (htmlize-delete-tmp-overlays))))
  htmlize-buffer-1()
  (save-restriction (narrow-to-region beg end) (htmlize-buffer-1))
  (let ((htmlbuf (save-restriction (narrow-to-region beg end) (htmlize-buffer-1)))) (when (interactive-p) (switch-to-buffer htmlbuf)) htmlbuf)
  htmlize-region(1 209)
  org-html-htmlize-generate-css()
  call-interactively(org-html-htmlize-generate-css t nil)
  execute-extended-command(nil)
  call-interactively(execute-extended-command nil nil)

-----Original Message-----
From: Eric Schulte [mailto:schulte.eric@gmail.com] 
Sent: Thursday, February 28, 2013 9:29 PM
To: Richard Stanton
Cc: emacs-orgmode@gnu.org
Subject: Re: [O] Code blocks (partially) inherit buffer colors

Richard Stanton <stanton@haas.berkeley.edu> writes:

> When I export a code block to HTML, I've noticed that some (but not
> all) of the characters in the resulting HTML file have the same 
> background color as my Emacs buffer at the time I exported. For 
> example, if I export
>
> -----------
>
> #+begin_src python
> a = 5
> #+end_src
>
> ------------
>
> the code block in the resulting HTML file has a very pale background, 
> except for the characters "a" and "5", both of which are displayed 
> with a dark blue background that looks like it's the same as the 
> background color in my Emacs buffer. This looks rather odd...
>
> I can work around this problem by changing the color-theme in my Emacs 
> buffer before exporting, but is there a better solution?
>
> Thanks.
>
> Richard Stanton

See the documentation of the `org-export-htmlize-output-type' variable.

--
Eric Schulte
http://cs.unm.edu/~eschulte