Add new contrib org-screenshot.el
[org-mode.git] / contrib / lisp / org-screenshot.el
blob5cb98ec7855ce43c16be365f45fc9953f30df215
1 ;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
2 ;;
3 ;; Copyright (C) 2009-2013
4 ;; Free Software Foundation, Inc.
5 ;;
6 ;; Author: Max Mikhanosha <max@openchat.com>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
9 ;; Version: 8.0
11 ;; Released under the GNU General Public License version 3
12 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
14 ;; This file is not part of GNU Emacs.
16 ;; This program is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;; Commentary:
32 ;; NOTE: This library requires external screenshot taking executable "scrot",
33 ;; which is available as a package from all major Linux distribution. If your
34 ;; distribution does not have it, source can be found at:
35 ;;
36 ;; http://freecode.com/projects/scrot
38 ;; org-screenshot.el have been tested with scrot version 0.8.
39 ;;
40 ;; Usage:
42 ;; (require 'org-screenshot)
44 ;; Available commands with default bindings
46 ;; `org-screenshot-take' C-c M-s M-t and C-c M-s M-s
47 ;;
48 ;; Take the screenshot, C-u argument delays 1 second, double C-u 2 seconds
49 ;; triple C-u 3 seconds, and subsequent C-u add 2 seconds to the delay.
51 ;; Screenshot area is selected with the mouse, or left-click on the window
52 ;; for an entire window.
53 ;;
54 ;; `org-screenshot-rotate-prev' C-c M-s M-p and C-c M-s C-p
55 ;;
56 ;; Rotate screenshot before the point to one before it (sorted by date)
57 ;;
58 ;; `org-screenshot-rotate-next' C-c M-s M-n and C-c M-s C-n
60 ;; Rotate screenshot before the point to one after it
62 ;; `org-screenshot-show-unused' C-c M-s M-u and C-c M-s u
64 ;; Open dired buffer with screenshots that are not used in current
65 ;; Org buffer marked
67 ;; The screenshot take and rotate commands will update the inline images
68 ;; if they are already shown, if you are inserting first screenshot in the Org
69 ;; Buffer (and there are no other images shown), you need to manually display
70 ;; inline images with C-c C-x C-v
72 ;; Screenshot take and rotate commands offer user to continue by by using single
73 ;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
74 ;; continue rotating screenshots by pressing just the last key of the binding
76 ;; For example: C-c M-s M-t creates the screenshot and then user can
77 ;; repeatedly press M-p or M-n to rotate it back and forth with
78 ;; previously taken ones.
81 (require 'org)
82 (require 'dired)
84 (defgroup org-screenshot nil
85 "Options for taking and managing screen-shots"
86 :tag "Org Startup"
87 :group 'org-link)
89 (defcustom org-screenshot-image-directory "./images/"
90 "Directory in which screenshot image files will be stored, it
91 be automatically created if it does't already exist."
92 :type 'string
93 :group 'org-screenshot)
95 (defcustom org-screenshot-file-name-format "screenshot-%2.2d.png"
96 "The string used to generate screenshot file name.
98 Any %d format string recipe will be expanded with `format'
99 function with the argument of a screenshot sequence number.
101 A sequence like %XXXX will be replaced with string of the same
102 length as there are X's, consisting of random characters in the
103 range of [A-Za-z]."
104 :type 'string
105 :group 'org-screenshot)
107 (defcustom org-screenshot-max-tries 200
108 "Number of times we will try to generate generate filename that
109 does not exist. With default `org-screenshot-name-format' its the
110 limit for number of screenshots, before `org-screenshot-take' is
111 unable to come up with a unique name."
112 :type 'integer
113 :group 'org-screenshot)
115 (defvar org-screenshot-map (make-sparse-keymap)
116 "Map for OrgMode screenshot related commands")
118 ;; prefix
119 (org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
121 ;; Mnemonic is Control-C Meta "Screenshot" "Take"
122 (org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
123 (org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
125 ;; No reason to require meta key, since its our own keymap
126 (org-defkey org-screenshot-map "s" 'org-screenshot-take)
127 (org-defkey org-screenshot-map "t" 'org-screenshot-take)
129 ;; Rotations, the fast rotation user hint, would prefer the modifier
130 ;; used by the original command that started the rotation
131 (org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
132 (org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
133 (org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
134 (org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)
136 ;; Show unused image files in Dired
137 (org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
138 (org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)
141 (random t)
143 (defun org-screenshot-random-string (length)
144 "Generate a random string of LENGTH consisting of random upper
145 case and lower case letters."
146 (let ((name (make-string length ?x)))
147 (dotimes (i length)
148 (let ((n (random 52)))
149 (aset name i (if (< n 26)
150 (+ ?a n)
151 (+ ?A n -26)))))
152 name))
154 (defvar org-screenshot-process nil
155 "Currently running screenshot process")
157 (defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))
159 (defun org-screenshot-update-seq-number (directory &optional reset)
160 "Set `org-screenshot-file-name-format' sequence number for the directory.
161 When RESET is NIL, increments the number stored, otherwise sets
162 RESET as a new number. Intended to be called if screenshot was
163 successful. Updating of sequence number is done in two steps, so
164 aborted/canceled screenshot attempts don't increase the number"
166 (setq directory (file-name-as-directory directory))
167 (puthash directory (if reset
168 (if (numberp reset) reset 1)
169 (1+ (gethash directory
170 org-screenshot-directory-seq-numbers
171 0)))
172 org-screenshot-directory-seq-numbers))
174 (defun org-screenshot-generate-file-name (directory)
175 "Use `org-screenshot-name-format' to generate new screenshot
176 file name for a specific directory. Keeps re-generating name if
177 it already exists, up to `org-screenshot-max-tries'
178 times. Returns just the file, without directory part"
179 (setq directory (file-name-as-directory directory))
180 (when (file-exists-p directory)
181 (let ((tries 0)
182 name
183 had-seq
184 (case-fold-search nil))
185 (while (and (< tries org-screenshot-max-tries)
186 (not name))
187 (incf tries)
188 (let ((tmp org-screenshot-file-name-format)
189 (seq-re "%[-0-9.]*d")
190 (rand-re "%X+"))
191 (when (string-match seq-re tmp)
192 (let ((seq (gethash
193 directory
194 org-screenshot-directory-seq-numbers 1)))
195 (setq tmp
196 (replace-regexp-in-string
197 seq-re (format (match-string 0 tmp) seq)
198 tmp)
199 had-seq t)))
200 (when (string-match rand-re tmp)
201 (setq tmp
202 (replace-regexp-in-string
203 rand-re (org-screenshot-random-string
204 (1- (length (match-string 0 tmp))))
205 tmp t)))
206 (let ((fullname (concat directory tmp)))
207 (if (file-exists-p fullname)
208 (when had-seq (org-screenshot-update-seq-number directory))
209 (setq name tmp)))))
210 name)))
212 (defun org-screenshot-image-directory ()
213 "Return the `org-screenshot-image-directory', ensuring there is
214 trailing slash, and that it exists"
215 (let ((dir (file-name-as-directory org-screenshot-image-directory)))
216 (if (file-exists-p dir)
218 (make-directory dir t)
219 dir)))
221 (defvar org-screenshot-last-file nil
222 "File name of the last taken or rotated screenshot file,
223 without directory")
225 (defun org-screenshot-process-done (process event file
226 orig-buffer
227 orig-delay
228 orig-event)
229 "Called when \"scrot\" process exits. PROCESS and EVENT are
230 same arguments as in `set-process-sentinel'. ORIG-BUFFER,
231 ORIG-DELAY and ORIG-EVENT are Org Buffer, the screenshot delay
232 used, and LAST-INPUT-EVENT values from when screenshot was
233 initiated.
235 (setq org-screenshot-process nil)
236 (with-current-buffer (process-buffer process)
237 (if (not (equal event "finished\n"))
238 (progn
239 (insert event)
240 (cond ((save-excursion
241 (goto-char (point-min))
242 (re-search-forward "Key was pressed" nil t))
243 (ding)
244 (message "Key was pressed, screenshot aborted"))
246 (display-buffer (process-buffer process))
247 (message "Error running \"scrot\" program")
248 (ding))))
249 (with-current-buffer orig-buffer
250 (let ((link (format "[[file:%s]]" file)))
251 (setq org-screenshot-last-file (file-name-nondirectory file))
252 (let ((beg (point)))
253 (insert link)
254 (when org-inline-image-overlays
255 (org-display-inline-images nil t beg (point))))
256 (unless (< orig-delay 3)
257 (ding))
258 (org-screenshot-rotate-continue t orig-event))))))
261 ;;;###autoload
262 (defun org-screenshot-take (&optional delay)
263 "Take a screenshot and insert link to it at point, if image
264 display is already on (see \\[org-toggle-inline-images])
265 screenshot will be displayed as an image
267 Screen area for the screenshot is selected with the mouse, left
268 click on a window screenshots that window, while left click and
269 drag selects a region. Pressing any key cancels the screen shot
271 With `C-u' universal argument waits one second after target is
272 selected before taking the screenshot. With double `C-u' wait two
273 seconds.
275 With triple `C-u' wait 3 seconds, and also rings the bell when
276 screenshot is done, any more `C-u' after that increases delay by
277 2 seconds
279 (interactive "P")
281 ;; probably easier way to count number of C-u C-u out there
282 (setq delay
283 (cond ((null delay) 0)
284 ((integerp delay) delay)
285 ((and (consp delay)
286 (integerp (car delay))
287 (plusp (car delay)))
288 (let ((num 1)
289 (limit (car delay))
290 (cnt 0))
291 (while (< num limit)
292 (setq num (* num 4)
293 cnt (+ cnt (if (< cnt 3) 1 2))))
294 cnt))
295 (t (error "Invald delay"))))
296 (when (and org-screenshot-process
297 (member (process-status org-screenshot-process)
298 '(run stop)))
299 (error "scrot process is still running"))
300 (let* ((name (org-screenshot-generate-file-name (org-screenshot-image-directory)))
301 (file (format "%s%s" (org-screenshot-image-directory)
302 name))
303 (path (expand-file-name file)))
304 (when (get-buffer "*scrot*")
305 (with-current-buffer (get-buffer "*scrot*")
306 (erase-buffer)))
307 (setq org-screenshot-process
308 (or
309 (apply 'start-process
310 (append
311 (list "scrot" "*scrot*" "scrot" "-s" path)
312 (when (plusp delay)
313 (list "-d" (format "%d" delay)))))
314 (error "Unable to start scrot process")))
315 (when org-screenshot-process
316 (if (plusp delay)
317 (message "Click on a window, or select a rectangle (delay is %d sec)..."
318 delay)
319 (message "Click on a window, or select a rectangle..."))
320 (set-process-sentinel
321 org-screenshot-process
322 `(lambda (process event)
323 (org-screenshot-process-done
324 process event ,file ,(current-buffer) ,delay ,last-input-event))))))
326 (defvar org-screenshot-file-list nil
327 "List of files in `org-screenshot-image-directory' used by
328 `org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")
330 (defvar org-screenshot-rotation-index -1)
332 (make-variable-buffer-local 'org-screenshot-file-list)
333 (make-variable-buffer-local 'org-screenshot-rotation-index)
335 (defun org-screenshot-rotation-init (lastfile)
336 "Initialize variable `org-screenshot-file-list' variabel with
337 the list of PNG files in `org-screenshot-image-directory' sorted
338 by most recent first"
339 (setq
340 org-screenshot-rotation-index -1
341 org-screenshot-file-list
342 (let ((files (directory-files org-screenshot-image-directory
343 t (org-image-file-name-regexp) t)))
344 (mapcar 'file-name-nondirectory
345 (sort files
346 (lambda (file1 file2)
347 (let ((mtime1 (nth 5 (file-attributes file1)))
348 (mtime2 (nth 5 (file-attributes file2))))
349 (setq mtime1 (+ (ash (first mtime1) 16)
350 (second mtime1)))
351 (setq mtime2 (+ (ash (first mtime2) 16)
352 (second mtime2)))
353 (> mtime1 mtime2)))))))
354 (let ((n -1) (list org-screenshot-file-list))
355 (while (and list (not (equal (pop list) lastfile)))
356 (incf n))
357 (setq org-screenshot-rotation-index n)))
359 (defun org-screenshot-do-rotate (dir from-continue-rotating)
360 "Rotate last screenshot with one of the previously taken
361 screenshots from the same directory. If DIR is negative, in the
362 other direction"
363 (setq org-screenshot-last-file nil)
364 (let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
365 done
366 (link-re
367 ;; taken from `org-display-inline-images'
368 (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
369 (substring (org-image-file-name-regexp) 0 -2)
370 "\\)\\]"))
371 newfile oldfile)
372 (save-excursion
373 ;; Search for link to image file in the same directory before the point
374 (while (not done)
375 (if (not (re-search-backward link-re (point-min) t))
376 (error "Unable to find link to image from %S directory before point" ourdir)
377 (let ((file (concat (or (match-string 3) "") (match-string 4))))
378 (when (equal (file-name-directory file)
379 ourdir)
380 (setq done t
381 oldfile (file-name-nondirectory file))))))
382 (when (or (null org-screenshot-file-list)
383 (and (not from-continue-rotating)
384 (not (member last-command
385 '(org-screenshot-rotate-prev
386 org-screenshot-rotate-next)))))
387 (org-screenshot-rotation-init oldfile))
388 (unless (> (length org-screenshot-file-list) 1)
389 (error "Can't rotate a single image file"))
390 (replace-match "" nil nil nil 1)
392 (setq org-screenshot-rotation-index
393 (mod (+ org-screenshot-rotation-index dir)
394 (length org-screenshot-file-list))
395 newfile (nth org-screenshot-rotation-index
396 org-screenshot-file-list))
397 ;; in case we started rotating from the file we just inserted,
398 ;; advance one more time
399 (when (equal oldfile newfile)
400 (setq org-screenshot-rotation-index
401 (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
402 (length org-screenshot-file-list))
403 newfile (nth org-screenshot-rotation-index
404 org-screenshot-file-list)))
405 (replace-match (concat "file:" ourdir
406 newfile)
407 t t nil 4))
408 ;; out of save-excursion
409 (setq org-screenshot-last-file newfile)
410 (when org-inline-image-overlays
411 (org-display-inline-images nil t (match-beginning 0) (point)))))
413 ;;;###autoload
414 (defun org-screenshot-rotate-prev (dir)
415 "Rotate last screenshot with one of the previously taken
416 screenshots from the same directory. If DIR is negative, rotate
417 in the other direction"
418 (interactive "p")
419 (org-screenshot-do-rotate dir nil)
420 (when org-screenshot-last-file
421 (org-screenshot-rotate-continue nil nil)))
423 ;;;###autoload
424 (defun org-screenshot-rotate-next (dir)
425 "Rotate last screenshot with one of the previously taken
426 screenshots from the same directory. If DIR is negative, rotate
427 in the other direction"
428 (interactive "p")
429 (org-screenshot-do-rotate (- dir) nil)
430 (when org-screenshot-last-file
431 (org-screenshot-rotate-continue nil nil)))
433 (defun org-screenshot-prefer-same-modifiers (list event)
434 (if (not (eventp nil)) (car list)
435 (let (ret (keys list))
436 (while (and (null ret) keys)
437 (let ((key (car keys)))
438 (if (and (= 1 (length key))
439 (equal (event-modifiers event)
440 (event-modifiers (elt key 0))))
441 (setq ret (car keys))
442 (setq keys (cdr keys)))))
443 (or ret (car list)))))
445 (defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
446 "Display the message with the name of the last changed
447 image-file and inform user that they can rotate by pressing keys
448 bound to `org-screenshot-rotate-next' and
449 `org-screenshot-rotate-prev' in `org-screenshot-map'
451 This works similarly to `kmacro-end-or-call-macro' so that user
452 can press a long key sequence to invoke the first command, and
453 then uses single keys to rotate, until unregognized key is
454 entered, at which point event will be unread"
456 (let* ((event (if from-take-screenshot orig-event
457 last-input-event))
458 done
459 (prev-key
460 (org-screenshot-prefer-same-modifiers
461 (where-is-internal 'org-screenshot-rotate-prev
462 org-screenshot-map nil)
463 event))
464 (next-key
465 (org-screenshot-prefer-same-modifiers
466 (where-is-internal 'org-screenshot-rotate-next
467 org-screenshot-map nil)
468 event))
469 prev-key-str next-key-str)
470 (when (and (= (length prev-key) 1)
471 (= (length next-key) 1))
472 (setq
473 prev-key-str (format-kbd-macro prev-key nil)
474 next-key-str (format-kbd-macro next-key nil)
475 prev-key (elt prev-key 0)
476 next-key (elt next-key 0))
477 (while (not done)
478 (message "%S - '%s' and '%s' to rotate"
479 org-screenshot-last-file prev-key-str next-key-str)
480 (setq event (read-event))
481 (cond ((equal event prev-key)
482 (clear-this-command-keys t)
483 (org-screenshot-do-rotate 1 t)
484 (setq last-input-event nil))
485 ((equal event next-key)
486 (clear-this-command-keys t)
487 (org-screenshot-do-rotate -1 t)
488 (setq last-input-event nil))
489 (t (setq done t))))
490 (when last-input-event
491 (clear-this-command-keys t)
492 (setq unread-command-events (list last-input-event))))))
494 ;;;###autoload
495 (defun org-screenshot-show-unused ()
496 "Open A Dired buffer with unused screenshots marked"
497 (interactive)
498 (let ((files-in-buffer)
499 dired-buffer
500 had-any
501 (image-re (org-image-file-name-regexp))
502 beg end)
503 (save-excursion
504 (save-restriction
505 (widen)
506 (setq beg (or beg (point-min)) end (or end (point-max)))
507 (goto-char beg)
508 (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
509 (substring (org-image-file-name-regexp) 0 -2)
510 "\\)\\]"))
511 (case-fold-search t)
512 old file ov img type attrwidth width)
513 (while (re-search-forward re end t)
514 (setq file (concat (or (match-string 3) "") (match-string 4)))
515 (when (and (file-exists-p file)
516 (equal (file-name-directory file)
517 (org-screenshot-image-directory)))
518 (push (file-name-nondirectory file)
519 files-in-buffer))))))
520 (setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
521 (with-current-buffer dired-buffer
522 (dired-unmark-all-files ?\r)
523 (dired-mark-if
524 (let ((file (dired-get-filename 'no-dir t)))
525 (and file (string-match image-re file)
526 (not (member file files-in-buffer))
527 (setq had-any t)))
528 "Unused screenshot"))
529 (when had-any (pop-to-buffer dired-buffer))))
531 (provide 'org-screenshot)