|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;; eev-sshot.el - hyperlinks to series of screenshots (and tools to take shots)
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;; License: GPL (headers missing at the moment! Sorry...)
;; Version: 2006oct02
;; (First version: 2006sep30)
;; Author home page: <http://angg.twu.net/>
;; IRC: I'm "edrx" at freenode, channels #emacs and #eev.
;; URLs for this file:
;; <http://angg.twu.net/eev-current/eev-sshot.el>
;; <http://angg.twu.net/eev-current/eev-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>
;;
;; This file contains functions for:
;; (1) taking series of (numbered) screenshots in Emacs,
;; (2) producing an HTML "flipbook interface" for viewing them,
;; (3) a minor mode for viewing screenshot series inside Emacs,
;; (4) hyperlinking to a specific screenshot in a series.
;;
;; WARNING: (1) is tricky to run - it requires a prepared Fvwm that
;; reacts to commands sent by FvwmCommand. Finding the geometry of a
;; window, including the window's borders and title bar - that are
;; added by the window manager - is something that depends on the WM,
;; and I've been using Fvwm since the dawn of times and I know
;; practically nothing about other WMs...
;; (Old stuff that I'm rewriting...)
;;
;; 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.
;;
;; Note: compare this with the "stepper" functions of eev:
;; <http://angg.twu.net/eev-current/eev-steps.el.html>
;; the functions there can be thought as hyperlinks to _performing_
;; series of steps; the functions here implement hyperlinks to the
;; _expected result_ of performing series of steps.
;; 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.
;; Save the desired geometry in "/tmp/sshot.geom".
;; WARNING: this depends on Fvwm and is not supposed to be easy to run!
;;
(defvar sshot-geom-file "/tmp/sshot.geom") ; don't change this
(defvar sshot-fname-prefix "/tmp/sshot/test") ; "test_001.png", "_002.png"...
(defvar sshot-next 1) ; next screenshot to save
(defun sshot-save-fvwm-script ()
(write-region "Current Exec sh -c \
'echo $[w.width]x$[w.height]+$[w.x]+$[w.y] > /tmp/sshot.geom'"
nil "/tmp/sshot.geom.fvwm"))
(defun sshot-save-tcl-script ()
(write-region "bind . <Key-q> {
puts [exec FvwmCommand {read /tmp/sshot.geom.fvwm}]; exit
}" nil "/tmp/sshot.geom.tcl"))
(defun sshot-save-geom-fvwm () (sshot-save-fvwm-script) (find-sh0
"FvwmCommand 'read /tmp/sshot.geom.fvwm'"))
(defun sshot-save-geom-tcl () (sshot-save-fvwm-script)
(sshot-save-tcl-script)
(find-sh0 "wish /tmp/sshot.geom.tcl"))
(defun sshot-force-geom (geom) (write-region geom nil "/tmp/sshot.geom"))
(defun sshot-save-geom () (sshot-save-geom-fvwm)) ; redefine this if needed
(defun sshot-geom () (ee-no-trailing-nl (ee-read-file sshot-geom-file)))
;; Take a screenshot.
;; Depends on "import", from ImageMagick.
;;
(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-cursor))
(defun sshot-take () (interactive) (sshot-import) (sshot-next++))
;; Discard the last screenshot taken if it's a duplicate.
;;
(defun sshot-read-file (f) (with-temp-buffer
(insert-file-contents-literally f)
(buffer-string)))
(defun sshot-read-file-n (n) (sshot-read-file (sshot-n-to-fname n)))
(defun sshot-equal-prev () (and (> sshot-next 2)
(equal (sshot-read-file-n (- sshot-next 1))
(sshot-read-file-n (- sshot-next 2)))))
(defun sshot-remove () (setq sshot-next (- sshot-next 1))
(delete-file (sshot-n-to-fname sshot-next)))
(defun sshot-remove* () (while (sshot-equal-prev) (sshot-remove)))
(defun sshot-take-unique () (interactive) (sshot-take) (sshot-remove*))
;; Produce an html "flipbook interface" for the current series of screenshots.
;; Example of output: <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 "←%03d" n))
(defun sshot-prev-href (n) (format "<a href=\"#%03d\">←%03d</a>" n n))
(defun sshot-this-href (n) (format "<a href=\"#%03d\">%03d</a>" n n))
(defun sshot-next-text (n) (format "%03d→" n))
(defun sshot-next-href (n) (format "<a href=\"#%03d\">%03d→</a>" n n))
(defun sshot-image-html (prefix max n) (format "%s\n%s<br>\n%s %s %s<br>\n"
(sshot-aname n)
(sshot-imgsrc prefix n)
(if (<= n 1) (sshot-prev-text (- n 1)) (sshot-prev-href (- n 1)))
(sshot-this-href n)
(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)))
(defun sshot-take+ () (interactive) (sshot-take-unique) (sshot-write-html))
;; (global-set-key (kbd "<print>") 'sshot-take)
;; (global-set-key (kbd "<print>") 'sshot-take-unique)
;; (global-set-key (kbd "<print>") 'sshot-take+)
;; fvwm-sshot:
;; (find-man "1 fvwm" "Key [(window)] Keyname Context Modifiers Function")
;; (find-man "1 fvwm" "Modifiers is any combination")
;; (eefvwm0 "Key Print A N Exec gnudoit '(sshot-take+)'")
;; (eefvwm0 "Key Print A N -")
;; This is how I produced a certain series of screenshots.
;; You are not expected to understand all of this!!!
;; Preparation:
;; (eval-buffer)
;; (set-frame-size (selected-frame) 80 25)
;; (sshot-save-geom-fvwm)
;; (recenter 12)
;; (sshot-init "/tmp/sshot/eesteps")
;; Now we get into the states that are to be "photographed".
;; The keys here are M-e, then 10*<down>, C-e, etc, etc,
;; with <print>s at the right places.
;; (find-efunctiondescr 'eesteps)
;; (sshot-blink)
;; (sshot-write-html)
;; Here's how to view that series of screenshots inside Emacs:
;; (find-fline (sshot-dir))
;; (find-fline "/tmp/sshot/")
;; (find-sshot "/tmp/sshot/eesteps" 1)
;;
;; And here's how to download one such series of screenshots
;; (instead of producing it locally):
;; mkdir -p /tmp/flipbooks/
;; cd /tmp/flipbooks/
;; wget http://angg.twu.net/flipbooks/eesteps.tgz
;; tar -xvzf eesteps.tgz
;; Now to view it:
;; (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-key sshot-view-mode-map (kbd "q") 'sshot-bury-all)
(define-minor-mode sshot-view-mode
"Navigate through screenshots with <left> and <right>."
nil " sshot-view" sshot-view-mode-map)
(defvar sshot-this nil) ; like sshot-next
(defvar sshot-view-prefix nil) ; like sshot-fname-prefix
(make-variable-buffer-local 'sshot-this)
(make-variable-buffer-local 'sshot-view-prefix)
(defun sshot-message () "sshot-view-mode - navigate with <left>, <right>, q")
(defun sshot-pn-to-fname (p n) (format "%s_%03d.png" p n))
(defun sshot-exists-p (p n) (file-exists-p (sshot-pn-to-fname p n)))
(defun sshot-not-found (p n) (error "Not found: %s" (sshot-pn-to-fname p n)))
(defun sshot-assert (p n) (or (sshot-exists-p p n) (sshot-not-found p n)))
(defun sshot-open (p n) (sshot-assert p n)
(find-file (sshot-pn-to-fname p n))
(sshot-view-mode 1)
(setq sshot-view-prefix p sshot-this n)
(message (sshot-message)))
(defun sshot-open-prev () (interactive)
(sshot-open sshot-view-prefix (- sshot-this 1)))
(defun sshot-open-next () (interactive)
(sshot-open sshot-view-prefix (+ sshot-this 1)))
(defun sshot-bury-all () (interactive) (let ((p sshot-view-prefix))
(if p (while (equal p sshot-view-prefix)
(bury-buffer)))))
(defun find-sshot (p n) (sshot-open p n) (sshot-message))
(provide 'eev-sshot)