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 254 2006-10-26 21:15:52Z 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.33
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 ;; + The "New Appointment" menu entry seems out of place. Remove it
81 ;; and enhance the time/data selection function so that if the text
82 ;; in the clipboard contains a date/time, then set that date as the
83 ;; default (instead of "today")
85 ;; + org-store-link, insert link
87 ;; + occur with the current word/tag (same menu item)
88 ;; + ctrl-c ctrl-c, for example, renumber the current list
91 ;; Please email me with new feature suggestions / bugs
96 ;; + added support for dragging URLs to the org-buffer
99 ;; + added support for agenda blocks
102 ;; + toggle checkboxes with a single click
105 ;; + added support for checkboxes
108 ;; + org-mode now works with the Agenda buffer as well
111 ;; + added a menu option that converts plain list items to outline items
114 ;; + "Insert Heading" now inserts a sibling heading if the point is
115 ;; on "***" and a child heading otherwise
118 ;; + compatible with Emacs 21
119 ;; + custom agenda commands added to the main menu
120 ;; + moving trees should now work between windows in the same frame
123 ;; + fixed org-mouse-at-link (thanks to Carsten)
124 ;; + removed [follow-link] bindings
127 ;; + added a menu option to remove highlights
128 ;; + compatible with org-mode 4.21 now
131 ;; + trees can be moved/promoted/demoted by dragging with the right
132 ;; mouse button (mouse-3)
133 ;; + small changes in the above function
135 ;; Versions 0.01 -- 0.07: (I don't remember)
137 (eval-when-compile (require 'cl
))
139 (defvar org-mouse-plain-list-regexp
"\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) ")
140 (defvar org-mouse-direct t
)
142 (defgroup org-mouse nil
147 (defcustom org-mouse-punctuation
":"
153 (defun org-mouse-re-search-line (regexp)
154 "Searches the current line for a given regular expression."
156 (re-search-forward regexp
(point-at-eol) t
))
158 (defun org-mouse-end-headline ()
159 "Go to the end of current headline (ignoring tags)."
162 (skip-chars-backward "\t ")
163 (when (looking-back ":[A-Za-z]+:")
164 (skip-chars-backward ":A-Za-z")
165 (skip-chars-backward "\t ")))
167 (defun org-mouse-show-context-menu (event prefix
)
168 (interactive "@e \nP")
169 (if (and (= (event-click-count event
) 1)
170 (or (not mark-active
)
171 (sit-for (/ double-click-time
1000.0))))
173 (select-window (posn-window (event-start event
)))
174 (goto-char (posn-point (event-start event
)))
175 (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook
)))
176 (let ((redisplay-dont-pause t
))
178 (if (functionp org-mouse-context-menu-function
)
179 (funcall org-mouse-context-menu-function
)
180 (mouse-major-mode-menu event prefix
))
182 (setq this-command
'mouse-save-then-kill
)
183 (mouse-save-then-kill event
)))
186 (defun org-mouse-line-position ()
187 "Returns :beginning :middle :end"
190 ((org-mouse-bolp) :begin
)
193 (defun org-mouse-empty-line ()
194 (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
196 (defun org-mouse-next-heading ()
197 "Goes to the next heading and if there is none, it ensures that the point is at the beginning of an empty line."
198 (unless (outline-next-heading)
200 (unless (org-mouse-empty-line)
204 (defun org-mouse-insert-heading ()
206 (case (org-mouse-line-position)
207 (:begin
(beginning-of-line)
208 (org-insert-heading))
209 (t (org-mouse-next-heading)
210 (org-insert-heading))))
212 (defun org-mouse-timestamp-today (&optional shift units
)
214 (flet ((org-read-date (x &optional y
) (current-time)))
215 (org-time-stamp nil
))
217 (org-timestamp-change shift units
)))
219 (defun org-mouse-keyword-menu (keywords function
&optional selected itemformat
)
223 ((functionp itemformat
) (funcall itemformat keyword
))
224 ((stringp itemformat
) (format itemformat keyword
))
226 `(funcall ,function
,keyword
)
229 ((functionp selected
) 'toggle
)
231 :selected
`(if (functionp ,selected
)
232 (funcall ,selected
,keyword
)
233 (equal ,selected
,keyword
))))
236 (defun org-mouse-remove-match-and-spaces ()
239 (when (looking-at " +")
243 (defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
)
244 (setq group
(or group
0))
246 (org-mouse-keyword-menu
248 `(lambda (keyword) (replace-match keyword t t nil
,group
))
249 `(match-string ,group
)
251 '(["None" org-mouse-remove-match-and-spaces t
])))
253 (defvar org-mouse-context-menu-function nil
)
254 (make-variable-buffer-local 'org-mouse-context-menu-function
)
256 (defun org-mouse-show-headlines ()
258 (let ((this-command 'org-cycle
)
259 (last-command 'org-cycle
)
260 (org-cycle-global-status nil
))
264 (defun org-mouse-show-overview ()
266 (let ((org-cycle-global-status nil
))
269 (defun org-mouse-set-priority (priority)
270 (flet ((read-char-exclusive () priority
))
273 (defvar org-mouse-priority-regexp
"\\[#\\([A-Z]\\)\\]"
274 "Regular expression matching the priority indicator. Differs from `org-priority-regexp' in that it doesn't contain the leading '.*?'.")
277 (defun org-mouse-get-priority (&optional default
)
279 (if (org-mouse-re-search-line org-mouse-priority-regexp
)
281 (when default
(char-to-string org-default-priority
)))))
283 (defun org-mouse-at-link ()
284 (and (eq (get-text-property (point) 'face
) 'org-link
)
286 (goto-char (previous-single-property-change (point) 'face
))
287 (or (looking-at org-bracket-link-regexp
)
288 (looking-at org-angle-link-re
)
289 (looking-at org-plain-link-re
)))))
292 (defun org-mouse-delete-timestamp ()
293 "Deletes the current timestamp as well as the preceding
294 SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
295 (when (or (org-at-date-range-p) (org-at-timestamp-p))
296 (replace-match "") ; delete the timestamp
297 (skip-chars-backward " :A-Z")
298 (when (looking-at " *[A-Z][A-Z]+:")
299 (replace-match ""))))
301 (defun org-mouse-looking-at (regexp skipchars
&optional movechars
)
303 (let ((point (point)))
304 (if (looking-at regexp
) t
305 (skip-chars-backward skipchars
)
306 (forward-char (or movechars
0))
307 (when (looking-at regexp
)
308 (> (match-end 0) point
))))))
311 (defun org-mouse-priority-list ()
312 (let ((ret) (current org-lowest-priority
))
313 (while (>= current ?A
)
314 (push (char-to-string current
) ret
)
318 (defun org-mouse-tag-menu () ;todo
320 (let ((tags (org-split-string (org-get-tags) ":")))
321 (org-mouse-keyword-menu
322 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
325 (sort (if (member tag
(quote ,tags
))
326 (delete tag
(quote ,tags
))
327 (cons tag
(quote ,tags
)))
329 `(lambda (tag) (member tag
(quote ,tags
)))
332 ["Align Tags Here" (org-set-tags nil t
) t
]
333 ["Align Tags in Buffer" (org-set-tags t t
) t
]
334 ["Set Tags ..." (org-set-tags) t
])))
338 (defun org-mouse-set-tags (tags)
340 ;; remove existing tags first
342 (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
345 ;; set new tags if any
348 (insert " :" (mapconcat 'identity tags
":") ":")
349 (org-set-tags nil t
))))
351 (defun org-mouse-insert-checkbox ()
354 (goto-char (match-end 0))
355 (unless (org-at-item-checkbox-p)
356 (delete-horizontal-space)
359 (defun org-mouse-agenda-type (type)
363 ('tags-tree
"Tags tree: ")
364 ('todo-tree
"TODO tree: ")
365 ('occur-tree
"Occur tree: ")
366 (t "Agenda command ???")))
369 (defun org-mouse-clip-text (text maxlength
)
370 (if (> (length text
) maxlength
)
371 (concat (substring text
0 (- maxlength
3)) "...")
374 (defun org-mouse-popup-global-menu ()
377 ["Show Overview" org-mouse-show-overview t
]
378 ["Show Headlines" org-mouse-show-headlines t
]
379 ["Show All" show-all t
]
380 ["Remove Highlights" org-remove-occur-highlights
381 :visible org-occur-highlights
]
384 (if (functionp 'org-check-deadlines-and-todos
)
385 (org-check-deadlines-and-todos org-deadline-warning-days
)
386 (org-check-deadlines org-deadline-warning-days
)) t
]
387 ["Check TODOs" org-show-todo-tree t
]
389 ,@(org-mouse-keyword-menu
390 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
391 '(lambda (tag) (org-tags-sparse-tree nil tag
)))
393 ["Custom Tag ..." org-tags-sparse-tree t
])
394 ["Check Phrase ..." org-occur
]
396 ["Display Agenda" org-agenda-list t
]
397 ["Display Timeline" org-timeline t
]
398 ["Display TODO List" org-todo-list t
]
400 ,@(org-mouse-keyword-menu
401 (sort (mapcar 'car
(org-get-buffer-tags)) 'string-lessp
)
402 '(lambda (tag) (org-tags-view nil tag
)))
404 ["Custom Tag ..." org-tags-view t
])
405 ["Display Calendar" org-goto-calendar t
]
407 ;; ("Custom Commands"
408 ;; ,@(org-mouse-keyword-menu
409 ;; (mapcar 'car org-agenda-custom-commands)
411 ;; (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
412 ;; (let ((current-prefix-arg t))
413 ;; (org-agenda nil)))))
414 ;; nil "Agenda (TODO) '%s'")
416 ,@(org-mouse-keyword-menu
417 (mapcar 'car org-agenda-custom-commands
)
419 (eval `(flet ((read-char-exclusive () (string-to-char ,key
)))
423 (let ((entry (assoc key org-agenda-custom-commands
)))
426 ((stringp (nth 1 entry
)) (nth 1 entry
))
427 ((stringp (nth 2 entry
))
428 (concat (org-mouse-agenda-type (nth 1 entry
))
430 (t "Agenda Command '%s'"))
434 ["Delete Blank Lines" delete-blank-lines
435 :visible
(org-mouse-empty-line)]
436 ["Insert Checkbox" org-mouse-insert-checkbox
437 :visible
(and (org-at-item-p) (not (org-at-item-checkbox-p)))]
439 (org-mouse-for-each-item 'org-mouse-insert-checkbox
)
440 :visible
(and (org-at-item-p) (not (org-at-item-checkbox-p)))]
441 ["Plain List to Outline" org-mouse-transform-to-outline
442 :visible
(org-at-item-p)])))
445 ; ["Jump" org-goto])))
447 (defun org-mouse-get-context (contextlist context
)
448 (let ((contextdata (find-if (lambda (x) (eq (car x
) context
)) contextlist
)))
451 (goto-char (nth 1 contextdata
))
452 ; (looking-at regexp)))))
453 (re-search-forward ".*" (nth 2 contextdata
))))))
455 (defun org-mouse-for-each-item (function)
458 (while t
(org-previous-item)))
464 (defun org-mouse-bolp ()
465 "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
467 (skip-chars-backward " \t*") (bolp)))
470 (defadvice dnd-insert-text
(around org-mouse-dnd-insert-text activate
)
471 (if (eq major-mode
'org-mode
)
472 (case (org-mouse-line-position)
473 (:begin
; insert before
475 (looking-at "[ \t]*")
477 (indent-to (- (match-end 0) (match-beginning 0)))
480 (:middle
; insert after
486 (:end
; insert text here
487 (skip-chars-backward " \t")
488 (kill-region (point) (point-at-eol))
489 (unless (looking-back org-mouse-punctuation
)
490 (insert (concat org-mouse-punctuation
" "))))
496 (defun org-mouse-context-menu ()
497 (let ((stamp-prefixes (list org-deadline-string org-scheduled-string
))
498 (contextlist (org-context)))
499 (flet ((get-context (context) (org-mouse-get-context contextlist context
)))
502 (and (looking-at " \\|\t") (looking-back " \\|\t")))
503 (org-mouse-popup-global-menu))
504 ;; ((get-context :todo-keyword)
505 ((get-context :checkbox
)
508 ["Toggle" org-toggle-checkbox t
]
509 ["Remove" org-mouse-remove-match-and-spaces t
]
511 ["All Clear" (org-mouse-for-each-item
513 (when (save-excursion (org-at-item-checkbox-p))
514 (replace-match "[ ]"))))]
515 ["All Set" (org-mouse-for-each-item
517 (when (save-excursion (org-at-item-checkbox-p))
518 (replace-match "[X]"))))]
519 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox
) t
]
520 ["All Remove" (org-mouse-for-each-item
522 (when (save-excursion (org-at-item-checkbox-p))
523 (org-mouse-remove-match-and-spaces))))]
525 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
526 (member (match-string 0) org-todo-keywords
))
529 ,@(org-mouse-keyword-replace-menu org-todo-keywords
)
531 ["Check TODOs" org-show-todo-tree t
]
532 ["Display TODO List" org-todo-list t
]
534 ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
535 (member (match-string 0) stamp-prefixes
))
538 ,@(org-mouse-keyword-replace-menu stamp-prefixes
)
540 ["Check Deadlines" org-check-deadlines t
]
542 ((org-mouse-looking-at org-mouse-priority-regexp
"[]A-Z#") ; priority
543 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
544 (org-mouse-priority-list) 1 "Priority %s"))))
548 ["Open" org-open-at-point t
]
549 ["Open in Emacs" (org-open-at-point t
) t
]
551 ["Copy link" (kill-new (match-string 0))]
552 ["Cut link" (kill-region (match-beginning 0) (match-end 0))]
553 ; ["Paste file link" ((insert "file:") (yank))]
555 ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -
1) ;tags
558 [,(format "Display '%s'" (match-string 1))
559 (org-tags-view nil
,(match-string 1))]
560 [,(format "Narrow to '%s'" (match-string 1))
561 (org-tags-sparse-tree nil
,(match-string 1))]
563 ,@(org-mouse-tag-menu))))
564 ((org-at-timestamp-p)
567 ["Show Day" org-open-at-point t
]
568 ["Change Timestamp" org-time-stamp t
]
569 ["Delete Timestamp" (org-mouse-delete-timestamp) t
]
570 ["Compute Time Range" org-evaluate-time-range
(org-at-date-range-p)]
572 ["Set for Today" org-mouse-timestamp-today
]
573 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day
)]
574 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day
)]
575 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day
)]
576 ["Set in a Month" (org-mouse-timestamp-today 1 'month
)]
578 ["+ 1 Day" (org-timestamp-change 1 'day
)]
579 ["+ 1 Week" (org-timestamp-change 7 'day
)]
580 ["+ 1 Month" (org-timestamp-change 1 'month
)]
582 ["- 1 Day" (org-timestamp-change -
1 'day
)]
583 ["- 1 Week" (org-timestamp-change -
7 'day
)]
584 ["- 1 Month" (org-timestamp-change -
1 'month
)])))
585 ((and (assq :headline contextlist
) (not (eolp)))
586 (let ((priority (org-mouse-get-priority t
)))
589 ("Tags and Priorities"
590 ,@(org-mouse-keyword-menu
591 (org-mouse-priority-list)
593 (org-mouse-set-priority (string-to-char keyword
)))
594 priority
"Priority %s")
596 ,@(org-mouse-tag-menu))
598 (with-current-buffer org-mouse-main-buffer
(org-agenda-show-tags))
599 :visible
(not org-mouse-direct
)]
601 (with-current-buffer org-mouse-main-buffer
(org-agenda-show-priority))
602 :visible
(not org-mouse-direct
)]
603 ,@(if org-mouse-direct
'("--") nil
)
604 ["New Heading" org-mouse-insert-heading
:visible org-mouse-direct
]
605 ;; ["New Appointment" org-mouse-new-appointment :visible org-mouse-direct]
607 ["Cycle TODO" org-todo
]
609 (progn (org-mouse-end-headline) (insert " ") (org-deadline))
610 :active
(not (save-excursion
611 (org-mouse-re-search-line org-deadline-regexp
)))]
613 (progn (org-mouse-end-headline) (insert " ") (org-schedule))
614 :active
(not (save-excursion
615 (org-mouse-re-search-line org-scheduled-regexp
)))]
617 (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil
)) t
]
618 ; ["Timestamp (inactive)" org-time-stamp-inactive t]
620 ["Archive Subtree" org-archive-subtree
]
621 ["Cut Subtree" org-cut-special
]
622 ["Copy Subtree" org-copy-special
]
623 ["Paste Subtree" org-paste-special
:visible org-mouse-direct
]
625 ;; ["Promote Subtree" org-shiftmetaleft]
626 ;; ["Demote Subtree" org-shiftmetaright]
627 ;; ["Promote Heading" org-metaleft]
628 ;; ["Demote Heading" org-metaright]
630 ["Move Trees" org-mouse-move-tree
:active nil
]
633 (org-mouse-popup-global-menu))))))
637 ;; (defun org-mouse-at-regexp (regexp)
639 ;; (let ((point (point))
640 ;; (bol (progn (beginning-of-line) (point)))
641 ;; (eol (progn (end-of-line) (point))))
643 ;; (re-search-backward regexp bol 1)
645 ;; (progn (forward-char)
646 ;; (re-search-forward regexp eol t))
647 ;; (<= (match-beginning 0) point)))))
649 (defun org-mouse-in-region-p (pos)
650 (and mark-active
(>= pos
(region-beginning)) (< pos
(region-end))))
652 (defun org-mouse-down-mouse (event)
654 (setq this-command last-command
)
655 (unless (and transient-mark-mode
656 (= 1 (event-click-count event
))
657 (org-mouse-in-region-p (posn-point (event-start event
))))
658 (mouse-drag-region event
)))
660 (add-hook 'org-mode-hook
662 (setq org-mouse-context-menu-function
'org-mouse-context-menu
)
664 ; (define-key org-mouse-map [follow-link] 'mouse-face)
665 (define-key org-mouse-map
(if (featurep 'xemacs
) [button3] [mouse-3]) nil)
666 (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
667 (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
668 (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
669 (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
670 (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
671 (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
673 (font-lock-add-keywords nil
675 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
677 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
678 (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
679 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
680 (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
683 (defadvice org-open-at-point (around org-mouse-open-at-point activate)
684 (let ((context (org-context)))
686 ((assq :headline-stars context) (org-cycle))
687 ((assq :checkbox context) (org-toggle-checkbox))
688 ((assq :item-bullet context)
689 (let ((org-cycle-include-plain-lists t)) (org-cycle)))
692 (defun org-mouse-move-tree-start (event)
694 (message "Same line: promote/demote, (***):move before, (text): make a child"))
697 (defun org-mouse-make-marker (position)
698 (with-current-buffer (window-buffer (posn-window position))
699 (copy-marker (posn-point position))))
701 (defun org-mouse-move-tree (event)
702 ;; todo: handle movements between different buffers
705 (let* ((start (org-mouse-make-marker (event-start event)))
706 (end (org-mouse-make-marker (event-end event)))
707 (sbuf (marker-buffer start))
708 (ebuf (marker-buffer end)))
710 (when (and sbuf ebuf)
713 (org-back-to-heading)
714 (if (and (eq sbuf ebuf)
717 (save-excursion (goto-char end) (org-back-to-heading) (point))))
718 ;; if the same line then promote/demote
719 (if (>= end start) (org-demote-subtree) (org-promote-subtree))
720 ;; if different lines then move
725 (org-back-to-heading)
726 (when (and (eq sbuf ebuf)
729 (save-excursion (goto-char start)
730 (org-back-to-heading) (point))))
731 (outline-end-of-subtree)
733 (if (eobp) (newline) (forward-char)))
735 (when (looking-at outline-regexp)
736 (let ((level (- (match-end 0) (match-beginning 0))))
737 (when (> end (match-end 0))
738 (outline-end-of-subtree)
740 (if (eobp) (newline) (forward-char))
741 (setq level (1+ level)))
742 (org-paste-subtree level)
744 (outline-end-of-subtree)
745 (when (bolp) (delete-char -1))))))))))
748 (defun org-mouse-transform-to-outline ()
750 (org-back-to-heading)
751 (let ((minlevel 1000)
752 (replace-text (concat (match-string 0) "* ")))
753 (beginning-of-line 2)
755 (while (not (or (eobp) (looking-at outline-regexp)))
756 (when (looking-at org-mouse-plain-list-regexp)
757 (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
759 (while (not (or (eobp) (looking-at outline-regexp)))
760 (when (and (looking-at org-mouse-plain-list-regexp)
761 (eq minlevel (- (match-end 1) (match-beginning 1))))
762 (replace-match replace-text))
767 (defun org-mouse-do-remotely (command)
768 ; (org-agenda-check-no-diary)
769 (when (get-text-property (point) 'org-marker)
770 (let* ((anticol (- (point-at-eol) (point)))
771 (marker (get-text-property (point) 'org-marker))
772 (buffer (marker-buffer marker))
773 (pos (marker-position marker))
774 (hdmarker (get-text-property (point) 'org-hd-marker))
775 (buffer-read-only nil)
776 (newhead "--- removed ---")
777 (org-mouse-direct nil)
778 (org-mouse-main-buffer (current-buffer)))
779 (when (eq (with-current-buffer buffer major-mode) 'org-mode)
780 (let ((endmarker (save-excursion
782 (outline-end-of-subtree)
784 (copy-marker (point)))))
785 (with-current-buffer buffer
788 (org-show-hidden-entry)
790 (and (outline-next-heading)
791 (org-flag-heading nil))) ; show the next heading
792 (org-back-to-heading)
793 (setq marker (copy-marker (point)))
794 (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
796 (unless (eq (marker-position marker) (marker-position endmarker))
797 (setq newhead (org-get-heading))))
799 (beginning-of-line 1)
801 (org-agenda-change-all-lines newhead hdmarker 'fixface)))
804 (defun org-mouse-agenda-context-menu ()
805 (or (org-mouse-do-remotely 'org-mouse-context-menu)
810 ["Rebuild Buffer" org-agenda-redo t]
812 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
814 ["Goto Today" org-agenda-goto-today
815 (org-agenda-check-type nil 'agenda 'timeline)]
816 ["Display Calendar" org-agenda-goto-calendar
817 (org-agenda-check-type nil 'agenda 'timeline)]
819 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
820 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
821 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
822 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
824 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
826 ["Day View" org-agenda-day-view
827 :active (org-agenda-check-type nil 'agenda)
828 :style radio :selected (equal org-agenda-ndays 1)]
829 ["Week View" org-agenda-week-view
830 :active (org-agenda-check-type nil 'agenda)
831 :style radio :selected (equal org-agenda-ndays 7)]
833 ["Show Logbook entries" org-agenda-log-mode
834 :style toggle :selected org-agenda-show-log
835 :active (org-agenda-check-type nil 'agenda 'timeline)]
836 ["Include Diary" org-agenda-toggle-diary
837 :style toggle :selected org-agenda-include-diary
838 :active (org-agenda-check-type nil 'agenda)]
839 ["Use Time Grid" org-agenda-toggle-time-grid
840 :style toggle :selected org-agenda-use-time-grid
841 :active (org-agenda-check-type nil 'agenda)]
842 ["Follow Mode" org-agenda-follow-mode
843 :style toggle :selected org-agenda-follow-mode]
845 ["Quit" org-agenda-quit t]
846 ["Exit and Release Buffers" org-agenda-exit t]
850 ; (setq org-agenda-mode-hook nil)
851 (add-hook 'org-agenda-mode-hook
853 ; (define-key org-agenda-keymap [follow-link] 'mouse-face)
854 (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
855 (define-key org-agenda-keymap
856 (if (featurep 'xemacs) [button3] [mouse-3
]) 'org-mouse-show-context-menu
)))