contrib/lisp/org-screenshot.el

   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
  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 <http://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 does'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         (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                     (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 "Invald 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 (plusp delay)
 311                      (list "-d" (format "%d" delay)))))
 312            (error "Unable to start scrot process")))
 313     (when org-screenshot-process
 314       (if (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' variabel 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       (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 (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)