1 ;;; org-mouse.el --- Better mouse support for org-mode
3 ;; Copyright (c) 2006 Piotr Zielinski
5 ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
7 ;; $Id: org-mouse.el 817 2007-02-01 00:28:02Z pz215 $
9 ;; The latest version of this file is available from
11 ;; http://www.cl.cam.ac.uk/~pz215/files/org-mouse.el
13 ;; This file is *NOT* part of GNU Emacs.
14 ;; This file is distributed under the same terms as GNU Emacs.
16 ;; This program is free software; you can redistribute it and/or
17 ;; modify it under the terms of the GNU General Public License as
18 ;; published by the Free Software Foundation; either version 2 of
19 ;; the License, or (at your option) any later version.
21 ;; This program is distributed in the hope that it will be
22 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
23 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
24 ;; PURPOSE. See the GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public
27 ;; License along with this program; if not, write to the Free
28 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; Org-mouse provides better mouse support for org-mode. Org-mode is
36 ;; a mode for keeping notes, maintaining ToDo lists, and doing project
37 ;; planning with a fast and effective plain-text system. It is
40 ;; http://staff.science.uva.nl/~dominik/Tools/org/
42 ;; Org-mouse implements the following features:
43 ;; * following links with the left mouse button (in Emacs 22)
44 ;; * subtree expansion/collapse (org-cycle) with the left mouse button
45 ;; * several context menus on the right mouse button:
52 ;; * promoting/demoting/moving subtrees with mouse-3
53 ;; + if the drag starts and ends in the same line then promote/demote
54 ;; + otherwise move the subtree
55 ;; * date/time extraction from selected text (requires a python script)
56 ;; (eg. select text from your email and click "Add Appointment")
58 ;; The python script that automatically extracts date/time information
59 ;; from a piece of English text is available from:
61 ;; http://www.cl.cam.ac.uk/~pz215/files/timeparser.py
66 ;; To use this package, put the following line in your .emacs:
68 ;; (require 'org-mouse)
70 ;; Tested with Emacs 22.0.50, org-mode 4.58
73 ;; + deal with folding / unfolding issues
75 ;; TODO (This list is only theoretical, if you'd like to have some
76 ;; feature implemented or a bug fix please send me an email, even if
77 ;; something similar appears in the list below. This will help me get
78 ;; the priorities right.):
80 ;; + org-store-link, insert link
82 ;; + occur with the current word/tag (same menu item)
83 ;; + ctrl-c ctrl-c, for example, renumber the current list
86 ;; Please email me with new feature suggestions / bugs
91 ;; + minor changes to the table menu
94 ;; + preliminary support for tables and calculation marks
95 ;; + context menu support for org-agenda-undo & org-sort-entries
98 ;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
101 ;; + selected text activates its context menu
102 ;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link
105 ;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
106 ;; + the TODO menu can now list occurrences of a specific TODO keyword
107 ;; + #+STARTUP line is now recognized
110 ;; + added support for dragging URLs to the org-buffer
113 ;; + added support for agenda blocks
116 ;; + toggle checkboxes with a single click
119 ;; + added support for checkboxes
122 ;; + org-mode now works with the Agenda buffer as well
125 ;; + added a menu option that converts plain list items to outline items
128 ;; + "Insert Heading" now inserts a sibling heading if the point is
129 ;; on "***" and a child heading otherwise
132 ;; + compatible with Emacs 21
133 ;; + custom agenda commands added to the main menu
134 ;; + moving trees should now work between windows in the same frame
137 ;; + fixed org-mouse-at-link (thanks to Carsten)
138 ;; + removed [follow-link] bindings
141 ;; + added a menu option to remove highlights
142 ;; + compatible with org-mode 4.21 now
145 ;; + trees can be moved/promoted/demoted by dragging with the right
146 ;; mouse button (mouse-3)
147 ;; + small changes in the above function
149 ;; Versions 0.01 -- 0.07: (I don't remember)
153 (defvar org-mouse-plain-list-regexp
"\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) ")
154 (defvar org-mouse-direct t
)
156 (defgroup org-mouse nil
161 (defcustom org-mouse-punctuation
":"
167 (defun org-mouse-re-search-line (regexp)
168 "Searches the current line for a given regular expression."
170 (re-search-forward regexp
(point-at-eol) t
))
172 (defun org-mouse-end-headline ()
173 "Go to the end of current headline (ignoring tags)."
176 (skip-chars-backward "\t ")
177 (when (looking-back ":[A-Za-z]+:")
178 (skip-chars-backward ":A-Za-z")
179 (skip-chars-backward "\t ")))
182 (defun org-mouse-show-context-menu (event prefix
)
183 (interactive "@e \nP")
184 (if (and (= (event-click-count event
) 1)
185 (or (not mark-active
)
186 (sit-for (/ double-click-time
1000.0))))
188 (select-window (posn-window (event-start event
)))
189 (when (not (org-mouse-mark-active))
190 (goto-char (posn-point (event-start event
)))
191 (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook
)))
192 (let ((redisplay-dont-pause t
))
194 (if (functionp org-mouse-context-menu-function
)
195 (funcall org-mouse-context-menu-function event
)
196 (mouse-major-mode-menu event prefix
))
198 (setq this-command
'mouse-save-then-kill
)
199 (mouse-save-then-kill event
)))
202 (defun org-mouse-line-position ()
203 "Returns :beginning :middle :end"
206 ((org-mouse-bolp) :begin
)
209 (defun org-mouse-empty-line ()
210 (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
212 (defun org-mouse-next-heading ()
213 "Goes to the next heading and if there is none, it ensures that the point is at the beginning of an empty line."
214 (unless (outline-next-heading)
216 (unless (org-mouse-empty-line)
220 (defun org-mouse-insert-heading ()
222 (case (org-mouse-line-position)
223 (:begin
(beginning-of-line)
224 (org-insert-heading))
225 (t (org-mouse-next-heading)
226 (org-insert-heading))))
228 (defun org-mouse-timestamp-today (&optional shift units
)
230 (flet ((org-read-date (&rest rest
) (current-time)))
231 (org-time-stamp nil
))
233 (org-timestamp-change shift units
)))
235 (defun org-mouse-keyword-menu (keywords function
&optional selected itemformat
)
239 ((functionp ,itemformat
) (funcall ,itemformat keyword
))
240 ((stringp ,itemformat
) (format ,itemformat keyword
))
242 (list 'funcall
,function keyword
)
245 ((functionp ,selected
) 'toggle
)
247 :selected
(if (functionp ,selected
)
248 (and (funcall ,selected keyword
) t
)
249 (equal ,selected keyword
))))
252 (defun org-mouse-remove-match-and-spaces ()
257 (defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
258 literal string subexp
)
259 "The same as replace-match, but surrounds the replacement with spaces."
260 (apply 'replace-match rest
)
262 (goto-char (match-beginning (or subexp
0)))
264 (goto-char (match-end (or subexp
0)))
268 (defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
270 (setq group
(or group
0))
271 (let ((replace (org-mouse-match-closure
272 (if nosurround
'replace-match
273 'org-mouse-replace-match-and-surround
))))
275 (org-mouse-keyword-menu
277 `(lambda (keyword) (funcall ,replace keyword t t nil
,group
))
280 `(["None" org-mouse-remove-match-and-spaces
282 :selected
,(not (member (match-string group
) keywords
))]))))
284 (defvar org-mouse-context-menu-function nil
)
285 (make-variable-buffer-local 'org-mouse-context-menu-function
)
287 (defun org-mouse-show-headlines ()
289 (let ((this-command 'org-cycle
)
290 (last-command 'org-cycle
)
291 (org-cycle-global-status nil
))
295 (defun org-mouse-show-overview ()
297 (let ((org-cycle-global-status nil
))
300 (defun org-mouse-set-priority (priority)
301 (flet ((read-char-exclusive () priority
))
304 (defvar org-mouse-priority-regexp
"\\[#\\([A-Z]\\)\\]"
305 "Regular expression matching the priority indicator. Differs from `org-priority-regexp' in that it doesn't contain the leading '.*?'.")
308 (defun org-mouse-get-priority (&optional default
)
310 (if (org-mouse-re-search-line org-mouse-priority-regexp
)
312 (when default
(char-to-string org-default-priority
)))))
314 (defun org-mouse-at-link ()
315 (and (eq (get-text-property (point) 'face
) 'org-link
)
317 (goto-char (previous-single-property-change (point) 'face
))
318 (or (looking-at org-bracket-link-regexp
)
319 (looking-at org-angle-link-re
)
320 (looking-at org-plain-link-re
)))))
323 (defun org-mouse-delete-timestamp ()
324 "Deletes the current timestamp as well as the preceding
325 SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
326 (when (or (org-at-date-range-p) (org-at-timestamp-p))
327 (replace-match "") ; delete the timestamp
328 (skip-chars-backward " :A-Z")
329 (when (looking-at " *[A-Z][A-Z]+:")
330 (replace-match ""))))
332 (defun org-mouse-looking-at (regexp skipchars
&optional movechars
)
334 (let ((point (point)))
335 (if (looking-at regexp
) t
336 (skip-chars-backward skipchars
)
337 (forward-char (or movechars
0))
338 (when (looking-at regexp
)
339 (> (match-end 0) point
))))))
342 (defun org-mouse-priority-list ()
343 (loop for priority from ?A to org-lowest-priority
344 collect
(char-to-string priority
)))
346 (defun org-mouse-tag-menu () ;todo
348 (let ((tags (org-split-string (org-get-tags) ":")))
349 (org-mouse-keyword-menu
350 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
353 (sort (if (member tag
(quote ,tags
))
354 (delete tag
(quote ,tags
))
355 (cons tag
(quote ,tags
)))
357 `(lambda (tag) (member tag
(quote ,tags
)))
360 ["Align Tags Here" (org-set-tags nil t
) t
]
361 ["Align Tags in Buffer" (org-set-tags t t
) t
]
362 ["Set Tags ..." (org-set-tags) t
])))
366 (defun org-mouse-set-tags (tags)
368 ;; remove existing tags first
370 (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
373 ;; set new tags if any
376 (insert " :" (mapconcat 'identity tags
":") ":")
377 (org-set-tags nil t
))))
379 (defun org-mouse-insert-checkbox ()
382 (goto-char (match-end 0))
383 (unless (org-at-item-checkbox-p)
384 (delete-horizontal-space)
387 (defun org-mouse-agenda-type (type)
391 ('tags-tree
"Tags tree: ")
392 ('todo-tree
"TODO tree: ")
393 ('occur-tree
"Occur tree: ")
394 (t "Agenda command ???")))
397 (defun org-mouse-list-options-menu (alloptions &optional function
)
398 (let ((options (save-match-data
399 (split-string (match-string-no-properties 1)))))
401 (loop for name in alloptions
407 (sort (if (member ',name
',options
)
408 (delete ',name
',options
)
409 (cons ',name
',options
))
413 (when (functionp ',function
) (funcall ',function
)))
415 :selected
(and (member name options
) t
)))))
420 (defun org-mouse-clip-text (text maxlength
)
421 (if (> (length text
) maxlength
)
422 (concat (substring text
0 (- maxlength
3)) "...")
425 (defun org-mouse-popup-global-menu ()
428 ["Show Overview" org-mouse-show-overview t
]
429 ["Show Headlines" org-mouse-show-headlines t
]
430 ["Show All" show-all t
]
431 ["Remove Highlights" org-remove-occur-highlights
432 :visible org-occur-highlights
]
435 (if (functionp 'org-check-deadlines-and-todos
)
436 (org-check-deadlines-and-todos org-deadline-warning-days
)
437 (org-check-deadlines org-deadline-warning-days
)) t
]
438 ["Check TODOs" org-show-todo-tree t
]
440 ,@(org-mouse-keyword-menu
441 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
442 '(lambda (tag) (org-tags-sparse-tree nil tag
)))
444 ["Custom Tag ..." org-tags-sparse-tree t
])
445 ["Check Phrase ..." org-occur
]
447 ["Display Agenda" org-agenda-list t
]
448 ["Display Timeline" org-timeline t
]
449 ["Display TODO List" org-todo-list t
]
451 ,@(org-mouse-keyword-menu
452 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
453 '(lambda (tag) (org-tags-view nil tag
)))
455 ["Custom Tag ..." org-tags-view t
])
456 ["Display Calendar" org-goto-calendar t
]
458 ,@(org-mouse-keyword-menu
459 (mapcar 'car org-agenda-custom-commands
)
461 (eval `(flet ((read-char-exclusive () (string-to-char ,key
)))
465 (let ((entry (assoc key org-agenda-custom-commands
)))
468 ((stringp (nth 1 entry
)) (nth 1 entry
))
469 ((stringp (nth 2 entry
))
470 (concat (org-mouse-agenda-type (nth 1 entry
))
472 (t "Agenda Command '%s'"))
476 ["Delete Blank Lines" delete-blank-lines
477 :visible
(org-mouse-empty-line)]
478 ["Insert Checkbox" org-mouse-insert-checkbox
479 :visible
(and (org-at-item-p) (not (org-at-item-checkbox-p)))]
481 (org-mouse-for-each-item 'org-mouse-insert-checkbox
)
482 :visible
(and (org-at-item-p) (not (org-at-item-checkbox-p)))]
483 ["Plain List to Outline" org-mouse-transform-to-outline
484 :visible
(org-at-item-p)])))
487 (defun org-mouse-get-context (contextlist context
)
488 (let ((contextdata (assq context contextlist
)))
491 (goto-char (second contextdata
))
492 (re-search-forward ".*" (third contextdata
))))))
494 (defun org-mouse-for-each-item (function)
497 (while t
(org-previous-item)))
503 (defun org-mouse-bolp ()
504 "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
506 (skip-chars-backward " \t*") (bolp)))
508 (defun org-mouse-insert-item (text)
509 (case (org-mouse-line-position)
510 (:begin
; insert before
512 (looking-at "[ \t]*")
514 (indent-to (- (match-end 0) (match-beginning 0)))
517 (:middle
; insert after
523 (:end
; insert text here
524 (skip-chars-backward " \t")
525 (kill-region (point) (point-at-eol))
526 (unless (looking-back org-mouse-punctuation
)
527 (insert (concat org-mouse-punctuation
" ")))))
534 (defadvice dnd-insert-text
(around org-mouse-dnd-insert-text activate
)
535 (if (eq major-mode
'org-mode
)
536 (org-mouse-insert-item text
)
539 (defadvice dnd-open-file
(around org-mouse-dnd-open-file activate
)
540 (if (eq major-mode
'org-mode
)
541 (org-mouse-insert-item uri
)
544 (defun org-mouse-match-closure (function)
545 (let ((match (match-data t
)))
546 `(lambda (&rest rest
)
548 (set-match-data ',match
)
549 (apply ',function rest
)))))
551 (defun org-mouse-match-todo-keyword ()
553 (org-back-to-heading)
554 (if (looking-at outline-regexp
) (goto-char (match-end 0)))
555 (or (looking-at (concat " +" org-todo-regexp
" *"))
556 (looking-at " \\( *\\)"))))
558 (defun org-mouse-yank-link (click)
560 ;; Give temporary modes such as isearch a chance to turn off.
561 (run-hooks 'mouse-leave-buffer-hook
)
562 (mouse-set-point click
)
563 (setq mouse-selection-click-count
0)
564 (delete-horizontal-space)
565 (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
568 (defun org-mouse-context-menu (&optional event
)
569 (let ((stamp-prefixes (list org-deadline-string org-scheduled-string
))
570 (contextlist (org-context)))
571 (flet ((get-context (context) (org-mouse-get-context contextlist context
)))
573 ((org-mouse-mark-active)
574 (let ((region-string (buffer-substring (region-beginning) (region-end))))
577 ["Sparse Tree" (org-occur ',region-string
)]
578 ["Find in Buffer" (occur ',region-string
)]
579 ["Grep in Current Dir"
580 (grep (format "grep -rnH -e '%s' *" ',region-string
))]
581 ["Grep in Parent Dir"
582 (grep (format "grep -rnH -e '%s' ../*" ',region-string
))]
585 (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
586 (save-excursion (goto-char (region-end)) (insert "]]")))]
587 ["Insert Link Here" (org-mouse-yank-link ',event
)]))))
589 ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
592 ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options
)
593 'org-mode-restart
))))
595 (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
596 (looking-back " \\|\t")))
597 (org-mouse-popup-global-menu))
598 ((get-context :checkbox
)
601 ["Toggle" org-toggle-checkbox t
]
602 ["Remove" org-mouse-remove-match-and-spaces t
]
604 ["All Clear" (org-mouse-for-each-item
606 (when (save-excursion (org-at-item-checkbox-p))
607 (replace-match "[ ]"))))]
608 ["All Set" (org-mouse-for-each-item
610 (when (save-excursion (org-at-item-checkbox-p))
611 (replace-match "[X]"))))]
612 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox
) t
]
613 ["All Remove" (org-mouse-for-each-item
615 (when (save-excursion (org-at-item-checkbox-p))
616 (org-mouse-remove-match-and-spaces))))]
618 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
619 (member (match-string 0) org-todo-keywords
))
622 ,@(org-mouse-keyword-replace-menu org-todo-keywords
)
624 ["Check TODOs" org-show-todo-tree t
]
625 ["List all TODO keywords" org-todo-list t
]
626 [,(format "List only %s" (match-string 0))
627 (org-todo-list (match-string 0)) t
]
629 ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
630 (member (match-string 0) stamp-prefixes
))
633 ,@(org-mouse-keyword-replace-menu stamp-prefixes
)
635 ["Check Deadlines" org-check-deadlines t
]
637 ((org-mouse-looking-at org-mouse-priority-regexp
"[]A-Z#") ; priority
638 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
639 (org-mouse-priority-list) 1 "Priority %s" t
))))
643 ["Open" org-open-at-point t
]
644 ["Open in Emacs" (org-open-at-point t
) t
]
646 ["Copy link" (kill-new (match-string 0))]
649 (kill-region (match-beginning 0) (match-end 0))
653 (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
654 ; ["Paste file link" ((insert "file:") (yank))]
656 ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -
1) ;tags
659 [,(format "Display '%s'" (match-string 1))
660 (org-tags-view nil
,(match-string 1))]
661 [,(format "Sparse Tree '%s'" (match-string 1))
662 (org-tags-sparse-tree nil
,(match-string 1))]
664 ,@(org-mouse-tag-menu))))
665 ((org-at-timestamp-p)
668 ["Show Day" org-open-at-point t
]
669 ["Change Timestamp" org-time-stamp t
]
670 ["Delete Timestamp" (org-mouse-delete-timestamp) t
]
671 ["Compute Time Range" org-evaluate-time-range
(org-at-date-range-p)]
673 ["Set for Today" org-mouse-timestamp-today
]
674 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day
)]
675 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day
)]
676 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day
)]
677 ["Set in a Month" (org-mouse-timestamp-today 1 'month
)]
679 ["+ 1 Day" (org-timestamp-change 1 'day
)]
680 ["+ 1 Week" (org-timestamp-change 7 'day
)]
681 ["+ 1 Month" (org-timestamp-change 1 'month
)]
683 ["- 1 Day" (org-timestamp-change -
1 'day
)]
684 ["- 1 Week" (org-timestamp-change -
7 'day
)]
685 ["- 1 Month" (org-timestamp-change -
1 'month
)])))
686 ((get-context :table-special
)
687 (let ((mdata (match-data)))
689 (store-match-data mdata
))
690 (message "match: %S" (match-string 0))
691 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
692 '(" " "!" "^" "_" "$" "#" "*" "'") 0
694 (case (string-to-char mark
)
695 (?
"( ) Nothing Special")
696 (?
! "(!) Column Names")
697 (?^
"(^) Field Names Above")
698 (?_
"(^) Field Names Below")
699 (?$
"($) Formula Parameters")
700 (?
# "(#) Recalculation: Auto")
701 (?
* "(*) Recalculation: Manual")
702 (?
' "(') Recalculation: None"))) t
))))
703 ((assq :table contextlist
)
706 ["Align Table" org-ctrl-c-ctrl-c
]
707 ["Blank Field" org-table-blank-field
]
708 ["Edit Field" org-table-edit-field
]
711 ["Move Column Left" org-metaleft
]
712 ["Move Column Right" org-metaright
]
713 ["Delete Column" org-shiftmetaleft
]
714 ["Insert Column" org-shiftmetaright
]
716 ["Enable Narrowing" (setq org-table-limit-column-width
(not org-table-limit-column-width
)) :selected org-table-limit-column-width
:style toggle
])
718 ["Move Row Up" org-metaup
]
719 ["Move Row Down" org-metadown
]
720 ["Delete Row" org-shiftmetaup
]
721 ["Insert Row" org-shiftmetadown
]
722 ["Sort lines in region" org-table-sort-lines
(org-at-table-p)]
724 ["Insert Hline" org-table-insert-hline
])
726 ["Copy Rectangle" org-copy-special
]
727 ["Cut Rectangle" org-cut-special
]
728 ["Paste Rectangle" org-paste-special
]
729 ["Fill Rectangle" org-table-wrap-region
])
731 ["Set Column Formula" org-table-eval-formula
]
732 ["Set Field Formula" (org-table-eval-formula '(4))]
733 ["Edit Formulas" org-table-edit-formulas
]
735 ["Recalculate Line" org-table-recalculate
]
736 ["Recalculate All" (org-table-recalculate '(4))]
737 ["Iterate All" (org-table-recalculate '(16))]
739 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks
]
740 ["Sum Column/Rectangle" org-table-sum
741 :active
(or (org-at-table-p) (org-region-active-p))]
742 ["Field Info" org-table-field-info
]
744 (setq org-table-formula-debug
(not org-table-formula-debug
))
745 :style toggle
:selected org-table-formula-debug
]
747 ((and (assq :headline contextlist
) (not (eolp)))
748 (let ((priority (org-mouse-get-priority t
)))
751 ("Tags and Priorities"
752 ,@(org-mouse-keyword-menu
753 (org-mouse-priority-list)
755 (org-mouse-set-priority (string-to-char keyword
)))
756 priority
"Priority %s")
758 ,@(org-mouse-tag-menu))
760 ,@(progn (org-mouse-match-todo-keyword)
761 (org-mouse-keyword-replace-menu org-todo-keywords
1)))
763 (with-current-buffer org-mouse-main-buffer
(org-agenda-show-tags))
764 :visible
(not org-mouse-direct
)]
766 (with-current-buffer org-mouse-main-buffer
(org-agenda-show-priority))
767 :visible
(not org-mouse-direct
)]
768 ,@(if org-mouse-direct
'("--") nil
)
769 ["New Heading" org-mouse-insert-heading
:visible org-mouse-direct
]
771 (progn (org-mouse-end-headline) (insert " ") (org-deadline))
772 :active
(not (save-excursion
773 (org-mouse-re-search-line org-deadline-regexp
)))]
775 (progn (org-mouse-end-headline) (insert " ") (org-schedule))
776 :active
(not (save-excursion
777 (org-mouse-re-search-line org-scheduled-regexp
)))]
779 (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil
)) t
]
780 ; ["Timestamp (inactive)" org-time-stamp-inactive t]
782 ["Archive Subtree" org-archive-subtree
]
783 ["Cut Subtree" org-cut-special
]
784 ["Copy Subtree" org-copy-special
]
785 ["Paste Subtree" org-paste-special
:visible org-mouse-direct
]
787 ["Alphabetically" (org-sort-entries nil ?a
)]
788 ["Numerically" (org-sort-entries nil ?n
)]
789 ["By Time/Date" (org-sort-entries nil ?t
)]
791 ["Reverse Alphabetically" (org-sort-entries nil ?A
)]
792 ["Reverse Numerically" (org-sort-entries nil ?N
)]
793 ["Reverse By Time/Date" (org-sort-entries nil ?T
)])
795 ["Move Trees" org-mouse-move-tree
:active nil
]
798 (org-mouse-popup-global-menu))))))
802 ;; (defun org-mouse-at-regexp (regexp)
804 ;; (let ((point (point))
805 ;; (bol (progn (beginning-of-line) (point)))
806 ;; (eol (progn (end-of-line) (point))))
808 ;; (re-search-backward regexp bol 1)
810 ;; (progn (forward-char)
811 ;; (re-search-forward regexp eol t))
812 ;; (<= (match-beginning 0) point)))))
814 (defun org-mouse-mark-active ()
815 (and mark-active transient-mark-mode
))
817 (defun org-mouse-in-region-p (pos)
818 (and (org-mouse-mark-active)
819 (>= pos
(region-beginning))
820 (< pos
(region-end))))
822 (defun org-mouse-down-mouse (event)
824 (setq this-command last-command
)
825 (unless (and (= 1 (event-click-count event
))
826 (org-mouse-in-region-p (posn-point (event-start event
))))
827 (mouse-drag-region event
)))
829 (add-hook 'org-mode-hook
831 (setq org-mouse-context-menu-function
'org-mouse-context-menu
)
833 ; (define-key org-mouse-map [follow-link] 'mouse-face)
834 (define-key org-mouse-map
(if (featurep 'xemacs
) [button3] [mouse-3]) nil)
835 (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
836 (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
837 (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
838 (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
839 (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link)
840 (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)
841 (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
842 (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
844 (font-lock-add-keywords nil
846 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
848 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
849 (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
850 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
851 (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
854 (defadvice org-open-at-point (around org-mouse-open-at-point activate)
855 (let ((context (org-context)))
857 ((assq :headline-stars context) (org-cycle))
858 ((assq :checkbox context) (org-toggle-checkbox))
859 ((assq :item-bullet context)
860 (let ((org-cycle-include-plain-lists t)) (org-cycle)))
863 (defun org-mouse-move-tree-start (event)
865 (message "Same line: promote/demote, (***):move before, (text): make a child"))
868 (defun org-mouse-make-marker (position)
869 (with-current-buffer (window-buffer (posn-window position))
870 (copy-marker (posn-point position))))
872 (defun org-mouse-move-tree (event)
873 ;; todo: handle movements between different buffers
876 (let* ((start (org-mouse-make-marker (event-start event)))
877 (end (org-mouse-make-marker (event-end event)))
878 (sbuf (marker-buffer start))
879 (ebuf (marker-buffer end)))
881 (when (and sbuf ebuf)
884 (org-back-to-heading)
885 (if (and (eq sbuf ebuf)
888 (save-excursion (goto-char end) (org-back-to-heading) (point))))
889 ;; if the same line then promote/demote
890 (if (>= end start) (org-demote-subtree) (org-promote-subtree))
891 ;; if different lines then move
896 (org-back-to-heading)
897 (when (and (eq sbuf ebuf)
900 (save-excursion (goto-char start)
901 (org-back-to-heading) (point))))
902 (outline-end-of-subtree)
904 (if (eobp) (newline) (forward-char)))
906 (when (looking-at outline-regexp)
907 (let ((level (- (match-end 0) (match-beginning 0))))
908 (when (> end (match-end 0))
909 (outline-end-of-subtree)
911 (if (eobp) (newline) (forward-char))
912 (setq level (1+ level)))
913 (org-paste-subtree level)
915 (outline-end-of-subtree)
916 (when (bolp) (delete-char -1))))))))))
919 (defun org-mouse-transform-to-outline ()
921 (org-back-to-heading)
922 (let ((minlevel 1000)
923 (replace-text (concat (match-string 0) "* ")))
924 (beginning-of-line 2)
926 (while (not (or (eobp) (looking-at outline-regexp)))
927 (when (looking-at org-mouse-plain-list-regexp)
928 (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
930 (while (not (or (eobp) (looking-at outline-regexp)))
931 (when (and (looking-at org-mouse-plain-list-regexp)
932 (eq minlevel (- (match-end 1) (match-beginning 1))))
933 (replace-match replace-text))
938 (defun org-mouse-do-remotely (command)
939 ; (org-agenda-check-no-diary)
940 (when (get-text-property (point) 'org-marker)
941 (let* ((anticol (- (point-at-eol) (point)))
942 (marker (get-text-property (point) 'org-marker))
943 (buffer (marker-buffer marker))
944 (pos (marker-position marker))
945 (hdmarker (get-text-property (point) 'org-hd-marker))
946 (buffer-read-only nil)
947 (newhead "--- removed ---")
948 (org-mouse-direct nil)
949 (org-mouse-main-buffer (current-buffer)))
950 (when (eq (with-current-buffer buffer major-mode) 'org-mode)
951 (let ((endmarker (save-excursion
953 (outline-end-of-subtree)
955 (copy-marker (point)))))
956 (org-with-remote-undo buffer
957 (with-current-buffer buffer
960 (org-show-hidden-entry)
962 (and (outline-next-heading)
963 (org-flag-heading nil))) ; show the next heading
964 (org-back-to-heading)
965 (setq marker (copy-marker (point)))
966 (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
968 (message "_cmd: %S" _cmd)
969 (message "this-command: %S" this-command)
970 (unless (eq (marker-position marker) (marker-position endmarker))
971 (setq newhead (org-get-heading))))
973 (beginning-of-line 1)
975 (org-agenda-change-all-lines newhead hdmarker 'fixface))))
978 (defun org-mouse-agenda-context-menu (&optional event)
979 (or (org-mouse-do-remotely 'org-mouse-context-menu)
984 ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo))
985 :visible (if (eq last-command 'org-agenda-undo)
986 org-agenda-pending-undo-list
987 org-agenda-undo-list)]
988 ["Rebuild Buffer" org-agenda-redo t]
990 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
992 ["Goto Today" org-agenda-goto-today
993 (org-agenda-check-type nil 'agenda 'timeline) t]
994 ["Display Calendar" org-agenda-goto-calendar
995 (org-agenda-check-type nil 'agenda 'timeline) t]
997 ["Phases of the Moon" org-agenda-phases-of-moon
998 (org-agenda-check-type nil 'agenda 'timeline)]
999 ["Sunrise/Sunset" org-agenda-sunrise-sunset
1000 (org-agenda-check-type nil 'agenda 'timeline)]
1001 ["Holidays" org-agenda-holidays
1002 (org-agenda-check-type nil 'agenda 'timeline)]
1003 ["Convert" org-agenda-convert-date
1004 (org-agenda-check-type nil 'agenda 'timeline)]
1006 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
1008 ["Day View" org-agenda-day-view
1009 :active (org-agenda-check-type nil 'agenda)
1010 :style radio :selected (equal org-agenda-ndays 1)]
1011 ["Week View" org-agenda-week-view
1012 :active (org-agenda-check-type nil 'agenda)
1013 :style radio :selected (equal org-agenda-ndays 7)]
1015 ["Show Logbook entries" org-agenda-log-mode
1016 :style toggle :selected org-agenda-show-log
1017 :active (org-agenda-check-type nil 'agenda 'timeline)]
1018 ["Include Diary" org-agenda-toggle-diary
1019 :style toggle :selected org-agenda-include-diary
1020 :active (org-agenda-check-type nil 'agenda)]
1021 ["Use Time Grid" org-agenda-toggle-time-grid
1022 :style toggle :selected org-agenda-use-time-grid
1023 :active (org-agenda-check-type nil 'agenda)]
1024 ["Follow Mode" org-agenda-follow-mode
1025 :style toggle :selected org-agenda-follow-mode]
1027 ["Quit" org-agenda-quit t]
1028 ["Exit and Release Buffers" org-agenda-exit t]
1032 (defun org-mouse-get-gesture (event)
1033 (let ((startxy (posn-x-y (event-start event)))
1034 (endxy (posn-x-y (event-end event))))
1035 (if (< (car startxy) (car endxy)) :right :left)))
1038 ; (setq org-agenda-mode-hook nil)
1039 (add-hook 'org-agenda-mode-hook
1041 (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
1042 (define-key org-agenda-keymap
1043 (if (featurep 'xemacs) [button3] [mouse-3
])
1044 'org-mouse-show-context-menu
)
1045 (define-key org-agenda-keymap
[down-mouse-3
] 'org-mouse-move-tree-start
)
1046 (define-key org-agenda-keymap
[C-mouse-4
] 'org-agenda-earlier
)
1047 (define-key org-agenda-keymap
[C-mouse-5
] 'org-agenda-later
)
1048 (define-key org-agenda-keymap
[drag-mouse-3
]
1049 '(lambda (event) (interactive "e")
1050 (case (org-mouse-get-gesture event
)
1051 (:left
(org-agenda-earlier 1))
1052 (:right
(org-agenda-later 1)))))))
1054 (provide 'org-mouse
)