org-screenshot.el 20 KB

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