org-mode/org-mouse.el

1058 lines
34 KiB
EmacsLisp

;;; 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.24a
;; $Id: org-mouse.el 817 2007-02-01 00:28:02Z pz215 $
;;
;; 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 on the right mouse button:
;; + general text
;; + headlines
;; + timestamps
;; + priorities
;; + links
;; + tags
;; * promoting/demoting/moving subtrees with mouse-3
;; + if the drag starts and ends in the same line then promote/demote
;; + otherwise move the subtree
;; * 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.58
;; Fixme:
;; + deal with folding / unfolding issues
;; TODO (This list is only theoretical, if you'd like to have some
;; feature implemented or a bug fix please send me an email, even if
;; something similar appears in the list below. This will help me get
;; the priorities right.):
;;
;; + org-store-link, insert link
;; + org tables
;; + occur with the current word/tag (same menu item)
;; + ctrl-c ctrl-c, for example, renumber the current list
;; + internal links
;; Please email me with new feature suggestions / bugs
;; History:
;;
;; Version 0.24
;; + minor changes to the table menu
;;
;; Version 0.23
;; + preliminary support for tables and calculation marks
;; + context menu support for org-agenda-undo & org-sort-entries
;;
;; Version 0.22
;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
;;
;; Version 0.21
;; + selected text activates its context menu
;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link
;;
;; Version 0.20
;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
;; + the TODO menu can now list occurrences of a specific TODO keyword
;; + #+STARTUP line is now recognized
;;
;; Version 0.19
;; + added support for dragging URLs to the org-buffer
;;
;; Version 0.18
;; + added support for agenda blocks
;;
;; Version 0.17
;; + toggle checkboxes with a single click
;;
;; Version 0.16
;; + added support for checkboxes
;;
;; Version 0.15
;; + org-mode now works with the Agenda buffer as well
;;
;; Version 0.14
;; + added a menu option that converts plain list items to outline items
;;
;; Version 0.13
;; + "Insert Heading" now inserts a sibling heading if the point is
;; on "***" and a child heading otherwise
;;
;; Version 0.12
;; + compatible with Emacs 21
;; + custom agenda commands added to the main menu
;; + moving trees should now work between windows in the same frame
;;
;; Version 0.11
;; + fixed org-mouse-at-link (thanks to Carsten)
;; + removed [follow-link] bindings
;;
;; Version 0.10
;; + added a menu option to remove highlights
;; + compatible with org-mode 4.21 now
;;
;; Version 0.08:
;; + trees can be moved/promoted/demoted by dragging with the right
;; mouse button (mouse-3)
;; + small changes in the above function
;;
;; Versions 0.01 -- 0.07: (I don't remember)
(require 'cl)
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) ")
(defvar org-mouse-direct t)
(defgroup org-mouse nil
"Org-mouse"
:tag "Org Mouse."
:group 'org)
(defcustom org-mouse-punctuation ":"
""
:group 'org-mouse
:type 'string)
(defun org-mouse-re-search-line (regexp)
"Searches the current line for a given regular expression."
(beginning-of-line)
(re-search-forward regexp (point-at-eol) t))
(defun org-mouse-end-headline ()
"Go to the end of current headline (ignoring tags)."
(interactive)
(end-of-line)
(skip-chars-backward "\t ")
(when (looking-back ":[A-Za-z]+:")
(skip-chars-backward ":A-Za-z")
(skip-chars-backward "\t ")))
(defun org-mouse-show-context-menu (event prefix)
(interactive "@e \nP")
(if (and (= (event-click-count event) 1)
(or (not mark-active)
(sit-for (/ double-click-time 1000.0))))
(progn
(select-window (posn-window (event-start event)))
(when (not (org-mouse-mark-active))
(goto-char (posn-point (event-start event)))
(when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
(let ((redisplay-dont-pause t))
(sit-for 0)))
(if (functionp org-mouse-context-menu-function)
(funcall org-mouse-context-menu-function event)
(mouse-major-mode-menu event prefix))
)
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
(defun org-mouse-line-position ()
"Returns :beginning :middle :end"
(cond
((eolp) :end)
((org-mouse-bolp) :begin)
(t :middle)))
(defun org-mouse-empty-line ()
(save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
(defun org-mouse-next-heading ()
"Goes to the next heading and if there is none, it ensures that the point is at the beginning of an empty line."
(unless (outline-next-heading)
(beginning-of-line)
(unless (org-mouse-empty-line)
(end-of-line)
(newline))))
(defun org-mouse-insert-heading ()
(interactive)
(case (org-mouse-line-position)
(:begin (beginning-of-line)
(org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
(defun org-mouse-timestamp-today (&optional shift units)
(interactive)
(flet ((org-read-date (&rest rest) (current-time)))
(org-time-stamp nil))
(when shift
(org-timestamp-change shift units)))
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
(mapcar
`(lambda (keyword)
(vector (cond
((functionp ,itemformat) (funcall ,itemformat keyword))
((stringp ,itemformat) (format ,itemformat keyword))
(t keyword))
(list 'funcall ,function keyword)
:style (cond
((null ,selected) t)
((functionp ,selected) 'toggle)
(t 'radio))
:selected (if (functionp ,selected)
(and (funcall ,selected keyword) t)
(equal ,selected keyword))))
keywords))
(defun org-mouse-remove-match-and-spaces ()
(interactive)
(replace-match "")
(just-one-space))
(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
literal string subexp)
"The same as replace-match, but surrounds the replacement with spaces."
(apply 'replace-match rest)
(save-excursion
(goto-char (match-beginning (or subexp 0)))
(just-one-space)
(goto-char (match-end (or subexp 0)))
(just-one-space)))
(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
nosurround)
(setq group (or group 0))
(let ((replace (org-mouse-match-closure
(if nosurround 'replace-match
'org-mouse-replace-match-and-surround))))
(append
(org-mouse-keyword-menu
keywords
`(lambda (keyword) (funcall ,replace keyword t t nil ,group))
(match-string group)
itemformat)
`(["None" org-mouse-remove-match-and-spaces
:style radio
:selected ,(not (member (match-string group) keywords))]))))
(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))))
(defun org-mouse-set-priority (priority)
(flet ((read-char-exclusive () priority))
(org-priority)))
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator. Differs from `org-priority-regexp' in that it doesn't contain the leading '.*?'.")
(defun org-mouse-get-priority (&optional default)
(save-excursion
(if (org-mouse-re-search-line org-mouse-priority-regexp)
(match-string 1)
(when default (char-to-string org-default-priority)))))
(defun org-mouse-at-link ()
(and (eq (get-text-property (point) 'face) 'org-link)
(save-excursion
(goto-char (previous-single-property-change (point) 'face))
(or (looking-at org-bracket-link-regexp)
(looking-at org-angle-link-re)
(looking-at org-plain-link-re)))))
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(when (or (org-at-date-range-p) (org-at-timestamp-p))
(replace-match "") ; delete the timestamp
(skip-chars-backward " :A-Z")
(when (looking-at " *[A-Z][A-Z]+:")
(replace-match ""))))
(defun org-mouse-looking-at (regexp skipchars &optional movechars)
(save-excursion
(let ((point (point)))
(if (looking-at regexp) t
(skip-chars-backward skipchars)
(forward-char (or movechars 0))
(when (looking-at regexp)
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
(loop for priority from ?A to org-lowest-priority
collect (char-to-string priority)))
(defun org-mouse-tag-menu () ;todo
(append
(let ((tags (org-split-string (org-get-tags) ":")))
(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
`(lambda (tag)
(org-mouse-set-tags
(sort (if (member tag (quote ,tags))
(delete tag (quote ,tags))
(cons tag (quote ,tags)))
'string-lessp)))
`(lambda (tag) (member tag (quote ,tags)))
))
'("--"
["Align Tags Here" (org-set-tags nil t) t]
["Align Tags in Buffer" (org-set-tags t t) t]
["Set Tags ..." (org-set-tags) t])))
(defun org-mouse-set-tags (tags)
(save-excursion
;; remove existing tags first
(beginning-of-line)
(when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
(replace-match ""))
;; set new tags if any
(when tags
(end-of-line)
(insert " :" (mapconcat 'identity tags ":") ":")
(org-set-tags nil t))))
(defun org-mouse-insert-checkbox ()
(interactive)
(and (org-at-item-p)
(goto-char (match-end 0))
(unless (org-at-item-checkbox-p)
(delete-horizontal-space)
(insert " [ ] "))))
(defun org-mouse-agenda-type (type)
(case type
('tags "Tags: ")
('todo "TODO: ")
('tags-tree "Tags tree: ")
('todo-tree "TODO tree: ")
('occur-tree "Occur tree: ")
(t "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
(split-string (match-string-no-properties 1)))))
(print options)
(loop for name in alloptions
collect
(vector name
`(progn
(replace-match
(mapconcat 'identity
(sort (if (member ',name ',options)
(delete ',name ',options)
(cons ',name ',options))
'string-lessp)
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
:style 'toggle
:selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
(concat (substring text 0 (- maxlength 3)) "...")
text))
(defun org-mouse-popup-global-menu ()
(popup-menu
`("Main Menu"
["Show Overview" org-mouse-show-overview t]
["Show Headlines" org-mouse-show-headlines t]
["Show All" show-all t]
["Remove Highlights" org-remove-occur-highlights
:visible org-occur-highlights]
"--"
["Check Deadlines"
(if (functionp 'org-check-deadlines-and-todos)
(org-check-deadlines-and-todos org-deadline-warning-days)
(org-check-deadlines org-deadline-warning-days)) t]
["Check TODOs" org-show-todo-tree t]
("Check Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
'(lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
["Check Phrase ..." org-occur]
"--"
["Display Agenda" org-agenda-list t]
["Display Timeline" org-timeline t]
["Display TODO List" org-todo-list t]
("Display Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
'(lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
'(lambda (key)
(eval `(flet ((read-char-exclusive () (string-to-char ,key)))
(org-agenda nil))))
nil
'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
(org-mouse-clip-text
(cond
((stringp (nth 1 entry)) (nth 1 entry))
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
(t "Agenda Command '%s'"))
30))))
;; )
"--"
["Delete Blank Lines" delete-blank-lines
:visible (org-mouse-empty-line)]
["Insert Checkbox" org-mouse-insert-checkbox
:visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
["Insert Checkboxes"
(org-mouse-for-each-item 'org-mouse-insert-checkbox)
:visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
["Plain List to Outline" org-mouse-transform-to-outline
:visible (org-at-item-p)])))
(defun org-mouse-get-context (contextlist context)
(let ((contextdata (assq context contextlist)))
(when contextdata
(save-excursion
(goto-char (second contextdata))
(re-search-forward ".*" (third contextdata))))))
(defun org-mouse-for-each-item (function)
(save-excursion
(ignore-errors
(while t (org-previous-item)))
(ignore-errors
(while t
(funcall function)
(org-next-item)))))
(defun org-mouse-bolp ()
"Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
(save-excursion
(skip-chars-backward " \t*") (bolp)))
(defun org-mouse-insert-item (text)
(case (org-mouse-line-position)
(:begin ; insert before
(beginning-of-line)
(looking-at "[ \t]*")
(open-line 1)
(indent-to (- (match-end 0) (match-beginning 0)))
(insert "+ "))
(:middle ; insert after
(end-of-line)
(newline t)
(indent-relative)
(insert "+ "))
(:end ; insert text here
(skip-chars-backward " \t")
(kill-region (point) (point-at-eol))
(unless (looking-back org-mouse-punctuation)
(insert (concat org-mouse-punctuation " ")))))
(insert text)
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
(if (eq major-mode 'org-mode)
(org-mouse-insert-item text)
ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
(if (eq major-mode 'org-mode)
(org-mouse-insert-item uri)
ad-do-it))
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
`(lambda (&rest rest)
(save-match-data
(set-match-data ',match)
(apply ',function rest)))))
(defun org-mouse-todo-keywords ()
(if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords))
(defun org-mouse-match-todo-keyword ()
(save-excursion
(org-back-to-heading)
(if (looking-at outline-regexp) (goto-char (match-end 0)))
(or (looking-at (concat " +" org-todo-regexp " *"))
(looking-at " \\( *\\)"))))
(defun org-mouse-yank-link (click)
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(mouse-set-point click)
(setq mouse-selection-click-count 0)
(delete-horizontal-space)
(insert-for-yank (concat " [[" (current-kill 0) "]] ")))
(defun org-mouse-context-menu (&optional event)
(let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
(contextlist (org-context)))
(flet ((get-context (context) (org-mouse-get-context contextlist context)))
(cond
((org-mouse-mark-active)
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(popup-menu
`(nil
["Sparse Tree" (org-occur ',region-string)]
["Find in Buffer" (occur ',region-string)]
["Grep in Current Dir"
(grep (format "grep -rnH -e '%s' *" ',region-string))]
["Grep in Parent Dir"
(grep (format "grep -rnH -e '%s' ../*" ',region-string))]
"--"
["Convert to Link"
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
(looking-back " \\|\t")))
(org-mouse-popup-global-menu))
((get-context :checkbox)
(popup-menu
'(nil
["Toggle" org-toggle-checkbox t]
["Remove" org-mouse-remove-match-and-spaces t]
""
["All Clear" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[ ]"))))]
["All Set" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(replace-match "[X]"))))]
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
["All Remove" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
(org-mouse-remove-match-and-spaces))))]
)))
((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
(member (match-string 0) (org-mouse-todo-keywords)))
(popup-menu
`(nil
,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords))
"--"
["Check TODOs" org-show-todo-tree t]
["List all TODO keywords" org-todo-list t]
[,(format "List only %s" (match-string 0))
(org-todo-list (match-string 0)) t]
)))
((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
(member (match-string 0) stamp-prefixes))
(popup-menu
`(nil
,@(org-mouse-keyword-replace-menu stamp-prefixes)
"--"
["Check Deadlines" org-check-deadlines t]
)))
((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
(org-mouse-priority-list) 1 "Priority %s" t))))
((org-mouse-at-link)
(popup-menu
'(nil
["Open" org-open-at-point t]
["Open in Emacs" (org-open-at-point t) t]
"--"
["Copy link" (kill-new (match-string 0))]
["Cut link"
(progn
(kill-region (match-beginning 0) (match-end 0))
(just-one-space))]
"--"
["Grep for TODOs"
(grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
; ["Paste file link" ((insert "file:") (yank))]
)))
((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
(popup-menu
`(nil
[,(format "Display '%s'" (match-string 1))
(org-tags-view nil ,(match-string 1))]
[,(format "Sparse Tree '%s'" (match-string 1))
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
((org-at-timestamp-p)
(popup-menu
'(nil
["Show Day" org-open-at-point t]
["Change Timestamp" org-time-stamp t]
["Delete Timestamp" (org-mouse-delete-timestamp) t]
["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
"--"
["Set for Today" org-mouse-timestamp-today]
["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
["Set in a Month" (org-mouse-timestamp-today 1 'month)]
"--"
["+ 1 Day" (org-timestamp-change 1 'day)]
["+ 1 Week" (org-timestamp-change 7 'day)]
["+ 1 Month" (org-timestamp-change 1 'month)]
"--"
["- 1 Day" (org-timestamp-change -1 'day)]
["- 1 Week" (org-timestamp-change -7 'day)]
["- 1 Month" (org-timestamp-change -1 'month)])))
((get-context :table-special)
(let ((mdata (match-data)))
(incf (car mdata) 2)
(store-match-data mdata))
(message "match: %S" (match-string 0))
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
'(" " "!" "^" "_" "$" "#" "*" "'") 0
(lambda (mark)
(case (string-to-char mark)
(? "( ) Nothing Special")
(?! "(!) Column Names")
(?^ "(^) Field Names Above")
(?_ "(^) Field Names Below")
(?$ "($) Formula Parameters")
(?# "(#) Recalculation: Auto")
(?* "(*) Recalculation: Manual")
(?' "(') Recalculation: None"))) t))))
((assq :table contextlist)
(popup-menu
'(nil
["Align Table" org-ctrl-c-ctrl-c]
["Blank Field" org-table-blank-field]
["Edit Field" org-table-edit-field]
"--"
("Column"
["Move Column Left" org-metaleft]
["Move Column Right" org-metaright]
["Delete Column" org-shiftmetaleft]
["Insert Column" org-shiftmetaright]
"--"
["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
("Row"
["Move Row Up" org-metaup]
["Move Row Down" org-metadown]
["Delete Row" org-shiftmetaup]
["Insert Row" org-shiftmetadown]
["Sort lines in region" org-table-sort-lines (org-at-table-p)]
"--"
["Insert Hline" org-table-insert-hline])
("Rectangle"
["Copy Rectangle" org-copy-special]
["Cut Rectangle" org-cut-special]
["Paste Rectangle" org-paste-special]
["Fill Rectangle" org-table-wrap-region])
"--"
["Set Column Formula" org-table-eval-formula]
["Set Field Formula" (org-table-eval-formula '(4))]
["Edit Formulas" org-table-edit-formulas]
"--"
["Recalculate Line" org-table-recalculate]
["Recalculate All" (org-table-recalculate '(4))]
["Iterate All" (org-table-recalculate '(16))]
"--"
["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
["Sum Column/Rectangle" org-table-sum
:active (or (org-at-table-p) (org-region-active-p))]
["Field Info" org-table-field-info]
["Debug Formulas"
(setq org-table-formula-debug (not org-table-formula-debug))
:style toggle :selected org-table-formula-debug]
)))
((and (assq :headline contextlist) (not (eolp)))
(let ((priority (org-mouse-get-priority t)))
(popup-menu
`("Headline Menu"
("Tags and Priorities"
,@(org-mouse-keyword-menu
(org-mouse-priority-list)
'(lambda (keyword)
(org-mouse-set-priority (string-to-char keyword)))
priority "Priority %s")
"--"
,@(org-mouse-tag-menu))
("TODO Status"
,@(progn (org-mouse-match-todo-keyword)
(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)
1)))
["Show Tags"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
:visible (not org-mouse-direct)]
["Show Priority"
(with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
:visible (not org-mouse-direct)]
,@(if org-mouse-direct '("--") nil)
["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
["Set Deadline"
(progn (org-mouse-end-headline) (insert " ") (org-deadline))
:active (not (save-excursion
(org-mouse-re-search-line org-deadline-regexp)))]
["Schedule Task"
(progn (org-mouse-end-headline) (insert " ") (org-schedule))
:active (not (save-excursion
(org-mouse-re-search-line org-scheduled-regexp)))]
["Insert Timestamp"
(progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
; ["Timestamp (inactive)" org-time-stamp-inactive t]
"--"
["Archive Subtree" org-archive-subtree]
["Cut Subtree" org-cut-special]
["Copy Subtree" org-copy-special]
["Paste Subtree" org-paste-special :visible org-mouse-direct]
("Sort Children"
["Alphabetically" (org-sort-entries nil ?a)]
["Numerically" (org-sort-entries nil ?n)]
["By Time/Date" (org-sort-entries nil ?t)]
"--"
["Reverse Alphabetically" (org-sort-entries nil ?A)]
["Reverse Numerically" (org-sort-entries nil ?N)]
["Reverse By Time/Date" (org-sort-entries nil ?T)])
"--"
["Move Trees" org-mouse-move-tree :active nil]
))))
(t
(org-mouse-popup-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-mark-active ()
(and mark-active transient-mark-mode))
(defun org-mouse-in-region-p (pos)
(and (org-mouse-mark-active)
(>= pos (region-beginning))
(< pos (region-end))))
(defun org-mouse-down-mouse (event)
(interactive "e")
(setq this-command last-command)
(unless (and (= 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 (featurep 'xemacs) [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)
(define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
(define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
(define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link)
(define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)
(define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
(define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
(font-lock-add-keywords nil
`((,outline-regexp
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
'prepend)
("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
(2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
t)
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
(let ((context (org-context)))
(cond
((assq :headline-stars context) (org-cycle))
((assq :checkbox context) (org-toggle-checkbox))
((assq :item-bullet context)
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
(t ad-do-it))))))
(defun org-mouse-move-tree-start (event)
(interactive "e")
(message "Same line: promote/demote, (***):move before, (text): make a child"))
(defun org-mouse-make-marker (position)
(with-current-buffer (window-buffer (posn-window position))
(copy-marker (posn-point position))))
(defun org-mouse-move-tree (event)
;; todo: handle movements between different buffers
(interactive "e")
(save-excursion
(let* ((start (org-mouse-make-marker (event-start event)))
(end (org-mouse-make-marker (event-end event)))
(sbuf (marker-buffer start))
(ebuf (marker-buffer end)))
(when (and sbuf ebuf)
(set-buffer sbuf)
(goto-char start)
(org-back-to-heading)
(if (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char end) (org-back-to-heading) (point))))
;; if the same line then promote/demote
(if (>= end start) (org-demote-subtree) (org-promote-subtree))
;; if different lines then move
(org-cut-subtree)
(set-buffer ebuf)
(goto-char end)
(org-back-to-heading)
(when (and (eq sbuf ebuf)
(equal
(point)
(save-excursion (goto-char start)
(org-back-to-heading) (point))))
(outline-end-of-subtree)
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
(outline-end-of-subtree)
(end-of-line)
(if (eobp) (newline) (forward-char))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
(outline-end-of-subtree)
(when (bolp) (delete-char -1))))))))))
(defun org-mouse-transform-to-outline ()
(interactive)
(org-back-to-heading)
(let ((minlevel 1000)
(replace-text (concat (match-string 0) "* ")))
(beginning-of-line 2)
(save-excursion
(while (not (or (eobp) (looking-at outline-regexp)))
(when (looking-at org-mouse-plain-list-regexp)
(setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
(forward-line)))
(while (not (or (eobp) (looking-at outline-regexp)))
(when (and (looking-at org-mouse-plain-list-regexp)
(eq minlevel (- (match-end 1) (match-beginning 1))))
(replace-match replace-text))
(forward-line))))
(defun org-mouse-do-remotely (command)
; (org-agenda-check-no-diary)
(when (get-text-property (point) 'org-marker)
(let* ((anticol (- (point-at-eol) (point)))
(marker (get-text-property (point) 'org-marker))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (get-text-property (point) 'org-hd-marker))
(buffer-read-only nil)
(newhead "--- removed ---")
(org-mouse-direct nil)
(org-mouse-main-buffer (current-buffer)))
(when (eq (with-current-buffer buffer major-mode) 'org-mode)
(let ((endmarker (save-excursion
(set-buffer buffer)
(outline-end-of-subtree)
(forward-char 1)
(copy-marker (point)))))
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-show-hidden-entry)
(save-excursion
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(org-back-to-heading)
(setq marker (copy-marker (point)))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command)
(message "_cmd: %S" _cmd)
(message "this-command: %S" this-command)
(unless (eq (marker-position marker) (marker-position endmarker))
(setq newhead (org-get-heading))))
(beginning-of-line 1)
(save-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface))))
t))))
(defun org-mouse-agenda-context-menu (&optional event)
(or (org-mouse-do-remotely 'org-mouse-context-menu)
(popup-menu
'("Agenda"
("Agenda Files")
"--"
["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo))
:visible (if (eq last-command 'org-agenda-undo)
org-agenda-pending-undo-list
org-agenda-undo-list)]
["Rebuild Buffer" org-agenda-redo t]
["New Diary Entry"
org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
"--"
["Goto Today" org-agenda-goto-today
(org-agenda-check-type nil 'agenda 'timeline) t]
["Display Calendar" org-agenda-goto-calendar
(org-agenda-check-type nil 'agenda 'timeline) t]
("Calendar Commands"
["Phases of the Moon" org-agenda-phases-of-moon
(org-agenda-check-type nil 'agenda 'timeline)]
["Sunrise/Sunset" org-agenda-sunrise-sunset
(org-agenda-check-type nil 'agenda 'timeline)]
["Holidays" org-agenda-holidays
(org-agenda-check-type nil 'agenda 'timeline)]
["Convert" org-agenda-convert-date
(org-agenda-check-type nil 'agenda 'timeline)]
"--"
["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
"--"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 1)]
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (equal org-agenda-ndays 7)]
"--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log
:active (org-agenda-check-type nil 'agenda 'timeline)]
["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary
:active (org-agenda-check-type nil 'agenda)]
["Use Time Grid" org-agenda-toggle-time-grid
:style toggle :selected org-agenda-use-time-grid
:active (org-agenda-check-type nil 'agenda)]
["Follow Mode" org-agenda-follow-mode
:style toggle :selected org-agenda-follow-mode]
"--"
["Quit" org-agenda-quit t]
["Exit and Release Buffers" org-agenda-exit t]
))))
(defun org-mouse-get-gesture (event)
(let ((startxy (posn-x-y (event-start event)))
(endxy (posn-x-y (event-end event))))
(if (< (car startxy) (car endxy)) :right :left)))
; (setq org-agenda-mode-hook nil)
(add-hook 'org-agenda-mode-hook
'(lambda ()
(setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
(define-key org-agenda-keymap
(if (featurep 'xemacs) [button3] [mouse-3])
'org-mouse-show-context-menu)
(define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start)
(define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier)
(define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later)
(define-key org-agenda-keymap [drag-mouse-3]
'(lambda (event) (interactive "e")
(case (org-mouse-get-gesture event)
(:left (org-agenda-earlier 1))
(:right (org-agenda-later 1)))))))
(provide 'org-mouse)