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