emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* RFQ - new contribution - org-screenshot.el
@ 2013-05-17  3:21 Max Mikhanosha
  2013-05-17  6:13 ` Bastien
                   ` (5 more replies)
  0 siblings, 6 replies; 26+ messages in thread
From: Max Mikhanosha @ 2013-05-17  3:21 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 592 bytes --]

Hi All,

I've been writing some documentation in OrgMode with screenshots, and
as with any screenshot taking, it takes a while to get one just right.

A few tiny helper utilities, quickly snowballed into this :-) It may
need some cleanup, but IMHO its too awesome not to share it with the
list.

To try it out, you'll need /usr/bin/scrot which is available as
"scrot" package on most distributions.

Then (require 'org-screenshot) and try C-c M-s (org-screenshot-take) in an Org File. Make
sure to turn on inline image display (C-c C-x C-v) after taking the
first screenshot.

Regards,
 Max


[-- Attachment #2: org-screenshot.el --]
[-- Type: application/octet-stream, Size: 19741 bytes --]

;;; org-screenshot.el --- take and manage screenshots from Org buffer
;;
;; Copyright (C) 2009-2013
;;   Free Software Foundation, Inc.
;;
;; Author: Max Mikhanosha <max@openchat.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 8.0
;;
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; NOTE: This library requires external screenshot taking executable "scrot",
;; which is available as a package from all major Linux distribution. If your
;; distribution does not have it, source can be found at:
;; 
;; http://freecode.com/projects/scrot
;;
;; org-screenshot.el have been tested with scrot version 0.8.
;; 
;; Usage:
;;
;;   (require 'org-screenshot)
;;
;;  Available commands with default bindings
;;
;;  `org-screenshot-take'              C-c M-s M-s   and
;;  
;;        Takes the screenshot
;;        
;;  `org-screenshot-rotate-prev'       C-c M-s M-p   and C-c M-s C-p
;;  
;;        Rotate screenshot before the point to one before it
;;        
;;  `org-screenshot-rotate-next'       C-c M-s M-n   and C-c M-s C-n
;;
;;        Rotate screenshot before the point to one after it
;;
;;  `org-screenshot-show-unused'       C-c M-s M-u   and C-c M-s u
;;
;;        Open dired buffer with screenshots that are not used in current
;;        Org buffer marked
;;
;; The screenshot take and rotate commands will update the inline images
;; if they are already shown, if you are inserting first screenshot in the Org
;; Buffer (and there are no other images shown), you need to manually display
;; inline images with C-c C-x C-v
;;
;; Screenshot take and rotate commands offer user to continue by by using single
;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
;; continue rotating screenshots by pressing just the last key of the binding
;;
;; For example: C-c M-s M-t    creates the screenshot
;; and then user can repeatedly press M-p or M-n to rotate it back and forth
;; with previously taken ones.
;;

(random t)

(defun org-screenshot-random-string (length)
  "Return string of LENGTH consisting of random upper case and
lower case letters."
  (let ((name (make-string length ?x)))
    (dotimes (i length)
      (let ((n (random 52)))
        (aset name i (if (< n 26)
                         (+ ?a n)
                       (+ ?A n -26))))) 
    name))

(defvar org-screenshot-process nil
  "Currently running screenshot process")

(defvar org-screenshot-image-directory "./images/"
  "Directory where to store images, will be created if does not exist")

(defvar org-screenshot-file-name-format "screenshot-%2.2d.png"
  "The string used to for screenshot file name.

If it contains the %d it will be replaced with a sequence
number (formatted by %d passed to `format' function with sequence
number as argument)

If it contains %XXXX then it will be replaced with random string
each X being a random upper or lower case character.")

(defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))

(defvar org-screenshot-max-tries 100
  "Number of time screenshot name generation will be re-tried if
file happen to exist in a directory. With default `org-screenshot-name-format'
its as many screenshots that can exist in a directory as ")

(defun org-screenshot-update-seq-number (directory &optional reset)
  "Set `org-screenshot-file-name-format' sequence number for the directory.
When RESET is NIL, increments the number stored, otherwise sets
RESET as a new number. Intended to be called if screenshot was
successful.  Updating of sequence number is done in two steps, so
aborted/canceled screenshot attempts don't increase the number"

  (setq directory (file-name-as-directory directory))
  (puthash directory (if reset
                         (if (numberp reset) reset 1)
                       (1+ (gethash directory
                                    org-screenshot-directory-seq-numbers
                                    0)))
           org-screenshot-directory-seq-numbers))

(defun org-screenshot-generate-file-name (directory)
  "Return the generated screenshot file name. Keeps re-generating
names if they exist in the DIRECTORY, up to
`org-screenshot-max-tries' times.  Returns just the filename,
without directory"
  (setq directory (file-name-as-directory directory))
  (when (file-exists-p directory)
    (let ((tries 0)
          name
          had-seq
          (case-fold-search nil))
      (while (and (< tries org-screenshot-max-tries)
                  (not name))
        (incf tries)
        (let ((tmp org-screenshot-file-name-format)
              (seq-re "%[-0-9.]*d")
              (rand-re "%X+"))
          (when (string-match seq-re tmp)
            (let ((seq (gethash
                        directory
                        org-screenshot-directory-seq-numbers 1))) 
              (setq tmp 
                    (replace-regexp-in-string
                     seq-re (format (match-string 0 tmp) seq)
                     tmp)
                    had-seq t)))
          (when (string-match rand-re tmp)
            (setq tmp
                  (replace-regexp-in-string
                   rand-re (org-screenshot-random-string
                            (1- (length (match-string 0 tmp))))
                   tmp t)))
          (let ((fullname (concat directory tmp))) 
            (if (file-exists-p fullname)
                (when had-seq (org-screenshot-update-seq-number directory))
              (setq name tmp)))))
      name)))

(defun org-screenshot-image-directory ()
  "Return the images directory, ensuring there is trailing
slash. Creates it if necessary"
  (let ((dir (file-name-as-directory org-screenshot-image-directory)))
    (if (file-exists-p dir)
        dir
      (make-directory dir t)
      dir)))

(defvar org-screenshot-last-file nil "File name of the last
screenshot, without directory")

(defun org-screenshot-process-done (process event file
                                            orig-buffer
                                            orig-delay
                                            orig-event)
  (setq org-screenshot-process nil)
  (with-current-buffer (process-buffer process) 
    (if (not (equal event "finished\n"))
        (progn 
          (insert event) 
          (cond ((save-excursion
                   (goto-char (point-min))
                   (re-search-forward "Key was pressed" nil t))
                 (ding)
                 (message "Key was pressed, screenshot aborted"))
                (t 
                 (display-buffer (process-buffer process))
                 (message "Error running \"scrot\" program")
                 (ding))))
      (with-current-buffer orig-buffer 
        (let ((link (format "[[file:%s]]" file))) 
          (setq org-screenshot-last-file (file-name-nondirectory file))
          (let ((beg (point)))
            (insert link) 
            (when org-inline-image-overlays
              (org-display-inline-images nil t beg (point))))
          (unless (< orig-delay 3)
            (ding))
          (org-screenshot-rotate-continue t orig-event))))))

(defun org-screenshot-take (&optional delay)
  "Take a screenshot and insert link to it at point, if display
inline images is on, screenshot will be immediately displayed as
a picture.

Screen area for the screenshot is selected with the mouse, left
click on a window screenshots that window, while left click and
drag selects a region. Pressing any key cancels the screen shot

With `C-u' wait one second after target is selected before taking
the screenshot. With double `C-u' wait two seconds.

With triple `C-u' wait 3 seconds, and also `ding' when screenshot
is done, any more `C-u' after that increases delay by 2 seconds.

When called non-interactively delay could be "
  (interactive "P")

  ;; probably easier way to count number of C-u C-u out there
  (setq delay
        (cond ((null delay) 0)
              ((integerp delay) delay)
              ((and (consp delay)
                    (integerp (car delay))
                    (plusp (car delay)))
               (let ((num 1)
                     (limit (car delay))
                     (cnt 0))
                 (while (< num limit)
                   (setq num (* num 4)
                         cnt (+ cnt (if (< cnt 3) 1 2))))
                 cnt))
              (t (error "Invald delay"))))
  (when (and org-screenshot-process
             (member (process-status org-screenshot-process)
                     '(run stop)))
    (error "scrot process is still running"))
  (let* ((name (org-screenshot-generate-file-name (org-screenshot-image-directory)))
         (file (format "%s%s" (org-screenshot-image-directory)
                       name))
         (path (expand-file-name file)))
    (when (get-buffer "*scrot*")
      (with-current-buffer (get-buffer "*scrot*")
        (erase-buffer)))
    (setq org-screenshot-process
          (or 
           (apply 'start-process
                  (append
                   (list "scrot" "*scrot*" "scrot" "-s" path)
                   (when (plusp delay)
                     (list "-d" (format "%d" delay)))))
           (error "Unable to start scrot process")))
    (when org-screenshot-process 
      (if (plusp delay) 
          (message "Click on a window, or select a rectangle (delay is %d sec)..."
                   delay)
        (message "Click on a window, or select a rectangle..."))
      (set-process-sentinel
       org-screenshot-process
       `(lambda (process event)
          (org-screenshot-process-done
           process event ,file ,(current-buffer) ,delay ,last-input-event))))))

(defvar org-screenshot-map (make-sparse-keymap)
  "Map for OrgMode screenshot related commands")
(org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
;; mnemonic (s)creen(s)shot or (s)creenshot (t)ake
(org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
(org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
;; No reason to require meta key
(org-defkey org-screenshot-map "s" 'org-screenshot-take)
(org-defkey org-screenshot-map "t" 'org-screenshot-take)

(org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
(org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
(org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
(org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)


(org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
(org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)

(defvar org-screenshot-file-list nil
  "List of files in `org-screenshot-image-directory' used by
`org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")

(defvar org-screenshot-rotation-index -1)

(make-variable-buffer-local 'org-screenshot-file-list)
(make-variable-buffer-local 'org-screenshot-rotation-index)

(defun org-screenshot-rotation-init (lastfile)
  "Initialize variable `org-screenshot-file-list' variabel with
the list of PNG files in `org-screenshot-image-directory' sorted
by most recent first"
  (setq
   org-screenshot-rotation-index -1
   org-screenshot-file-list
   (let ((files (directory-files org-screenshot-image-directory
                                 t (org-image-file-name-regexp) t)))
     (mapcar 'file-name-nondirectory 
             (sort files
                   (lambda (file1 file2)
                     (let ((mtime1 (nth 5 (file-attributes file1)))
                           (mtime2 (nth 5 (file-attributes file2))))
                       (setq mtime1 (+ (ash (first mtime1) 16)
                                       (second mtime1)))
                       (setq mtime2 (+ (ash (first mtime2) 16)
                                       (second mtime2)))
                       (> mtime1 mtime2)))))))
  (let ((n -1) (list org-screenshot-file-list))
    (while (and list (not (equal (pop list) lastfile)))
      (incf n))
    (setq org-screenshot-rotation-index n)))

(defun org-screenshot-do-rotate (dir from-continue-rotating)
  "Rotate last screenshot with one of the previously taken
screenshots from the same directory. If DIR is negative, in the
other direction"
  (setq org-screenshot-last-file nil)
  (let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
         done
         (link-re 
          ;; taken from `org-display-inline-images'
          (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
                  (substring (org-image-file-name-regexp) 0 -2)
                  "\\)\\]"))
         newfile oldfile)
    (save-excursion 
      ;; Search for link to image file in the same directory before the point
      (while (not done)
        (if (not (re-search-backward link-re (point-min) t))
            (error "Unable to find link to image from %S directory before point" ourdir)
          (let ((file (concat (or (match-string 3) "") (match-string 4))))
            (when (equal (file-name-directory file)
                         ourdir)
              (setq done t
                    oldfile (file-name-nondirectory file))))))
      (when (or (null org-screenshot-file-list)
                (and (not from-continue-rotating) 
                     (not (member last-command
                                  '(org-screenshot-rotate-prev
                                    org-screenshot-rotate-next)))))
        (org-screenshot-rotation-init oldfile))
      (unless (> (length org-screenshot-file-list) 1)
        (error "Can't rotate a single image file"))
      (replace-match "" nil nil nil 1)

      (setq org-screenshot-rotation-index
            (mod (+ org-screenshot-rotation-index dir)
                 (length org-screenshot-file-list)) 
            newfile (nth org-screenshot-rotation-index
                         org-screenshot-file-list))
      ;; in case we started rotating from the file we just inserted,
      ;; advance one more time
      (when (equal oldfile newfile)
        (setq org-screenshot-rotation-index
              (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
                   (length org-screenshot-file-list))
              newfile (nth org-screenshot-rotation-index
                           org-screenshot-file-list)))
      (replace-match (concat "file:" ourdir
                             newfile)
                     t t nil 4))
    ;; out of save-excursion
    (setq org-screenshot-last-file newfile)
    (when org-inline-image-overlays
      (org-display-inline-images nil t (match-beginning 0) (point)))))

(defun org-screenshot-rotate-prev (dir)
  "Rotate last screenshot with one of the previously taken
screenshots from the same directory. If DIR is negative, rotate
in the other direction"
  (interactive "p")
  (org-screenshot-do-rotate dir nil)
  (when org-screenshot-last-file 
    (org-screenshot-rotate-continue nil nil)))

(defun org-screenshot-rotate-next (dir)
  "Rotate last screenshot with one of the previously taken
screenshots from the same directory. If DIR is negative, rotate
in the other direction"
  (interactive "p")
  (org-screenshot-do-rotate (- dir) nil)
  (when org-screenshot-last-file 
    (org-screenshot-rotate-continue nil nil)))

(defun org-screenshot-prefer-same-modifiers (list event)
  (if (not (eventp nil)) (car list) 
    (let (ret (keys list))
      (while (and (null ret) keys)
        (let ((key (car keys))) 
          (if (and (= 1 (length key)) 
                   (equal (event-modifiers event)
                          (event-modifiers (elt key 0))))
              (setq ret (car keys))
            (setq keys (cdr keys)))))
      (or ret (car list)))))

(defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
  "Display the message with the name of the last changed
image-file and inform user that they can rotate by pressing keys
bound to `org-screenshot-rotate-next' and
`org-screenshot-rotate-prev' in `org-screenshot-map'

This works similarly to `kmacro-end-or-call-macro' so that user
can press a long key sequence to invoke the first command, and
then uses single keys to rotate, until unregognized key is
entered, at which point event will be unread"

  (let* ((event (if from-take-screenshot orig-event
                  last-input-event))
         done
         (prev-key
          (org-screenshot-prefer-same-modifiers
           (where-is-internal 'org-screenshot-rotate-prev
                              org-screenshot-map nil)
           event))
         (next-key
          (org-screenshot-prefer-same-modifiers
           (where-is-internal 'org-screenshot-rotate-next
                              org-screenshot-map nil)
           event))
         prev-key-str next-key-str)
    (when (and (= (length prev-key) 1)
               (= (length next-key) 1)) 
      (setq
       prev-key-str (format-kbd-macro prev-key nil)
       next-key-str (format-kbd-macro next-key nil)
       prev-key (elt prev-key 0)
       next-key (elt next-key 0))
      (while (not done)
        (message "%S - '%s' and '%s' to rotate"
                 org-screenshot-last-file prev-key-str next-key-str)
        (setq event (read-event))
        (cond ((equal event prev-key)
               (clear-this-command-keys t)
               (org-screenshot-do-rotate 1 t)
               (setq last-input-event nil))
              ((equal event next-key)
               (clear-this-command-keys t)
               (org-screenshot-do-rotate -1 t)
               (setq last-input-event nil))
              (t (setq done t)))) 
      (when last-input-event
        (clear-this-command-keys t)
        (setq unread-command-events (list last-input-event))))))

(defun org-screenshot-show-unused ()
  "Open A Dired buffer with unused screenshots marked"
  (interactive)
  (let ((files-in-buffer)
	dired-buffer
	had-any
	(image-re (org-image-file-name-regexp))
	beg end)
    (save-excursion
      (save-restriction
	(widen)
	(setq beg (or beg (point-min)) end (or end (point-max)))
	(goto-char beg)
	(let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
			  (substring (org-image-file-name-regexp) 0 -2)
			  "\\)\\]"))
	      (case-fold-search t)
	      old file ov img type attrwidth width)
	  (while (re-search-forward re end t)
	    (setq file (concat (or (match-string 3) "") (match-string 4)))
	    (when (and (file-exists-p file)
		       (equal (file-name-directory file)
			      (org-screenshot-image-directory)))
	      (push (file-name-nondirectory file)
		    files-in-buffer))))))
    (setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
    (with-current-buffer dired-buffer
      (dired-unmark-all-files ?\r)
      (dired-mark-if
       (let ((file (dired-get-filename 'no-dir t))) 
	 (and file (string-match image-re file)
	      (not (member file files-in-buffer))
	      (setq had-any t)))
       "Unused screenshot"))
    (when had-any (pop-to-buffer dired-buffer))))

(provide 'org-screenshot)

^ permalink raw reply	[flat|nested] 26+ messages in thread
end of thread, other threads:[~2013-05-21 17:42 UTC | newest]

Thread overview: 26+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-05-17  3:21 RFQ - new contribution - org-screenshot.el Max Mikhanosha
2013-05-17  6:13 ` Bastien
2013-05-17  7:38   ` Rainer M. Krug
2013-05-17 10:41     ` Max Mikhanosha
2013-05-17 12:33       ` Daniel F
2013-05-17 13:17       ` Feng Shu
2013-05-17 13:49       ` Bastien
2013-05-17 10:46     ` Carsten Dominik
2013-05-17 13:05     ` Carsten Dominik
2013-05-17 14:37       ` Max Mikhanosha
2013-05-17 13:27 ` Feng Shu
2013-05-17 16:25 ` Max Mikhanosha
2013-05-17 17:20   ` Brett Viren
2013-05-17 18:33     ` Max Mikhanosha
2013-05-17 19:42       ` Brett Viren
2013-05-20 16:53 ` François Pinard
2013-05-20 18:45 ` Russell Adams
2013-05-21  0:14   ` Max Mikhanosha
2013-05-21  0:58     ` Russell Adams
2013-05-21 12:03     ` François Pinard
2013-05-21 12:45       ` Russell Adams
2013-05-21 13:42 ` Haider Rizvi
2013-05-21 15:36   ` Feng Shu
2013-05-21 16:16     ` François Pinard
2013-05-21 17:40   ` Viktor Rosenfeld
2013-05-21 17:42     ` Viktor Rosenfeld

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).