;; sshot.el - take screenshots of Emacs windows, view screenshots.
;; Author:  Eduardo Ochs <eduardoochs@gmail.com>
;; Version: 2006sep30 / 2006oct02
;; Home page: <http://angg.twu.net/>
;; IRC:     I'm "edrx" at freenode (channels #emacs and #eev).
;; License: GPL (yeah, I know, the legalese is missing! Sorry...)
;; URLs for this file:
;;   <http://angg.twu.net/elisp/sshot.el>
;;   <http://angg.twu.net/elisp/sshot.el.html>
;; Examples of output (in html flipbook format):
;;   <http://angg.twu.net/flipbooks/eesteps.html>
;;   <http://angg.twu.net/flipbooks/ee-glyph.html>
;;
;; Functions for taking series of (numbered) screenshots in Emacs.
;; Status: WARNING! This file is very recent, and at present only its
;; middle part ("view screenshots") is supposed to be easy to run...
;; The first part - that produce series of screenshots - and the third
;; part - that produce an html "interface" for viewing a series of
;; screenshots - depend heavily on eev, and I'm intending to use them
;; to make some of the ideas behind eev clearer. You are encouraged to
;; play with all parts, of course, but (1) beware the risk of
;; frustration if you're gonna play with parts 1 and 3, and (2) please
;; contact me if you have any questions or comments, no matter how
;; silly... My nickname is "edrx" and I'm often at the channels #emacs
;; and #eev at freenode. Cheers!
;;
;; The "take screenshots" part requires fvwm with eev support to get
;; the geometry of the Emacs window window (`sshot-save-geom-fvwm'),
;; and ImageMagick to generate the pngs; you can bypass the dependency
;; on fvwm if you have other ways to write the geometry of the region
;; to take screenshots of to the file /tmp/sshot.geom. See:
;;   <http://angg.twu.net/eev-current/eev-langs.el.html#eefvwm>
;; Note: if you find other ways to get the geometry please tell me!!!
;;
;; The "view screenshots" part requires just a graphical Emacs.
;; Navigation through the screenshots in sshot-view-mode is done with
;; the keys <left> and <right>. This is better than watching passively
;; the animations in <http://angg.twu.net/eev-current/anim/> because:
;;   (1) png screenshots can be viewed inside Emacs,
;;   (2) they doesn't require a browser and a Flash plugin,
;;   (3) you can "move forward and backward in time" though them,
;;   (4) you can spend as much or as little time as you wish in each
;;       screenshot,
;;   (5) you can create hyperlinks to specific shots with `find-sshot'.
;;
;; The "html flipbooks" part generates HTML pages like these:
;;   <http://angg.twu.net/flipbooks/eesteps.html>
;;   <http://angg.twu.net/flipbooks/ee-glyph.html>
;; You won't need to run it unless you are creating your own series of
;; screenshots - but for that you will need fvwm, etc.
;;
;; KNOWN BUG: sometimes typing the key for `sshot-take' (i.e.,
;; "<print>") once will take two screenshots instead of one... I don't
;; know why that happens, and my current workaround is a hackish
;; script to removes duplicates:
;;   <http://angg.twu.net/bin/sshot-uniq.lua.html>
;;   <http://angg.twu.net/.emacs.html#sshot>

;; The style of this file is reminiscent of my Forth roots.


;; Take screenshots.
;;
(defvar sshot-geom-file    "/tmp/sshot.geom")
(defvar sshot-fname-prefix "/tmp/sshot/test") ;; "test_001.png", "_002.png"...
(defvar sshot-next         1)

(defun sshot-save-geom-fwvm ()
  (eefvwm0
   (format
    "Current Exec sh -c '%s > %s'"
    "echo $[w.width]x$[w.height]+$[w.x]+$[w.y]"
    (ee-expand sshot-geom-file))))
(defun sshot-save-geom  () (sshot-save-geom-fwvm))
(defun sshot-geom       () (ee-no-trailing-nl (ee-read-file sshot-geom-file)))
(defun sshot-n-to-fname (n) (format "%s_%03d.png" sshot-fname-prefix n))
(defun sshot-fname-next () (sshot-n-to-fname sshot-next))
(defun sshot-import-cmd ()
  (format "import -window root -crop %s %s" (sshot-geom) (sshot-fname-next)))
(defun sshot-import     () (find-sh0 (sshot-import-cmd)))
(defun sshot-next++     () (setq sshot-next (1+ sshot-next)))
(defun sshot-dir        () (file-name-directory sshot-fname-prefix))
(defun sshot-mkdir      () (make-directory (file-name-directory (sshot-dir)) t))
(defun sshot-fname-*png () (concat sshot-fname-prefix "*.png"))
(defun sshot-rm-v-shots () (find-sh0 (format "rm -v %s" (sshot-fname-*png))))
(defun sshot-next=1     () (setq sshot-next 1))
(defun sshot-cursor     () (blink-cursor-mode 0))
(defun sshot-blink      () (blink-cursor-mode 1))
(defun sshot-init (prefix) (interactive) (setq sshot-fname-prefix prefix)
                           (sshot-rm-v-shots) (sshot-mkdir) (sshot-next=1)
                           (sshot-save-geom) (sshot-cursor))
(defun sshot-take       () (interactive) (sshot-import) (sshot-next++))
(global-set-key (kbd "<print>") 'sshot-take)

;; A test, or: "this is how I produce a certain series of screenshots".
;; You are not expected to understand all of this!!!
;;   (eval-buffer)
;;   (set-frame-size (selected-frame) 80 25)
;;   (recenter 12)
;;   (sshot-init "/tmp/sshot/eesteps")
;;   (find-efunctiondescr 'eesteps)
;;   (sshot-blink)
;;   (sshot-write-html)
;; For viewing them:
;;   (find-fline (sshot-dir))
;;   (find-fline "/tmp/sshot/")
;;   (find-sshot "/tmp/sshot/eesteps" 1)




;; View screenshots in Emacs.
;; Here's a way to try the viewer:
;;   mkdir -p /tmp/flipbooks/
;;   cd       /tmp/flipbooks/
;;   wget http://angg.twu.net/flipbooks/eesteps.tgz
;;   tar -xvzf eesteps.tgz
;; and then:
;;   (find-sshot "/tmp/flipbooks/eesteps" 1)
;;
(defvar sshot-view-mode-map (make-sparse-keymap))
(define-key sshot-view-mode-map (kbd "<left>")  'sshot-open-prev)
(define-key sshot-view-mode-map (kbd "<right>") 'sshot-open-next)
(define-minor-mode sshot-view-mode
  "Navigate through screenshots with <left> and <right>."
  nil " sshot-view" sshot-view-mode-map)

(defvar sshot-this nil)
(make-variable-buffer-local 'sshot-this)
(defun sshot-exists-p   (n) (file-exists-p (sshot-n-to-fname n)))
(defun sshot-not-found  (n) (error "Not found: %s" (sshot-n-to-fname n)))
(defun sshot-assert     (n) (or (sshot-exists-p n) (sshot-not-found n)))
(defun sshot-open       (n) (sshot-assert n) (find-file (sshot-n-to-fname n))
                            (sshot-view-mode 1) (setq sshot-this n))
(defun sshot-open-prev  ()  (interactive) (sshot-open (- sshot-this 1)))
(defun sshot-open-next  ()  (interactive) (sshot-open (+ sshot-this 1)))
(defun find-sshot       (prefix n) (setq sshot-fname-prefix prefix)
                            (sshot-open n))




;; Html flipbooks.
;; This is used to make the html thingies to view series of
;; screenshots, like this one:
;;   <http://angg.twu.net/flipbooks/eesteps.html>
;;
(defun sshot-aname      (n) (format "<a name=\"%03d\"></a>" n))
(defun sshot-imgsrc     (pr n) (format "<img src=\"%s_%03d.png\">" pr n))
(defun sshot-prev-text  (n) (format                   "&larr;%03d"       n))
(defun sshot-prev-href  (n) (format "<a href=\"#%03d\">&larr;%03d</a>" n n))
(defun sshot-next-text  (n) (format                   "%03d&rarr;"       n))
(defun sshot-next-href  (n) (format "<a href=\"#%03d\">%03d&rarr;</a>" n n))
(defun sshot-image-html (prefix max n) (format "%s\n%s<br>\n%s %s<br>\n"
       (sshot-aname n)
       (sshot-imgsrc prefix n)
       (if (<= n 1)   (sshot-prev-text (- n 1)) (sshot-prev-href (- n 1)))
       (if (>= n max) (sshot-next-text (+ n 1)) (sshot-next-href (+ n 1)))))
(defun sshot-images-html (prefix max) (mapconcat
                            (lambda (n) (sshot-image-html prefix max n))
                            (number-sequence 1 max)
                            "<br>\n\n"))
(defun sshot-html-wrap   (title body tail)
          (format "<html>\n%s\n%s</html>\n"
           (format "<head>\n<title>%s</title>\n</head>" title)
           (format "<body bgcolor=\"#4C4C4C\">\n\n%s\n%s\n</body>" body tail)))
(defun sshot-mkstr (s n) (mapconcat (lambda (n) s) (number-sequence 1 n) ""))
(defun sshot-html-3      (title prefix max) (sshot-html-wrap title
                                             (sshot-images-html prefix max)
                                             (sshot-mkstr "<br>\n" 40)))
(defun sshot-stem       () (file-name-nondirectory sshot-fname-prefix))
(defun sshot-fname-html () (format "%s.html" sshot-fname-prefix))
(defun sshot-title-html () (format "flipbook: %s" (sshot-stem)))
(defun sshot-html-0     () (sshot-html-3 (sshot-title-html) (sshot-stem)
                                         (- sshot-next 1)))
(defun sshot-write-html () (write-region (sshot-html-0) nil (sshot-fname-html)))




(provide 'sshot)