org-screenshot.el 20 KB

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