emacs/nxhtml/util/hfyview.el

   1 ;;; hfyview.el --- View current buffer as html in web browser
   2
   3 ;; Copyright (C) 2005, 2006, 2007 by Lennart Borgman
   4
   5 ;; Author: Lennart Borgman
   6 ;; Created: Fri Oct 21 2005
   7 (defconst hfyview:version "0.63") ;; Version:
   8 ;; Last-Updated: 2010-04-16 Fri
   9 ;; Keywords: printing
  10 ;; URL: http://OurComments.org/Emacs/DL/elisp/hfyview.el
  11 ;; Compatibility:
  12 ;;
  13 ;;
  14 ;; Features that might be required by this library:
  15 ;;
  16   ;; `easymenu'.
  17 ;;
  18 ;;
  19 ;; htmlfontify.el is part of Emacs.
  20 ;;
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;; Commentary:
  25 ;;
  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
  29 ;;  platforms.
  30 ;;
  31 ;;  Put this file in your load-path and in your .emacs this:
  32 ;;
  33 ;;      (require 'hfyview)
  34 ;;
  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.
  38 ;;
  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.
  42 ;;
  43 ;;
  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.
  48 ;;
  49 ;;
  50 ;;  You can see an example of the output here:
  51 ;;
  52 ;;    http://ourcomments.org/Emacs/nXhtml/doc/htmlfontify-example.html
  53 ;;
  54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55 ;;
  56 ;;; Change log:
  57 ;;
  58 ;;
  59
  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.
  65 ;;
  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.
  70 ;;
  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.
  75
  76 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77 ;;
  78 ;;; Code:
  79
  80 (eval-when-compile (require 'cl))
  81 (eval-when-compile (require 'htmlfontify))
  82 (require 'easymenu)
  83
  84 (defvar hfyview-selected-window)
  85
  86 (defvar hfyview-frame-mode-emulation-map
  87   (let ((m (make-sparse-keymap)))
  88     ;;(define-key m [apps] 'hfyview-frame)
  89     m))
  90
  91 (defvar hfyview-frame-mode-emulation-maps
  92   (list (cons 'hfyview-frame-mode hfyview-frame-mode-emulation-map)))
  93
  94 ;; Fix-me: which are needed? Probably only viper, but have to test.
  95 (defconst hfyview-frame-mode-other-maps
  96   '(
  97     hfyview-frame-mode-emulation-map
  98     minibuffer-local-completion-map
  99     minibuffer-local-filename-completion-map
 100     minibuffer-local-isearch-map
 101     minibuffer-local-map
 102     ;; minibuffer-local-must-match-filename-map
 103     minibuffer-local-must-match-map
 104     minibuffer-local-ns-map
 105     viper-minibuffer-map
 106     isearch-mode-map))
 107
 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
 113 shown."
 114   :global t
 115   :group 'htmlfontify
 116   (if hfyview-frame-mode
 117       (progn
 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)
 123           )
 124         )
 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))))
 130
 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))
 137     (if start
 138         (save-restriction
 139           (widen)
 140           (narrow-to-region start end)
 141           (assert (= end (point-max)))
 142           (assert (= start (point-min)))
 143           (htmlfontify-buffer))
 144       (htmlfontify-buffer))))
 145
 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
 149 window."
 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))
 155     hbuf))
 156
 157
 158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 159 ;;;;;; Menus
 160
 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"))
 170   ;; Main
 171   (define-key-after menu-bar-file-menu [hfyview-print]
 172     (list 'menu-item
 173           "Quick Print (Using Web Browser)"
 174           hfyview-print-menu
 175           :visible 'hfyview-print-visible)
 176     'separator-print)
 177   ;; Main submenu
 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]
 189     '(menu-item "--"))
 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"
 193                 :visible t))
 194   )
 195
 196 ;;;###autoload
 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."
 201   :type 'boolean
 202   :set (lambda (sym val)
 203          (set-default sym val)
 204          (if val
 205              (hfyview-add-to-files-menu)))
 206   :group 'hfy-view)
 207
 208 (defvar hfyview-print-visible t
 209   "Non-nil means show Quick Print entry on the file menu.")
 210
 211
 212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 213 ;;;;;; Interactive commands
 214
 215 ;;;###autoload
 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."
 219   (interactive "P")
 220   (hfyview-buffer-1 nil nil arg))
 221
 222 ;;;###autoload
 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."
 226   (interactive "P")
 227   (hfyview-buffer-1 (region-beginning) (region-end) arg))
 228
 229 ;;;###autoload
 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."
 233   (interactive "P")
 234   (hfyview-buffer-1 (window-start) (window-end) arg))
 235
 236 ;;;###autoload
 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.
 241
 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.
 245
 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
 248 details.
 249
 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")
 253         buf)
 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))))
 258
 259
 260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 261 ;;;;;; Internal commands
 262
 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
 266   ;; approximation.
 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
 269           ;;"<pre>"
 270           "-- (Unix)%s   <b>%s</b>    (%s%s) "
 271           (make-string 6 ?-)
 272           "%s" ;; Viper
 273           (make-string 200 ?-)
 274           ;;"</pre>"
 275           "</div>"))
 276
 277 (defun hfyview-get-minors ()
 278   "Return string with active minor mode highlighters."
 279   (let ((minors ""))
 280     (dolist (mr minor-mode-alist)
 281       (let ((mm (car mr))
 282             (ml (cadr mr)))
 283         (when (symbol-value mm)
 284           (when (stringp ml)
 285             (setq minors (concat minors ml))))))
 286     minors))
 287
 288 ;; (hfyview-dekludge-string "<i> ")
 289 (defun hfyview-dekludge-string (str)
 290   "Return html quoted string STR."
 291   (mapconcat (lambda (c)
 292                (hfy-html-quote
 293                 (char-to-string c)))
 294              (append str)
 295              ""))
 296
 297 (defvar viper-mode-string) ;; Silence compiler
 298
 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
 303 `hfyview-frame-1'."
 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")
 311                           "gray"))
 312          start
 313          end
 314          css-start
 315          css-end
 316          mod-fgcolor
 317          mod-bgcolor
 318          mod-width
 319          mod
 320          bu-name
 321          ma-name
 322          minors
 323          (window-start-line (point-min))
 324          (window-end-line   (point-max))
 325          (is-selected-window (eq win hfyview-selected-window))
 326          (mark-viper "")
 327          )
 328     ;; Fix-me: fetch style too
 329     (with-current-buffer (window-buffer win)
 330       (unless whole-buffer
 331         (save-restriction
 332           (widen)
 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))
 338           )
 339         )
 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
 346         (setq mod "%%"))
 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))
 352       )
 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.*?>")
 363       (setq start (point))
 364       (insert
 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
 368                ))
 369       (goto-char (point-max))
 370       (setq end (search-backward "</body>"))
 371       (unless whole-buffer
 372         (insert
 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
 378                       width
 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)))
 384       (setq end (point))
 385       (goto-char (point-min))
 386       (search-forward "<style type=\"text/css\"><!--")
 387       (beginning-of-line)
 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)))
 394
 395 ;; (defun hfyview-window-framed ()
 396 ;;   "Just a test"
 397 ;;   (interactive)
 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))))
 402
 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
 406 `hfyview-frame-1'."
 407   (with-selected-window win
 408     (let* ((start (window-start))
 409            (end (window-end))
 410            (res (hfyview-fontify-win-to win "div" whole-buffer))
 411            (hbuf (nth 0 res)))
 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)
 415       res)))
 416
 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'."
 421   (if (not (listp wt))
 422       (hfyview-fontify-tree-win wt whole-buffers)
 423     (let ((ret))
 424       (dolist (w (cddr wt))
 425         (setq ret (cons (hfyview-fontify-tree w whole-buffers) ret)))
 426       (list (car wt) ret))))
 427
 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'."
 431   (let ((html "")
 432         (css "")
 433         (first (car res))
 434         (td "<td style=\"vertical-align:top;\">")
 435         h)
 436     (cond
 437      ((memq first '(nil t))
 438       (dolist (sub (reverse (cadr res)))
 439         (let* ((fres (hfyview-frame-to-html sub))
 440                (h    (nth 0 fres))
 441                (c    (nth 1 fres)))
 442           (when first (setq h (concat "<tr>\n" h "</tr>\n")))
 443           (setq html (concat html h))
 444           (setq css  (concat css c))))
 445       (unless first
 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"))
 449       )
 450      ((bufferp first)
 451       ;; (buf start end)
 452       (let* ((buf (nth 0 res))
 453              (sta (nth 1 res))
 454              (end (nth 2 res))
 455              (cst (nth 3 res))
 456              (cnd (nth 4 res))
 457              (h
 458               ;;(concat "<td>" "temp" "</td>\n")
 459               (with-current-buffer buf (buffer-substring-no-properties sta end)))
 460              (c
 461               ;;(concat "<td>" "temp" "</td>\n")
 462               (with-current-buffer buf (buffer-substring-no-properties cst cnd))))
 463         (setq h (concat td h
 464                         "</td>\n"))
 465         (setq html (concat html h))
 466         (setq css c)
 467         (kill-buffer buf)))
 468      (t
 469       (error "Uh?")))
 470     (list html css)))
 471
 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\">
 477   <head>
 478     <title>%s</title>
 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; }
 481  --></style>
 482 %s
 483   </head>
 484   <body>\n")
 485
 486 (defvar hfyview-xhtml-footer "</body>\n</html>\n")
 487
 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")))
 492
 493 (defvar hfy-grabbed-echo-content nil)
 494 (defvar hfy-grabbed-minibuffer-content nil)
 495 (defvar hfyview-prompt-face nil)
 496
 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."
 502   (if (and use-grabbed
 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))
 511                        (erase-buffer)
 512                        ;; Fix-me: move the propertize to a new
 513                        ;; copy-buffer in hfy-fontify-buffer. Explained
 514                        ;; in mail to Vivek.
 515                        (insert (propertize str
 516                                            'read-only nil
 517                                            'intangible nil
 518                                            'field nil
 519                                            'modification-hooks nil
 520                                            'insert-in-front-hooks nil
 521                                            'insert-behind-hooks nil
 522                                            'point-entered nil
 523                                            'point-left nil
 524                                            'font-sticky nil
 525                                            'rear-nonsticky nil
 526                                            ))
 527                        (htmlfontify-buffer))))
 528              bdy-start
 529              bdy-end
 530              bdy-txt
 531              css-start
 532              css-end
 533              css-txt)
 534         (with-current-buffer hbuf
 535           (goto-char (point-min))
 536           (search-forward "<style type=\"text/css\"><!--")
 537           (beginning-of-line)
 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)
 552           (setq mini-fg "")
 553         (setq mini-fg (concat "color:" (hfy-triplet mini-fg) "; ")))
 554       (if (eq mini-bg 'unspecified)
 555           (setq mini-bg "")
 556         (setq mini-bg (concat "background:" (hfy-triplet mini-bg) "; ")))
 557       (list nil
 558             (concat
 559              "<span style=\"" mini-fg mini-bg "\">"
 560              "&nbsp;M-x "
 561              "</span>"
 562              "&nbsp;"
 563              "hfyview-frame"
 564              )))))
 565
 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.
 571
 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")
 578                                "white"))
 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"))
 582          html
 583          css
 584          ;; (face-attribute 'minibuffer-prompt :foreground)
 585          (hfyview-prompt-face (plist-get minibuffer-prompt-properties 'face))
 586          minibuf
 587          (frame-width (* 0.56 (frame-width)))
 588          table-style
 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\" />")))
 592          mini-css
 593          mini-html
 594          )
 595     (setq table-style
 596           (format "border: solid %s; width:%sem;"
 597                   (hfyview-wm-border-color)
 598                   frame-width
 599                   ))
 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 "&nbsp;"))
 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)
 609       (erase-buffer)
 610       (insert (format hfyview-xhtml-header
 611                       (concat "Emacs frame dump - " frame-title)
 612                       css)
 613               (if mini-css mini-css "")
 614               (format "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" style=\"%s\">\n" table-style)
 615               "<tr>\n"
 616               (format "<td style=\"%s\">%s&nbsp;&nbsp;%s</td>\n" title-style img-tag
 617                       (hfyview-dekludge-string frame-title))
 618               "</tr>\n"
 619               "<tr>\n"
 620               html
 621               "</tr>\n"
 622               "<tr>\n"
 623               "<td style=\"padding:1px;\">\n"
 624               mini-html
 625               "</td>\n"
 626               "</tr>\n"
 627               "</table>\n"
 628               hfyview-xhtml-footer)
 629       (browse-url-of-buffer)
 630       outbuf)))
 631
 632 (defun hfy-grab-echo-content ()
 633   "Return echo area content."
 634   (setq hfy-grabbed-echo-content (current-message)))
 635
 636 (defun hfy-grab-minibuffer-content ()
 637   "Return minibuffer content."
 638   ;;(interactive)
 639   (let* ((mw (minibuffer-window))
 640          (mb (window-buffer mw)))
 641     (setq hfy-grabbed-minibuffer-content
 642           (with-current-buffer mb
 643               (buffer-substring
 644                (point-min) (point-max)))
 645             )))
 646
 647 ;;(add-hook 'pre-command-hook 'grab-minibuffer-content nil t)
 648 ;;(remove-hook 'pre-command-hook 'grab-minibuffer-content) t)
 649
 650 (provide 'hfyview)
 651 ;;; hfyview.el ends here