EXPERIMENTAL/org-pic.el

   1 ;;; Modified picture mode with extra functions and bindings
   2 ;; BUGS:  The mouse stuff does not really work reliable
   3
   4 ;; What it really needs:
   5 ;; Picture areas should always start with ":"
   6 ;; Automatic recognize the region and use the right commands, also
   7 ;; extending the region.
   8
   9 ;; Picture mode
  10 ;; ------------
  11 ;; Simple ASCII drawings can be made in picture-mode.  You can toggle
  12 ;; picture mode with `C-c C-c' (unless you have turned it off with the
  13 ;; variable `org-enable-picture-mode').  See the picture-mode
  14 ;; documentation for details. Some additional bindings are provided by
  15 ;; org-mode:
  16 ;;
  17 ;;      M-up         M-7 M-8 M-9  \
  18 ;; M-left  M-right   M-u     M-o   }  Draw lines in keypad-like directions
  19 ;;     M-down        M-j M-k M-o  /
  20 ;;
  21 ;;    M--              Draw line from mark to point, set mark at end.
  22 ;;    S-mouse1         Freehand drawing with the mouse.
  23 ;;
  24 (defcustom org-enable-picture-mode t
  25   "Non-nil means, C-c C-c switches to picture mode.
  26 When nil, this command is disabled."
  27   :group 'org
  28   :type 'boolean)
  29 (defun org-edit-picture ()
  30   "Switch to picture mode and save the value of `transient-mark-mode'.
  31 Turn transient-mark-mode off while in picture-mode."
  32   (interactive)
  33   (if (not org-enable-picture-mode)
  34       (error
  35        "Set variable `org-enable-picture-mode' to allow picture-mode."))
  36   ;; FIXME: This is not XEmacs compatible yet
  37   (set (make-local-variable 'org-transient-mark-mode)
  38        transient-mark-mode)
  39   (set (make-local-variable 'org-cursor-color)
  40        (frame-parameter nil 'cursor-color))
  41   (set (make-local-variable 'transient-mark-mode) nil)
  42   (set-cursor-color "red")
  43   (picture-mode)
  44   (message (substitute-command-keys
  45             "Type \\[org-picture-mode-exit] in this buffer to return it to Org mode.")))
  46
  47 (defun org-picture-mode-exit (&optional arg)
  48   "Turn off picture mode and restore `transient-mark-mode'."
  49   (interactive "P")
  50   (if (local-variable-p 'org-transient-mark-mode)
  51       (setq transient-mark-mode org-transient-mark-mode))
  52   (if (local-variable-p 'org-cursor-color)
  53       (set-cursor-color org-cursor-color))
  54   (if (fboundp 'deactivate-mark) (deactivate-mark))
  55   (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region))
  56   (picture-mode-exit))
  57
  58
  59 (eval-after-load "picture"
  60   ' (progn
  61       (define-key picture-mode-map [(meta left)] (lambda (arg) (interactive "p") (org-picture-draw 4 arg)))
  62       (define-key picture-mode-map [(meta right)] (lambda (arg) (interactive "p") (org-picture-draw 6 arg)))
  63       (define-key picture-mode-map [(meta up)] (lambda (arg) (interactive "p") (org-picture-draw 8 arg)))
  64       (define-key picture-mode-map [(meta down)] (lambda (arg) (interactive "p") (org-picture-draw 2 arg)))
  65       (define-key picture-mode-map [(meta shift left)] (lambda (arg) (interactive "p") (org-picture-draw 7 arg)))
  66       (define-key picture-mode-map [(meta shift right)] (lambda (arg) (interactive "p") (org-picture-draw 3 arg)))
  67       (define-key picture-mode-map [(meta shift up)] (lambda (arg) (interactive "p") (org-picture-draw 9 arg)))
  68       (define-key picture-mode-map [(meta shift down)] (lambda (arg) (interactive "p") (org-picture-draw 1 arg)))
  69
  70       (define-key picture-mode-map [(meta ?j)] (lambda (arg) (interactive "p") (org-picture-draw 1 arg)))
  71       (define-key picture-mode-map [(meta ?k)] (lambda (arg) (interactive "p") (org-picture-draw 2 arg)))
  72       (define-key picture-mode-map [(meta ?l)] (lambda (arg) (interactive "p") (org-picture-draw 3 arg)))
  73       (define-key picture-mode-map [(meta ?u)] (lambda (arg) (interactive "p") (org-picture-draw 4 arg)))
  74       (define-key picture-mode-map [(meta ?o)] (lambda (arg) (interactive "p") (org-picture-draw 6 arg)))
  75       (define-key picture-mode-map [(meta ?7)] (lambda (arg) (interactive "p") (org-picture-draw 7 arg)))
  76       (define-key picture-mode-map [(meta ?8)] (lambda (arg) (interactive "p") (org-picture-draw 8 arg)))
  77       (define-key picture-mode-map [(meta ?9)] (lambda (arg) (interactive "p") (org-picture-draw 9 arg)))
  78       (define-key picture-mode-map [(meta ?-)] 'org-picture-draw-line)
  79       (define-key picture-mode-map [mouse-2] 'org-picture-mouse-line-to-here)
  80       (define-key picture-mode-map [mouse-1] 'org-picture-mouse-set-point)
  81       (define-key picture-mode-map [(shift down-mouse-1)] 'org-picture-draw-with-mouse)
  82       (define-key picture-mode-map "\C-c\C-c" 'org-picture-mode-exit)))
  83
  84 (defun org-picture-draw (dir arg)
  85   "Draw ARG character into the direction given by DIR."
  86   (cond
  87    ((equal dir 1)
  88     (picture-movement-sw)
  89     (setq last-command-event ?/)  (picture-self-insert arg))
  90    ((equal dir 2)
  91     (picture-movement-down)
  92     (setq last-command-event ?|)  (picture-self-insert arg))
  93    ((equal dir 3)
  94     (picture-movement-se)
  95     (setq last-command-event ?\\) (picture-self-insert arg))
  96    ((equal dir 4)
  97     (picture-movement-left)
  98     (setq last-command-event ?-)  (picture-self-insert arg))
  99    ((equal dir 5))
 100    ((equal dir 6)
 101     (picture-movement-right)
 102     (setq last-command-event ?-)  (picture-self-insert arg))
 103    ((equal dir 7)
 104     (picture-movement-nw)
 105     (setq last-command-event ?\\) (picture-self-insert arg))
 106    ((equal dir 8)
 107     (picture-movement-up)
 108     (setq last-command-event ?|)  (picture-self-insert arg))
 109    ((equal dir 9)
 110     (picture-movement-ne)
 111     (setq last-command-event ?/)  (picture-self-insert arg)))
 112   (picture-movement-right))
 113
 114 (defun org-picture-draw-line (&optional beg end)
 115   "Draw a line from mark to point."
 116   (interactive)
 117   (unless (and beg end)
 118     (setq beg (mark 'force)
 119           end (point)))
 120   (let (x1 x2 y1 y2 n i Dx Dy dx dy char lp x y x1a y1a lastx lasty)
 121     (goto-char beg)
 122     (setq x1 (current-column) y1 (count-lines (point-min) (point)))
 123     (if (bolp) (setq y1 (1+ y1)))
 124     (goto-char end)
 125     (setq x2 (current-column) y2 (count-lines (point-min) (point)))
 126     (if (bolp) (setq y2 (1+ y2)))
 127     (setq Dx (- x2 x1) Dy (- y2 y1)
 128           n (+ (abs Dx) (abs Dy))
 129           n (sqrt (+ (* Dx Dx) (* Dy Dy)))
 130           n (max (abs Dx) (abs Dy))
 131           n (max (abs Dx) (abs Dy))
 132           dx (/ (float Dx) (float n)) dy (/ (float Dy) (float n)))
 133     (setq x1a (floor (+ x1 (* 1. dx) .5))
 134           y1a (floor (+ y1 (* 1. dy) .5)))
 135     ;; Do the loop
 136     (setq i -1)
 137     (setq lastx x1a lasty y1a)
 138     (while (< i n)
 139       (setq i (1+ i)
 140             x (floor (+ x1 (* (float i) dx) .5))
 141             y (floor (+ y1 (* (float i) dy) .5)))
 142       (setq char (cond ((= lastx x) ?|) ((= lasty y) ?-)
 143                        ((> (* (- x lastx) (- y lasty)) 0) ?\\)
 144                        (t ?/))
 145             lastx x lasty y)
 146       (goto-line y)
 147       (move-to-column x t)
 148       (setq last-command-event char)
 149       (setq lp (point))
 150       (picture-self-insert 1))
 151     (goto-char lp)
 152     (set-mark lp)))
 153
 154 (defun org-picture-mouse-line-to-here (ev)
 155   "Draw a line from point to the click position."
 156   (interactive "e")
 157   (let* ((beg (move-marker (make-marker) (point))))
 158     (org-picture-mouse-set-point ev)
 159     (org-picture-draw-line beg (point))
 160     (move-marker beg nil)))
 161
 162 ;; Draw with the mouse
 163 (defun org-picture-mouse-set-point (ev)
 164   "Mouse-set-point, but force position."
 165   (interactive "e")
 166   (let* ((colrow (posn-col-row (event-end ev)))
 167          (col (car colrow)) (line (cdr colrow))
 168          (realline (1+ (+ (count-lines (point-min) (window-start)) line))))
 169     (goto-line realline)
 170     (while (and (eobp)
 171                 (not (> (count-lines (point-min) (point-max)) realline)))
 172       (newline))
 173     (goto-line realline)
 174     (move-to-column col t)))
 175
 176 (defun org-picture-draw-with-mouse (ev)
 177   "Use the mouse like a brush and paint stars where it goes."
 178   (interactive "e")
 179   (let (lastcr cr)
 180     (track-mouse
 181       (catch 'exit
 182         (while t
 183           (setq e (read-event))
 184           (if (not (eq (car e) 'mouse-movement)) (throw 'exit nil))
 185           (setq cr (posn-col-row (event-end e)))
 186           (when (not (equal cr lastcr))
 187             (setq lastcr cr)
 188             (org-picture-mouse-set-point e)
 189             (setq last-command-event ?*)
 190             (save-excursion
 191               (picture-self-insert 1))))))))