org-mouse.el --- Better mouse support for org-mode (version 0.01)

[Piotr Zielinski]

;;; org-mouse.el --- Better mouse support for org-mode

;; Copyright (c) 2006 Piotr Zielinski
;;
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Version: 0.01
;;
;; The latest version of this file is available from
;;
;; http://www.cl.cam.ac.uk/~pz215/files/org-mouse.el
;;
;; This file is *NOT* part of GNU Emacs.
;; This file is distributed under the same terms as 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 2 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Org-mouse provides better mouse support for org-mode.  Org-mode is
;; a mode for keeping notes, maintaining ToDo lists, and doing project
;; planning with a fast and effective plain-text system.  It is
;; available from
;;
;; http://staff.science.uva.nl/~dominik/Tools/org/
;;
;; Org-mouse implements the following features:
;; + following links with the left mouse button (in Emacs 22)
;; + subtree expansion/collapse (org-cycle) with the left mouse button
;; + several context menus
;; + date/time extraction from selected text (requires a python script)
;;   (eg. select text from your email and click "Add Appointment")
;;
;; The python script that automatically extracts date/time information
;; from a piece of English text is available from:
;;
;; http://www.cl.cam.ac.uk/~pz215/files/timeparser.py
;;
;; Use
;; ------------
;;
;; To use this package, put the following line in your .emacs:
;;
;;    (require 'org-mouse)
;;
;; Tested with Emacs 22.0.50, org-mode 4.03

;;; Code:

(defvar org-mouse-version "0.01")

(defun org-mouse-show-context-menu (event prefix)
  (interactive "@e \nP")
  (if (and (= (event-click-count event) 1)
           (or ; (not transient-mark-mode)
               (sit-for (/ double-click-time 1000.0))))
      (progn
        (message "executing")
        (goto-char (posn-point (event-start event)))
        (let ((redisplay-dont-pause t))
          (sit-for 0))
        (if (functionp org-mouse-context-menu-function)
            (funcall org-mouse-context-menu-function)
          (mouse-major-mode-menu event prefix))
        )
    (message "killing %i" (event-click-count event))
    (setq this-command 'mouse-save-then-kill)
    (mouse-save-then-kill event)))


(defun org-mouse-insert-heading ()
  (interactive)
  (beginning-of-line)
  (org-insert-heading))

(defun org-mouse-new-appointment ()
  (interactive)
  (org-mouse-insert-heading)
  (save-excursion
    (call-process "timeparser.py" nil t nil
                  (format "%s" (current-kill 0)))
    (backward-delete-char 1)))

(defun org-mouse-activate-headlines (limit)
  "Run through the buffer and add overlays to headlines."
  (if (re-search-forward outline-regexp limit t)
      (progn
        (add-text-properties (match-beginning 0) (match-end 0)
                             (list 'mouse-face 'highlight
                                   'keymap org-mouse-map))
        t)))

(defun org-mouse-at-headline-head ()
  (save-excursion
             (let ((point (point)))
               (beginning-of-line)
               (and (looking-at outline-regexp)
                    (< point (match-end 0))))))

(defun org-mouse-at-headline ()
  (save-excursion
    (beginning-of-line)
    (looking-at outline-regexp)))

(defun org-mouse-at-headline-tail ()
  (save-excursion
             (let ((point (point)))
               (beginning-of-line)
               (and (looking-at outline-regexp)
                    (>= point (match-end 0))))))




(defun org-mouse-priority-set (priority)
  (replace-match priority t t nil 1))


(defun org-mouse-keyword-menu (keywords &optional remove group)
  (setq group (or group 0))
  (append
   (mapcar
    (lambda (keyword)
      (vector keyword
              `(lambda () (interactive) (replace-match ,keyword t t nil
,group))
              :style 'toggle :selected  (equal (match-string group) keyword)))
    keywords)
   (when remove
     '(["None" (lambda () (interactive) (replace-match ""))]))))

(defvar org-mouse-context-menu-function nil)
(make-variable-buffer-local 'org-mouse-context-menu-function)

(defun org-mouse-show-headlines ()
  (interactive)
  (let ((this-command 'org-cycle)
        (last-command 'org-cycle)
        (org-cycle-global-status nil))
    (org-cycle '(4))
    (org-cycle '(4))))

(defun org-mouse-show-overview ()
  (interactive)
  (let ((org-cycle-global-status nil))
    (org-cycle '(4))))


(setq org-mouse-headline-menu
  '(nil
         ["New Heading" org-mouse-insert-heading t]
         ["New Appointment" org-mouse-new-appointment t]
         ["Set Priority" org-priority]
         ["Set TODO" org-todo]
         "--"
         ["Timestamp" org-time-stamp t]
         ["Timestamp (inactive)" org-time-stamp-inactive t]
         ["Schedule Item" org-schedule t]
         ["Set Deadline" org-deadline t]
         "--"
         ["Archive Subtree" org-archive-subtree]
         ["Cut Subtree"  org-cut-special]
         ["Copy Subtree"  org-copy-special]
         ["Paste Subtree"  org-paste-special]
         "--"
         ["Promote Heading" org-metaleft]
         ["Promote Subtree" org-shiftmetaleft]
         ["Demote Heading"  org-metaright]
         ["Demote Subtree"  org-shiftmetaright]
         ))

(setq org-mouse-global-menu
  '(nil
       ["Show Overview" org-mouse-show-overview t]
       ["Show Headlines" org-mouse-show-headlines t]
       ["Show All" show-all t]
       "--"
       ["Check TODOs" org-show-todo-tree t]
       ["Check Deadlines" org-check-deadlines t]
       ["Check Tags ..." org-tags-sparse-tree t]
       ["Check Phrase ..." org-occur]
       "--"
       ["Display Agenda" org-agenda t]
       ["Display Timeline" org-timeline t]
       ["Display TODO List" org-todo-list t]
       ["Display Calendar" org-goto-calendar t]
       "--"
       "--"
       ["Jump" org-goto]))

(defun org-mouse-context-menu ()
  (let ((word (and (org-mouse-at-regexp "\\b\\w+\\b") (match-string
0))))
    (cond
     ((eolp)
      (popup-menu org-mouse-global-menu))
     ((member word org-todo-keywords)
    (popup-menu
     `(nil
       ,@(org-mouse-keyword-menu org-todo-keywords t)
       "--"
       ["Check TODOs" org-show-todo-tree t]
       ["Display TODO List" org-todo-list t]
       )))
   ((member word '("DEADLINE" "SCHEDULED"))
    (popup-menu
     `(nil
       ,@(org-mouse-keyword-menu '("DEADLINE" "SCHEDULED") t)
       "--"
       ["Check Deadlines" org-check-deadlines t]
       )))
   ((org-mouse-at-regexp "\\[#\\([A-Z]\\)\\]") ; priority
    (popup-menu `(nil ,@(org-mouse-keyword-menu '("A" "B" "C") t 1))))
   ((org-at-timestamp-p)
    (popup-menu
     '(nil
       ["Show Day" org-open-at-point t]
       ["Change Timestamp" org-time-stamp t]
       ["Compute Time Range" org-evaluate-time-range
(org-at-date-range-p)])))
   ((and (org-mouse-at-headline) (not (eolp)))
    (popup-menu org-mouse-headline-menu))
   (t
    (popup-menu org-mouse-global-menu)))))


(defun org-mouse-at-regexp (regexp)
  (save-excursion
    (let ((point (point))
          (bol (progn (beginning-of-line) (point)))
          (eol (progn (end-of-line) (point))))
      (goto-char point)
      (re-search-backward regexp bol 1)
      (and (not (eolp))
           (progn (forward-char)
                  (re-search-forward regexp eol t))
           (<= (match-beginning 0) point)))))

(defun org-mouse-in-region-p (pos)
  (and mark-active (>= pos (region-beginning)) (<  pos (region-end))))

(defun org-mouse-down-mouse (event)
  (interactive "e")
  (setq this-command last-command)
  (unless (and transient-mark-mode
               (= 1 (event-click-count event))
               (org-mouse-in-region-p (posn-point (event-start event))))
    (mouse-drag-region event)))

(add-hook 'org-mode-hook
  '(lambda ()
     (setq org-mouse-context-menu-function 'org-mouse-context-menu)

     (define-key org-mouse-map [follow-link] 'mouse-face)
     (define-key org-mouse-map (if org-xemacs-p [button3] [mouse-3])
nil)
     (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
     (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)

     (font-lock-add-keywords nil
        '((org-mouse-activate-headlines  (0 'org-link 'prepend))) t)

     (defadvice org-open-at-point (around org-mouse-open-at-point
activate)
       (if (org-mouse-at-headline-head)
           (org-cycle)
         ad-do-it))))

(add-hook 'org-agenda-mode-hook
   '(lambda ()
      (define-key org-agenda-keymap [follow-link] 'mouse-face)
      (define-key org-agenda-keymap
        (if org-xemacs-p [button3] [mouse-3]) nil)))
  
(provide 'org-mouse)