contrib/lisp/org-screenshot.el

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