Download
(defvar screenshot-version "$Id: screenshot.el,v 1.9 2010/05/04 08:59:08 rubikitch Exp $")
(eval-when-compile (require 'cl))
(require 'yaoddmuse nil t)
(defgroup screenshot nil
"screenshot"
:group 'external)
(defcustom screenshot-schemes
'(("local"
:dir "~/images/")
("current-directory"
:dir default-directory)
("remote-ssh"
:dir "/tmp/"
:ssh-dir "www.example.org:public_html/archive/"
:url "http://www.example.org/archive/")
("EmacsWiki"
:dir "~/.yaoddmuse/EmacsWiki/"
:yaoddmuse "EmacsWiki")
("local-server"
:dir "~/public_html/"
:url "http://127.0.0.1/"))
"*Screenshot configuration list."
:type 'list
:group 'screenshot)
(defcustom screenshot-default-scheme nil
"*Default scheme name of screenshot.el.
If nil, the last-used scheme is used."
:type 'string
:group 'screenshot)
(defcustom screenshot-take-delay 0.5
"*Delay time to take a screenshot.
It is recommend to have a delay time to enable us to take a screenshot other than emacs."
:type 'float
:group 'screenshot)
(defvar screenshot-image-filename nil)
(defvar screenshot-current-scheme nil)
(defvar screenshot-prepare-minor-mode nil)
(defvar screenshot-last-scheme-name nil)
(defvar screenshot-prepare-minor-mode-map (make-sparse-keymap))
(define-key screenshot-prepare-minor-mode-map "\C-c\C-c" 'screenshot-take)
(add-to-list 'minor-mode-map-alist
(cons 'screenshot-prepare-minor-mode screenshot-prepare-minor-mode-map))
(defun screenshot (filename &optional scheme nomsg)
"Prepare to take a screenshot to FILENAME with SCHEME.
After pressing C-c C-c, executing `screenshot-take'.
See also `screenshot-take' docstring. "
(interactive "sScreenshot image filename: ")
(unless scheme
(setq scheme (if (>= emacs-major-version 23)
(completing-read "Scheme: " (mapcar 'car screenshot-schemes)
nil t (or screenshot-default-scheme
screenshot-last-scheme-name))
(completing-read "Scheme: " (mapcar 'car screenshot-schemes)
nil t nil nil (or screenshot-default-scheme
screenshot-last-scheme-name)))))
(setq screenshot-last-scheme-name scheme)
(setq screenshot-current-scheme (cdr (assoc scheme screenshot-schemes)))
(setq screenshot-image-filename
(expand-file-name
filename
(screenshot-get-directory (plist-get screenshot-current-scheme :dir))))
(if (and (file-exists-p screenshot-image-filename)
(y-or-n-p (format "%s already exists. Retry? " screenshot-image-filename)))
(call-interactively 'screenshot)
(setq screenshot-prepare-minor-mode t)
(or nomsg (message "Press C-c C-c to take a screenshot!"))))
(defun screenshot-take ()
"Take a screenshot configured by `screenshot' command.
- Taking a screenshot is delayed by `screenshot-take-delay'.
- Execute import command (ImageMagick).
- If the scheme has :ssh-dir property, use scp to send image to remote host.
It is executed asynchronously to suppress a wait.
- Finally put the image URL or filename to kill-ring.
Press C-y to input the image URL.
If the scheme has :yaoddmuse, [[image:FileName]] is yanked.
"
(interactive)
(run-with-idle-timer screenshot-take-delay nil 'screenshot-take-internal))
(defun screenshot-get-directory (arg)
(cond ((stringp arg) arg)
((boundp arg) (symbol-value arg))
((functionp arg) (funcall arg))))
(defun screenshot-take-internal ()
(screenshot-do-import screenshot-image-filename)
(setq screenshot-prepare-minor-mode nil)
(let (dir url wiki pagename)
(cond ((setq dir (plist-get screenshot-current-scheme :ssh-dir))
(screenshot-do-scp screenshot-image-filename dir))
((setq wiki (plist-get screenshot-current-scheme :yaoddmuse))
(yaoddmuse-post-file screenshot-image-filename wiki
(setq pagename
(file-name-sans-extension
(file-name-nondirectory screenshot-image-filename)))
"Screenshot by screenshot.el")))
(let ((img-url (cond ((setq url (plist-get screenshot-current-scheme :url))
(concat url (file-name-nondirectory screenshot-image-filename)))
(pagename
(format "[[image:%s]]" pagename))
(t
screenshot-image-filename))))
(kill-new img-url)
(message "Image URL: %s" img-url))))
(defun screenshot-do-import (filename)
(call-process "import" nil nil nil filename))
(defun screenshot-do-scp (filename dir)
(start-process "scp" "scp" "scp" filename dir))
(defvar screenshot-maintainer-mail-address
(concat "rubiki" "tch@ru" "by-lang.org"))
(defvar screenshot-bug-report-salutation
"Describe bug below, using a precise recipe.
When I executed M-x ...
How to send a bug report:
1) Be sure to use the LATEST version of screenshot.el.
2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t)
3) Use Lisp version instead of compiled one: (load \"screenshot.el\")
4) If you got an error, please paste *Backtrace* buffer.
5) Type C-c C-c to send.
# If you are a Japanese, please write in Japanese:-)")
(defun screenshot-send-bug-report ()
(interactive)
(reporter-submit-bug-report
screenshot-maintainer-mail-address
"screenshot.el"
(apropos-internal "^screenshot-" 'boundp)
nil nil
screenshot-bug-report-salutation))
(dont-compile
(when (fboundp 'expectations)
(expectations
(desc "screenshot")
(expect "/path/to/test.png"
(let ((screenshot-schemes '(("local" :dir "/path/to/")))
screenshot-prepare-minor-mode)
(screenshot "test.png" "local")
screenshot-image-filename))
(expect '(:dir "/path/to/")
(let ((screenshot-schemes '(("local" :dir "/path/to/")))
screenshot-prepare-minor-mode)
(screenshot "test.png" "local")
screenshot-current-scheme))
(expect t
(let ((screenshot-schemes '(("local" :dir "/path/to/")))
screenshot-prepare-minor-mode)
(screenshot "test.png" "local")
screenshot-prepare-minor-mode))
(expect "local"
(let (screenshot-default-scheme
(screenshot-schemes '(("local" :dir "/path/to/")))
screenshot-prepare-minor-mode)
(screenshot "test.png" "local")
screenshot-last-scheme-name))
(desc "screenshot-get-directory")
(expect "/path/to/"
(screenshot-get-directory "/path/to/"))
(expect "/images/"
(let ((default-directory "/images/"))
(screenshot-get-directory 'default-directory)))
(expect "/img/"
(flet ((getdir () "/img/"))
(screenshot-get-directory 'getdir)))
(desc "screenshot-take-internal")
(expect (mock (screenshot-do-import "/path/to/test.png"))
(let ((screenshot-image-filename "/path/to/test.png"))
(screenshot-take-internal)))
(expect nil
(stub screenshot-do-import)
screenshot-prepare-minor-mode)
(expect (mock (kill-new "/path/to/test.png"))
(stub screenshot-do-import)
(let ((screenshot-image-filename "/path/to/test.png"))
(screenshot-take-internal)))
(expect (mock (screenshot-do-scp "/path/to/test.png" "remote:pulic_html/archive/"))
(stub screenshot-do-import)
(stub kill-new)
(let ((screenshot-image-filename "/path/to/test.png")
(screenshot-current-scheme '(:dir "/path/to/"
:ssh-dir "remote:pulic_html/archive/"
:url "http://www.example.com/archive/")))
(screenshot-take-internal)))
(expect (mock (kill-new "http://www.example.com/archive/test.png"))
(stub screenshot-do-import)
(stub screenshot-do-scp)
(let ((screenshot-image-filename "/path/to/test.png")
(screenshot-current-scheme '(:dir "/path/to/"
:ssh-dir "remote:pulic_html/archive/"
:url "http://www.example.com/archive/")))
(screenshot-take-internal)))
(desc "post with yaoddmuse")
(expect (mock (yaoddmuse-post-file
"/path/to/TestImage.png" "EmacsWiki"
"TestImage" "Screenshot by screenshot.el"))
(stub screenshot-do-import)
(stub screenshot-do-scp)
(let ((screenshot-image-filename "/path/to/TestImage.png")
(screenshot-current-scheme '(:dir "/path/to/"
:yaoddmuse "EmacsWiki")))
(screenshot-take-internal)))
(expect (mock (kill-new "[[image:TestImage]]"))
(stub screenshot-do-import)
(stub screenshot-do-scp)
(stub yaoddmuse-post-file)
(let ((screenshot-image-filename "/path/to/TestImage.png")
(screenshot-current-scheme '(:dir "/path/to/"
:yaoddmuse "EmacsWiki")))
(screenshot-take-internal)))
)))
(provide 'screenshot)