1 ;;; hfyview.el --- View current buffer as html in web browser
3 ;; Copyright (C) 2005, 2006, 2007 by Lennart Borgman
5 ;; Author: Lennart Borgman
6 ;; Created: Fri Oct 21 2005
7 (defconst hfyview:version "0.63") ;; Version:
8 ;; Last-Updated: 2010-04-16 Fri
10 ;; URL: http://OurComments.org/Emacs/DL/elisp/hfyview.el
14 ;; Features that might be required by this library:
19 ;; htmlfontify.el is part of Emacs.
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;; This file shows the current buffer in your web browser with all
27 ;; the colors it has. The purpose is mainly to make it possible to
28 ;; easily print what you see in Emacs in colors on different
31 ;; Put this file in your load-path and in your .emacs this:
35 ;; This defines the commands `hfyview-buffer', `hfyview-region' and
36 ;; `hfyview-window' which will show the whole or a part of the buffer
37 ;; in your web browser.
39 ;; You can add those commands to the menus by customizing
40 ;; `hfyview-quick-print-in-files-menu' to t. This will add an entry
41 ;; "Quick Print (Using Web Browser)" to the files menu.
44 ;; There is also a command `hfyview-frame' to take a "screen shot" of
45 ;; your current frame and produce an html look-alike page. If you
46 ;; turn on `hfyview-frame-mode' you get this function on the <apps>
47 ;; key in most situations.
50 ;; You can see an example of the output here:
52 ;; http://ourcomments.org/Emacs/nXhtml/doc/htmlfontify-example.html
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
61 ;; This program is free software; you can redistribute it and/or
62 ;; modify it under the terms of the GNU General Public License as
63 ;; published by the Free Software Foundation; either version 2, or (at
64 ;; your option) any later version.
66 ;; This program is distributed in the hope that it will be useful, but
67 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
68 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
69 ;; General Public License for more details.
71 ;; To find out more about the GNU General Public License you can visit
72 ;; Free Software Foundation's website http://www.fsf.org/. Or, write
73 ;; to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
74 ;; Floor, Boston, MA 02110-1301, USA.
76 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80 (eval-when-compile (require 'cl))
81 (eval-when-compile (require 'htmlfontify))
84 (defvar hfyview-selected-window)
86 (defvar hfyview-frame-mode-emulation-map
87 (let ((m (make-sparse-keymap)))
88 ;;(define-key m [apps] 'hfyview-frame)
91 (defvar hfyview-frame-mode-emulation-maps
92 (list (cons 'hfyview-frame-mode hfyview-frame-mode-emulation-map)))
94 ;; Fix-me: which are needed? Probably only viper, but have to test.
95 (defconst hfyview-frame-mode-other-maps
97 hfyview-frame-mode-emulation-map
98 minibuffer-local-completion-map
99 minibuffer-local-filename-completion-map
100 minibuffer-local-isearch-map
102 ;; minibuffer-local-must-match-filename-map
103 minibuffer-local-must-match-map
104 minibuffer-local-ns-map
108 (define-minor-mode hfyview-frame-mode
109 "Define some useful things for `hfyview-frame'.
110 The <apps> key is bound to `hfyview-frame' in this mode. When
111 this mode is on you can push <apps> to get all of what you see on
112 the screen. Without it the minibuffer/echo area will not be
116 (if hfyview-frame-mode
118 (add-hook 'pre-command-hook 'hfy-grab-minibuffer-content)
119 (add-hook 'post-command-hook 'hfy-grab-echo-content)
120 (add-to-list 'emulation-mode-map-alists 'hfyview-frame-mode-emulation-maps)
121 (dolist (map hfyview-frame-mode-other-maps)
122 (define-key (symbol-value map) [(apps)] 'hfyview-frame)
125 (remove-hook 'pre-command-hook 'hfy-grab-minibuffer-content)
126 (remove-hook 'post-command-hook 'hfy-grab-echo-content)
127 (setq emulation-mode-map-alists (delq 'hfyview-frame-mode-emulation-maps emulation-mode-map-alists))
128 (dolist (map hfyview-frame-mode-other-maps)
129 (define-key (symbol-value map) [(apps)] nil))))
131 (defun hfyview-fontify-region (start end)
132 "Fontify region between START and END the htmlfontify way."
133 ;; If the last command in mumamo resulted in a change of major-mode
134 ;; the big bug watcher in mumamo will get us if we do not tell that
135 ;; we know what we are doing:
136 (let ((mumamo-just-changed-major nil))
140 (narrow-to-region start end)
141 (assert (= end (point-max)))
142 (assert (= start (point-min)))
143 (htmlfontify-buffer))
144 (htmlfontify-buffer))))
146 (defun hfyview-buffer-1(start end show-source)
147 "Convert current buffer between START and END to html.
148 If SHOW-SOURCE is non-nil then also show produced html in other
150 (let ((hbuf (hfyview-fontify-region start end)))
151 (with-current-buffer hbuf
152 (setq buffer-file-name nil)
153 (browse-url-of-buffer))
154 (when show-source (switch-to-buffer-other-window hbuf))
158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
161 (defvar hfyview-print-menu (make-sparse-keymap "QP"))
162 (defvar hfyview-print-region-menu (make-sparse-keymap "QPR"))
163 (defvar hfyview-print-window-menu (make-sparse-keymap "QPW"))
164 (defun hfyview-add-to-files-menu ()
165 "Add \"Quick Print\" entry to file menu."
166 ;; Why did I redo this???
167 (setq hfyview-print-menu (make-sparse-keymap "QP"))
168 (setq hfyview-print-region-menu (make-sparse-keymap "QPR"))
169 (setq hfyview-print-window-menu (make-sparse-keymap "QPW"))
171 (define-key-after menu-bar-file-menu [hfyview-print]
173 "Quick Print (Using Web Browser)"
175 :visible 'hfyview-print-visible)
178 (define-key hfyview-print-menu [hfyview-browser-frame-pre]
179 '(menu-item "Print Preview Frame" hfyview-frame
180 :help "Print preview frame with web browser"))
181 (define-key hfyview-print-menu [hfyview-browser-window-pre]
182 '(menu-item "Print Preview Window" hfyview-window
183 :help "Print preview window with web browser"))
184 (define-key hfyview-print-menu [hfyview-browser-region-pre]
185 (list 'menu-item "Print Preview Region" 'hfyview-region
186 :help "Print preview region with web browser"
187 :enable 'mark-active))
188 (define-key hfyview-print-menu [hfyview-separator-pre]
190 (define-key hfyview-print-menu [hfyview-browser-pre]
191 '(menu-item "Print Preview Buffer" hfyview-buffer
192 :help "Print preview buffer with web browser"
197 (defcustom hfyview-quick-print-in-files-menu nil
198 "Add Quick print entries to File menu if non-nil.
199 If you set this to nil you have to restart Emacs to get rid of
200 the Quick Print entry."
202 :set (lambda (sym val)
203 (set-default sym val)
205 (hfyview-add-to-files-menu)))
208 (defvar hfyview-print-visible t
209 "Non-nil means show Quick Print entry on the file menu.")
212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
213 ;;;;;; Interactive commands
216 (defun hfyview-buffer (arg)
217 "Convert buffer to html preserving faces and show in web browser.
218 With command prefix ARG also show html source in other window."
220 (hfyview-buffer-1 nil nil arg))
223 (defun hfyview-region (arg)
224 "Convert region to html preserving faces and show in web browser.
225 With command prefix ARG also show html source in other window."
227 (hfyview-buffer-1 (region-beginning) (region-end) arg))
230 (defun hfyview-window (arg)
231 "Convert window to html preserving faces and show in web browser.
232 With command prefix ARG also show html source in other window."
234 (hfyview-buffer-1 (window-start) (window-end) arg))
237 (defun hfyview-frame (whole-buffers)
238 "Convert frame to html preserving faces and show in web browser.
239 Make an XHTML view of the current Emacs frame. Put it in a buffer
240 named *hfyview-frame* and show that buffer in a web browser.
242 If WHOLE-BUFFERS is non-nil then the whole content of the buffers
243 is shown in the XHTML page, otherwise just the part that is
244 visible currently on the frame.
246 If you turn on the minor mode `hfyview-frame-mode' you can also
247 get the minibuffer/echo area in the output. See this mode for
250 With command prefix also show html source in other window."
251 (interactive (list (y-or-n-p "Enter y for whole buffers, n for only visible part? ")))
252 (let ((title "Emacs - Frame Dump")
254 (setq title (frame-parameter (selected-frame) 'name))
255 (setq buf (hfyview-frame-1 whole-buffers title))
256 (when current-prefix-arg
257 (switch-to-buffer-other-window buf))))
260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
261 ;;;;;; Internal commands
263 (defconst hfyview-modline-format
264 ;; There seems to be a bug in Firefox that prevents this from
265 ;; displaying correctly. Anyway this is just a quick and reasonable
267 (concat "<div style=\"width:%sem; color:%s; background:%s; white-space:pre; overflow:hidden; font-family:monospace;\">"
268 ;; Using <pre> gives empty line above and below
270 "-- (Unix)%s <b>%s</b> (%s%s) "
277 (defun hfyview-get-minors ()
278 "Return string with active minor mode highlighters."
280 (dolist (mr minor-mode-alist)
283 (when (symbol-value mm)
285 (setq minors (concat minors ml))))))
288 ;; (hfyview-dekludge-string "<i> ")
289 (defun hfyview-dekludge-string (str)
290 "Return html quoted string STR."
291 (mapconcat (lambda (c)
297 (defvar viper-mode-string) ;; Silence compiler
299 (defun hfyview-fontify-win-to (win tag whole-buffer)
300 "Return html code for window WIN.
301 Sorround the code with the html tag <TAG>.
302 WHOLE-BUFFER corresponds to the similar argument for
304 (let* ((bstart (unless whole-buffer (window-start win)))
305 (bend (unless whole-buffer (window-end win)))
306 (hbuf (hfyview-fontify-region bstart bend))
307 (edges (window-edges win))
308 (width (- (nth 2 edges) (nth 0 edges)))
309 (height (- (nth 3 edges) (nth 1 edges)))
310 (border-color (or (hfy-triplet "SystemActiveBorder")
323 (window-start-line (point-min))
324 (window-end-line (point-max))
325 (is-selected-window (eq win hfyview-selected-window))
328 ;; Fix-me: fetch style too
329 (with-current-buffer (window-buffer win)
333 (setq window-start-line (line-number-at-pos bstart))
334 (setq window-end-line (line-number-at-pos bend))
335 (unless (or (< (line-number-at-pos (point-min)) window-start-line)
336 (> (line-number-at-pos (point-max)) window-end-line))
337 (setq whole-buffer t))
340 (setq mod-fgcolor (face-attribute (if is-selected-window 'mode-line 'mode-line-inactive) :foreground))
341 (setq mod-bgcolor (face-attribute (if is-selected-window 'mode-line 'mode-line-inactive) :background))
342 (setq mod-fgcolor (hfy-triplet mod-fgcolor))
343 (setq mod-bgcolor (hfy-triplet mod-bgcolor))
344 (setq mod (if (buffer-modified-p) "**" "--"))
345 (when buffer-read-only
347 (setq bu-name (buffer-name))
348 (setq ma-name mode-name)
349 (setq minors (hfyview-get-minors))
350 (when (and (local-variable-p 'viper-mode-string) viper-mode-string)
351 (setq mark-viper viper-mode-string))
353 ;; Compensate for scroll-bars
354 (setq mod-width (+ width 1))
355 (with-current-buffer hbuf
356 (setq width (- width 2.5))
357 (setq width (* 0.57 width))
358 (setq height (+ height 2)) ;; For pre
359 ;;(setq height (+ height 1.2)) ;; For horisontal scrollbar
360 (setq height (* 1.16 height))
361 (goto-char (point-min))
362 (re-search-forward "<body.*?>")
365 (format "<%s style=\"width:%sem; height:%sem; border: 1px solid %s; overflow:%s; padding:4px;\">\n"
366 tag width height border-color
367 (if whole-buffer "auto" "hidden") ;; overflow
369 (goto-char (point-max))
370 (setq end (search-backward "</body>"))
373 (format "\n<div style=\"margin-top:2em; color: red; text-align: center; \"> Truncated to line %s - %s! </div>\n"
374 window-start-line window-end-line)))
375 (insert "</" tag ">\n")
376 ;;(lwarn t :warning "%s" mark-viper)
377 (insert (format hfyview-modline-format
379 mod-fgcolor mod-bgcolor mod
380 (hfyview-dekludge-string bu-name)
381 (hfyview-dekludge-string ma-name)
382 (hfyview-dekludge-string minors)
383 (hfyview-dekludge-string mark-viper)))
385 (goto-char (point-min))
386 (search-forward "<style type=\"text/css\"><!--")
388 (setq css-start (point))
389 (search-forward "--></style>")
390 (setq css-end (point))
391 (set-buffer-modified-p nil)
392 (setq buffer-file-name nil))
393 (list hbuf start end css-start css-end)))
395 ;; (defun hfyview-window-framed ()
398 ;; (let* ((res (hfyview-fontify-win-to (selected-window) "div" nil))
399 ;; (hbuf (nth 0 res)))
400 ;; (with-current-buffer hbuf
401 ;; (browse-url-of-buffer))))
403 (defun hfyview-fontify-tree-win (win whole-buffer)
404 "Return html code for window WIN.
405 WHOLE-BUFFER corresponds to the similar argument for
407 (with-selected-window win
408 (let* ((start (window-start))
410 (res (hfyview-fontify-win-to win "div" whole-buffer))
412 (with-current-buffer hbuf
413 (rename-buffer (generate-new-buffer-name (format "%s %s-%s" win start end))))
414 ;;(lwarn t :warning "win=%s, hbuf=%s" win hbuf)
417 (defun hfyview-fontify-tree (wt whole-buffers)
418 "Return list of html code for all windows in tree WT.
419 WT should be the result of function `window-tree' or a subtree of
420 this. For WHOLE-BUFFERS see `hfyview-frame-1'."
422 (hfyview-fontify-tree-win wt whole-buffers)
424 (dolist (w (cddr wt))
425 (setq ret (cons (hfyview-fontify-tree w whole-buffers) ret)))
426 (list (car wt) ret))))
428 (defun hfyview-frame-to-html (res)
429 "Return list with css and html code for frame.
430 RES is the collected result from `hfyview-fontify-tree'."
434 (td "<td style=\"vertical-align:top;\">")
437 ((memq first '(nil t))
438 (dolist (sub (reverse (cadr res)))
439 (let* ((fres (hfyview-frame-to-html sub))
442 (when first (setq h (concat "<tr>\n" h "</tr>\n")))
443 (setq html (concat html h))
444 (setq css (concat css c))))
446 (setq html (concat "<tr>" html "</tr>\n")))
447 (setq html (concat "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\">\n" html "</table>\n"))
448 (setq html (concat td html "</td>\n"))
452 (let* ((buf (nth 0 res))
458 ;;(concat "<td>" "temp" "</td>\n")
459 (with-current-buffer buf (buffer-substring-no-properties sta end)))
461 ;;(concat "<td>" "temp" "</td>\n")
462 (with-current-buffer buf (buffer-substring-no-properties cst cnd))))
465 (setq html (concat html h))
472 (defconst hfyview-xhtml-header
473 "<?xml version=\"1.0\" encoding=\"utf-8\"?>
474 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
475 \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
476 <html xmlns=\"http://www.w3.org/1999/xhtml\">
479 <style type=\"text/css\"><!--
480 body { font-family: outline-courier new; font-stretch: normal; font-weight: 500; font-style: normal; color: rgb(0, 0, 0); font-size: 10pt; text-decoration: none; }
486 (defvar hfyview-xhtml-footer "</body>\n</html>\n")
488 (defun hfyview-wm-border-color ()
489 "Return CSS code for color to use in window borders."
490 (or (hfy-triplet "SystemActiveTitle")
491 (hfy-triplet "blue")))
493 (defvar hfy-grabbed-echo-content nil)
494 (defvar hfy-grabbed-minibuffer-content nil)
495 (defvar hfyview-prompt-face nil)
497 (defun hfyview-frame-minibuff (use-grabbed)
498 "Return html code for minibuffer.
499 If USE-GRABBED is non-nil use what has been grabbed by
500 `hfy-grab-echo-content' or `hfy-grab-minibuffer-content'.
501 Otherwise make a default content for the minibuffer."
503 (or hfy-grabbed-echo-content
504 hfy-grabbed-minibuffer-content))
505 (let* ((str (if hfy-grabbed-echo-content
506 hfy-grabbed-echo-content
507 hfy-grabbed-minibuffer-content))
508 (tmpbuf (get-buffer-create "*hfy-minibuff-temp*"))
509 (hbuf (with-current-buffer tmpbuf
510 (let ((inhibit-read-only t))
512 ;; Fix-me: move the propertize to a new
513 ;; copy-buffer in hfy-fontify-buffer. Explained
515 (insert (propertize str
519 'modification-hooks nil
520 'insert-in-front-hooks nil
521 'insert-behind-hooks nil
527 (htmlfontify-buffer))))
534 (with-current-buffer hbuf
535 (goto-char (point-min))
536 (search-forward "<style type=\"text/css\"><!--")
538 (setq css-start (point))
539 (search-forward "--></style>")
540 (setq css-end (point))
541 (goto-char (point-min))
542 (search-forward "<pre>")
543 (setq bdy-start (point))
544 (goto-char (point-max))
545 (search-backward "</pre>")
546 (setq bdy-end (point))
547 (list (buffer-substring css-start css-end)
548 (buffer-substring bdy-start bdy-end))))
549 (let ((mini-bg (face-attribute hfyview-prompt-face :background))
550 (mini-fg (face-attribute hfyview-prompt-face :foreground)))
551 (if (eq mini-fg 'unspecified)
553 (setq mini-fg (concat "color:" (hfy-triplet mini-fg) "; ")))
554 (if (eq mini-bg 'unspecified)
556 (setq mini-bg (concat "background:" (hfy-triplet mini-bg) "; ")))
559 "<span style=\"" mini-fg mini-bg "\">"
566 (defun hfyview-frame-1(whole-buffers frame-title)
567 "Return buffer with html code for current frame.
568 If WHOLE-BUFFERS is non-nil then make scrollable buffers in the
569 html output. Otherwise just make html code for the currently
570 visible part of the buffers.
572 FRAME-TITLE is the title to show on the resulting html page."
573 (let* ((wt (window-tree))
574 (hfyview-selected-window (selected-window))
575 (res (hfyview-fontify-tree (car wt) whole-buffers))
576 (title-bg-color (hfyview-wm-border-color))
577 (title-color (or (hfy-triplet "SystemHilightText")
579 (title-style (concat (format "background-color:%s; color:%s;" title-bg-color title-color)
580 "border: none; padding:4px; vertical-align: middle;"))
581 (outbuf (get-buffer-create "frame"))
584 ;; (face-attribute 'minibuffer-prompt :foreground)
585 (hfyview-prompt-face (plist-get minibuffer-prompt-properties 'face))
587 (frame-width (* 0.56 (frame-width)))
589 (icon-file (expand-file-name "../etc/images/icons/emacs_16.png" exec-directory))
590 (img-tag (if (file-exists-p icon-file)
591 (concat "<img src=\"file://" icon-file "\" height=\"16\" width=\"16\" />")))
596 (format "border: solid %s; width:%sem;"
597 (hfyview-wm-border-color)
600 (setq minibuf (hfyview-frame-minibuff hfyview-frame-mode))
601 (setq mini-css (nth 0 minibuf))
602 (setq mini-html (nth 1 minibuf))
603 (when (string= mini-html "") (setq mini-html " "))
604 (setq res (hfyview-frame-to-html res))
605 (setq html (nth 0 res))
606 (setq css (nth 1 res))
607 (with-current-buffer outbuf
608 ;;(lwarn t :warning "outbuf=%s" outbuf)
610 (insert (format hfyview-xhtml-header
611 (concat "Emacs frame dump - " frame-title)
613 (if mini-css mini-css "")
614 (format "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" style=\"%s\">\n" table-style)
616 (format "<td style=\"%s\">%s %s</td>\n" title-style img-tag
617 (hfyview-dekludge-string frame-title))
623 "<td style=\"padding:1px;\">\n"
628 hfyview-xhtml-footer)
629 (browse-url-of-buffer)
632 (defun hfy-grab-echo-content ()
633 "Return echo area content."
634 (setq hfy-grabbed-echo-content (current-message)))
636 (defun hfy-grab-minibuffer-content ()
637 "Return minibuffer content."
639 (let* ((mw (minibuffer-window))
640 (mb (window-buffer mw)))
641 (setq hfy-grabbed-minibuffer-content
642 (with-current-buffer mb
644 (point-min) (point-max)))
647 ;;(add-hook 'pre-command-hook 'grab-minibuffer-content nil t)
648 ;;(remove-hook 'pre-command-hook 'grab-minibuffer-content) t)
651 ;;; hfyview.el ends here