Mercurial > emacs
annotate lisp/textmodes/org-mouse.el @ 93075:66248fc5b523
* w32fns.c (hourglass_timer, hourglass_hwnd): New variables.
(syms_of_w32fns): Initialize them.
(HOURGLASS_ID): New constant.
(x_window_to_frame): Don't check hourglass_window.
(w32_wnd_proc) <WM_TIMER>: Handle hourglass_timer.
(w32_wnd_proc) <WM_EXITMENULOOP>: Set pending hourglass cursor.
(w32_wnd_proc) <WM_SETCURSOR>: Set the hourglass or current cursor.
(w32_wnd_proc) <WM_EMACS_SETCURSOR>: Set frame's current_cursor.
Only change the cursor if hourglass is not active.
(Fx_create_frame): Initialize frame's current_cursor.
(hourglass_atimer): Remove.
(hourglass_started): New function.
(start_hourglass, cancel_hourglass, hide_hourglass): Adapt to w32.
(show_hourglass): Adapt to w32, changing argument to frame.
* w32term.h (struct w32_output): Remove hourglass_window.
Add current_cursor.
* eval.c (call_debugger, Fsignal):
* keyboard.c (recursive_edit_1, cmd_error, Ftop_level)
(command_loop_1, Fread_key_sequence, Fread_key_sequence_vector)
(Fexecute_extended_command, cancel_hourglass_unwind):
* minibuf.c (read_minibuf):
* fns.c (Fy_or_n_p): Enable hourglass when HAVE_WINDOW_SYSTEM.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Wed, 19 Mar 2008 17:04:14 +0000 |
parents | 9d0bccd6c171 |
children |
rev | line source |
---|---|
87831 | 1 ;;; org-mouse.el --- Better mouse support for org-mode |
2 | |
87841
f76850f6a776
Remove copyright from author with assignment, merge years into FSF
Glenn Morris <rgm@gnu.org>
parents:
87831
diff
changeset
|
3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation |
87831 | 4 ;; |
5 ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> | |
6 ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> | |
92876
9d0bccd6c171
*** empty log message ***
Carsten Dominik <dominik@science.uva.nl>
parents:
87846
diff
changeset
|
7 ;; Version: 5.23 |
87831 | 8 ;; |
9 ;; This file is part of GNU Emacs. | |
10 ;; | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 3, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
24 ;; Boston, MA 02110-1301, USA. | |
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
26 ;; | |
27 ;;; Commentary: | |
28 ;; | |
29 ;; Org-mouse provides mouse support for org-mode. | |
30 ;; | |
31 ;; http://orgmode.org | |
32 ;; | |
33 ;; Org-mouse implements the following features: | |
34 ;; * following links with the left mouse button (in Emacs 22) | |
35 ;; * subtree expansion/collapse (org-cycle) with the left mouse button | |
36 ;; * several context menus on the right mouse button: | |
37 ;; + general text | |
38 ;; + headlines | |
39 ;; + timestamps | |
40 ;; + priorities | |
41 ;; + links | |
42 ;; + tags | |
43 ;; * promoting/demoting/moving subtrees with mouse-3 | |
44 ;; + if the drag starts and ends in the same line then promote/demote | |
45 ;; + otherwise move the subtree | |
46 ;; | |
47 ;; Use | |
48 ;; --- | |
49 ;; | |
50 ;; To use this package, put the following line in your .emacs: | |
51 ;; | |
52 ;; (require 'org-mouse) | |
53 ;; | |
54 | |
55 ;; Fixme: | |
56 ;; + deal with folding / unfolding issues | |
57 | |
58 ;; TODO (This list is only theoretical, if you'd like to have some | |
59 ;; feature implemented or a bug fix please send me an email, even if | |
60 ;; something similar appears in the list below. This will help me get | |
61 ;; the priorities right.): | |
62 ;; | |
63 ;; + org-store-link, insert link | |
64 ;; + org tables | |
65 ;; + occur with the current word/tag (same menu item) | |
66 ;; + ctrl-c ctrl-c, for example, renumber the current list | |
67 ;; + internal links | |
68 | |
69 ;; Please email the maintainer with new feature suggestions / bugs | |
70 | |
71 ;; History: | |
72 ;; | |
73 ;; SInce version 5.10: Changes are listed in the general org-mode docs. | |
74 ;; | |
75 ;; Version 5.09 | |
76 ;; + Version number synchronization with Org-mode. | |
77 ;; | |
78 ;; Version 0.25 | |
79 ;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) | |
80 ;; | |
81 ;; Version 0.24 | |
82 ;; + minor changes to the table menu | |
83 ;; | |
84 ;; Version 0.23 | |
85 ;; + preliminary support for tables and calculation marks | |
86 ;; + context menu support for org-agenda-undo & org-sort-entries | |
87 ;; | |
88 ;; Version 0.22 | |
89 ;; + handles undo support for the agenda buffer (requires org-mode >=4.58) | |
90 ;; | |
91 ;; Version 0.21 | |
92 ;; + selected text activates its context menu | |
93 ;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link | |
94 ;; | |
95 ;; Version 0.20 | |
96 ;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item | |
97 ;; + the TODO menu can now list occurrences of a specific TODO keyword | |
98 ;; + #+STARTUP line is now recognized | |
99 ;; | |
100 ;; Version 0.19 | |
101 ;; + added support for dragging URLs to the org-buffer | |
102 ;; | |
103 ;; Version 0.18 | |
104 ;; + added support for agenda blocks | |
105 ;; | |
106 ;; Version 0.17 | |
107 ;; + toggle checkboxes with a single click | |
108 ;; | |
109 ;; Version 0.16 | |
110 ;; + added support for checkboxes | |
111 ;; | |
112 ;; Version 0.15 | |
113 ;; + org-mode now works with the Agenda buffer as well | |
114 ;; | |
115 ;; Version 0.14 | |
116 ;; + added a menu option that converts plain list items to outline items | |
117 ;; | |
118 ;; Version 0.13 | |
119 ;; + "Insert Heading" now inserts a sibling heading if the point is | |
120 ;; on "***" and a child heading otherwise | |
121 ;; | |
122 ;; Version 0.12 | |
123 ;; + compatible with Emacs 21 | |
124 ;; + custom agenda commands added to the main menu | |
125 ;; + moving trees should now work between windows in the same frame | |
126 ;; | |
127 ;; Version 0.11 | |
128 ;; + fixed org-mouse-at-link (thanks to Carsten) | |
129 ;; + removed [follow-link] bindings | |
130 ;; | |
131 ;; Version 0.10 | |
132 ;; + added a menu option to remove highlights | |
133 ;; + compatible with org-mode 4.21 now | |
134 ;; | |
135 ;; Version 0.08: | |
136 ;; + trees can be moved/promoted/demoted by dragging with the right | |
137 ;; mouse button (mouse-3) | |
138 ;; + small changes in the above function | |
139 ;; | |
140 ;; Versions 0.01 -- 0.07: (I don't remember) | |
141 | |
142 (eval-when-compile (require 'cl)) | |
143 (require 'org) | |
144 | |
145 (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " | |
146 "Regular expression that matches a plain list.") | |
147 (defvar org-mouse-direct t | |
148 "Internal variable indicating whether the current action is direct. | |
149 | |
150 If t, then the current action has been invoked directly through the buffer | |
151 it is intended to operate on. If nil, then the action has been invoked | |
152 indirectly, for example, through the agenda buffer.") | |
153 | |
154 (defgroup org-mouse nil | |
155 "Mouse support for org-mode." | |
156 :tag "Org Mouse" | |
157 :group 'org) | |
158 | |
159 (defcustom org-mouse-punctuation ":" | |
160 "Punctuation used when inserting text by drag and drop." | |
161 :group 'org-mouse | |
162 :type 'string) | |
163 | |
164 | |
165 (defun org-mouse-re-search-line (regexp) | |
166 "Search the current line for a given regular expression." | |
167 (beginning-of-line) | |
168 (re-search-forward regexp (point-at-eol) t)) | |
169 | |
170 (defun org-mouse-end-headline () | |
171 "Go to the end of current headline (ignoring tags)." | |
172 (interactive) | |
173 (end-of-line) | |
174 (skip-chars-backward "\t ") | |
175 (when (looking-back ":[A-Za-z]+:") | |
176 (skip-chars-backward ":A-Za-z") | |
177 (skip-chars-backward "\t "))) | |
178 | |
179 (defvar org-mouse-context-menu-function nil | |
180 "Function to create the context menu. | |
181 The value of this variable is the function invoked by | |
182 `org-mouse-context-menu' as the context menu.") | |
183 (make-variable-buffer-local 'org-mouse-context-menu-function) | |
184 | |
185 (defun org-mouse-show-context-menu (event prefix) | |
186 "Invoke the context menu. | |
187 | |
188 If the value of `org-mouse-context-menu-function' is a function, then | |
189 this function is called. Otherwise, the current major mode menu is used." | |
190 (interactive "@e \nP") | |
191 (if (and (= (event-click-count event) 1) | |
192 (or (not mark-active) | |
193 (sit-for (/ double-click-time 1000.0)))) | |
194 (progn | |
195 (select-window (posn-window (event-start event))) | |
196 (when (not (org-mouse-mark-active)) | |
197 (goto-char (posn-point (event-start event))) | |
198 (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) | |
199 (let ((redisplay-dont-pause t)) | |
200 (sit-for 0))) | |
201 (if (functionp org-mouse-context-menu-function) | |
202 (funcall org-mouse-context-menu-function event) | |
203 (mouse-major-mode-menu event prefix))) | |
204 (setq this-command 'mouse-save-then-kill) | |
205 (mouse-save-then-kill event))) | |
206 | |
207 | |
208 (defun org-mouse-line-position () | |
209 "Returns `:beginning' or `:middle' or `:end', depending on the point position. | |
210 | |
211 If the point is at the end of the line, return `:end'. | |
212 If the point is separated from the beginning of the line only by white | |
213 space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise, | |
214 return `:middle'." | |
215 (cond | |
216 ((eolp) :end) | |
217 ((org-mouse-bolp) :beginning) | |
218 (t :middle))) | |
219 | |
220 (defun org-mouse-empty-line () | |
221 "Return non-nil iff the line contains only white space." | |
222 (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) | |
223 | |
224 (defun org-mouse-next-heading () | |
225 "Go to the next heading. | |
226 If there is none, ensure that the point is at the beginning of an empty line." | |
227 (unless (outline-next-heading) | |
228 (beginning-of-line) | |
229 (unless (org-mouse-empty-line) | |
230 (end-of-line) | |
231 (newline)))) | |
232 | |
233 (defun org-mouse-insert-heading () | |
234 "Insert a new heading, as `org-insert-heading'. | |
235 | |
236 If the point is at the :beginning (`org-mouse-line-position') of the line, | |
237 insert the new heading before the current line. Otherwise, insert it | |
238 after the current heading." | |
239 (interactive) | |
240 (case (org-mouse-line-position) | |
241 (:beginning (beginning-of-line) | |
242 (org-insert-heading)) | |
243 (t (org-mouse-next-heading) | |
244 (org-insert-heading)))) | |
245 | |
246 (defun org-mouse-timestamp-today (&optional shift units) | |
247 "Change the timestamp into SHIFT UNITS in the future. | |
248 | |
249 For the acceptable UNITS, see `org-timestamp-change'." | |
250 (interactive) | |
251 (flet ((org-read-date (&rest rest) (current-time))) | |
252 (org-time-stamp nil)) | |
253 (when shift | |
254 (org-timestamp-change shift units))) | |
255 | |
256 (defun org-mouse-keyword-menu (keywords function &optional selected itemformat) | |
257 "A helper function. | |
258 | |
259 Returns a menu fragment consisting of KEYWORDS. When a keyword | |
260 is selected by the user, FUNCTION is called with the selected | |
261 keyword as the only argument. | |
262 | |
263 If SELECTED is nil, then all items are normal menu items. If | |
264 SELECTED is a function, then each item is a checkbox, which is | |
265 enabled for a given keyword iff (funcall SELECTED keyword) return | |
266 non-nil. If SELECTED is neither nil nor a function, then the | |
267 items are radio buttons. A radio button is enabled for the | |
268 keyword `equal' to SELECTED. | |
269 | |
270 ITEMFORMAT governs formatting of the elements of KEYWORDS. If it | |
271 is a function, it is invoked with the keyword as the only | |
272 argument. If it is a string, it is interpreted as the format | |
273 string to (format ITEMFORMAT keyword). If it is neither a string | |
274 nor a function, elements of KEYWORDS are used directly. " | |
275 (mapcar | |
276 `(lambda (keyword) | |
277 (vector (cond | |
278 ((functionp ,itemformat) (funcall ,itemformat keyword)) | |
279 ((stringp ,itemformat) (format ,itemformat keyword)) | |
280 (t keyword)) | |
281 (list 'funcall ,function keyword) | |
282 :style (cond | |
283 ((null ,selected) t) | |
284 ((functionp ,selected) 'toggle) | |
285 (t 'radio)) | |
286 :selected (if (functionp ,selected) | |
287 (and (funcall ,selected keyword) t) | |
288 (equal ,selected keyword)))) | |
289 keywords)) | |
290 | |
291 (defun org-mouse-remove-match-and-spaces () | |
292 "Remove the match, make just one space around the point." | |
293 (interactive) | |
294 (replace-match "") | |
295 (just-one-space)) | |
296 | |
297 (defvar rest) | |
298 (defun org-mouse-replace-match-and-surround (newtext &optional fixedcase | |
299 literal string subexp) | |
300 "The same as `replace-match', but surrounds the replacement with spaces." | |
301 (apply 'replace-match rest) | |
302 (save-excursion | |
303 (goto-char (match-beginning (or subexp 0))) | |
304 (just-one-space) | |
305 (goto-char (match-end (or subexp 0))) | |
306 (just-one-space))) | |
307 | |
308 | |
309 (defun org-mouse-keyword-replace-menu (keywords &optional group itemformat | |
310 nosurround) | |
311 "A helper function. | |
312 | |
313 Returns a menu fragment consisting of KEYWORDS. When a keyword | |
314 is selected, group GROUP of the current match is replaced by the | |
315 keyword. The method ensures that both ends of the replacement | |
316 are separated from the rest of the text in the buffer by | |
317 individual spaces (unless NOSURROND is non-nil). | |
318 | |
319 The final entry of the menu is always \"None\", which removes the | |
320 match. | |
321 | |
322 ITEMFORMAT governs formatting of the elements of KEYWORDS. If it | |
323 is a function, it is invoked with the keyword as the only | |
324 argument. If it is a string, it is interpreted as the format | |
325 string to (format ITEMFORMAT keyword). If it is neither a string | |
326 nor a function, elements of KEYWORDS are used directly. | |
327 " | |
328 (setq group (or group 0)) | |
329 (let ((replace (org-mouse-match-closure | |
330 (if nosurround 'replace-match | |
331 'org-mouse-replace-match-and-surround)))) | |
332 (append | |
333 (org-mouse-keyword-menu | |
334 keywords | |
335 `(lambda (keyword) (funcall ,replace keyword t t nil ,group)) | |
336 (match-string group) | |
337 itemformat) | |
338 `(["None" org-mouse-remove-match-and-spaces | |
339 :style radio | |
340 :selected ,(not (member (match-string group) keywords))])))) | |
341 | |
342 (defun org-mouse-show-headlines () | |
343 "Change the visibility of the current org buffer to only show headlines." | |
344 (interactive) | |
345 (let ((this-command 'org-cycle) | |
346 (last-command 'org-cycle) | |
347 (org-cycle-global-status nil)) | |
348 (org-cycle '(4)) | |
349 (org-cycle '(4)))) | |
350 | |
351 (defun org-mouse-show-overview () | |
352 "Change visibility of current org buffer to first-level headlines only." | |
353 (interactive) | |
354 (let ((org-cycle-global-status nil)) | |
355 (org-cycle '(4)))) | |
356 | |
357 (defun org-mouse-set-priority (priority) | |
358 "Set the priority of the current headline to PRIORITY." | |
359 (flet ((read-char-exclusive () priority)) | |
360 (org-priority))) | |
361 | |
362 (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" | |
363 "Regular expression matching the priority indicator. | |
364 Differs from `org-priority-regexp' in that it doesn't contain the | |
365 leading '.*?'.") | |
366 | |
367 (defun org-mouse-get-priority (&optional default) | |
368 "Return the priority of the current headline. | |
369 DEFAULT is returned if no priority is given in the headline." | |
370 (save-excursion | |
371 (if (org-mouse-re-search-line org-mouse-priority-regexp) | |
372 (match-string 1) | |
373 (when default (char-to-string org-default-priority))))) | |
374 | |
375 ;; (defun org-mouse-at-link () | |
376 ;; (and (eq (get-text-property (point) 'face) 'org-link) | |
377 ;; (save-excursion | |
378 ;; (goto-char (previous-single-property-change (point) 'face)) | |
379 ;; (or (looking-at org-bracket-link-regexp) | |
380 ;; (looking-at org-angle-link-re) | |
381 ;; (looking-at org-plain-link-re))))) | |
382 | |
383 | |
384 (defun org-mouse-delete-timestamp () | |
385 "Deletes the current timestamp as well as the preceding keyword. | |
386 SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" | |
387 (when (or (org-at-date-range-p) (org-at-timestamp-p)) | |
388 (replace-match "") ; delete the timestamp | |
389 (skip-chars-backward " :A-Z") | |
390 (when (looking-at " *[A-Z][A-Z]+:") | |
391 (replace-match "")))) | |
392 | |
393 (defun org-mouse-looking-at (regexp skipchars &optional movechars) | |
394 (save-excursion | |
395 (let ((point (point))) | |
396 (if (looking-at regexp) t | |
397 (skip-chars-backward skipchars) | |
398 (forward-char (or movechars 0)) | |
399 (when (looking-at regexp) | |
400 (> (match-end 0) point)))))) | |
401 | |
402 (defun org-mouse-priority-list () | |
403 (loop for priority from ?A to org-lowest-priority | |
404 collect (char-to-string priority))) | |
405 | |
406 (defun org-mouse-tag-menu () ;todo | |
407 (append | |
408 (let ((tags (org-split-string (org-get-tags) ":"))) | |
409 (org-mouse-keyword-menu | |
410 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | |
411 `(lambda (tag) | |
412 (org-mouse-set-tags | |
413 (sort (if (member tag (quote ,tags)) | |
414 (delete tag (quote ,tags)) | |
415 (cons tag (quote ,tags))) | |
416 'string-lessp))) | |
417 `(lambda (tag) (member tag (quote ,tags))) | |
418 )) | |
419 '("--" | |
420 ["Align Tags Here" (org-set-tags nil t) t] | |
421 ["Align Tags in Buffer" (org-set-tags t t) t] | |
422 ["Set Tags ..." (org-set-tags) t]))) | |
423 | |
424 | |
425 | |
426 (defun org-mouse-set-tags (tags) | |
427 (save-excursion | |
428 ;; remove existing tags first | |
429 (beginning-of-line) | |
430 (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)") | |
431 (replace-match "")) | |
432 | |
433 ;; set new tags if any | |
434 (when tags | |
435 (end-of-line) | |
436 (insert " :" (mapconcat 'identity tags ":") ":") | |
437 (org-set-tags nil t)))) | |
438 | |
439 (defun org-mouse-insert-checkbox () | |
440 (interactive) | |
441 (and (org-at-item-p) | |
442 (goto-char (match-end 0)) | |
443 (unless (org-at-item-checkbox-p) | |
444 (delete-horizontal-space) | |
445 (insert " [ ] ")))) | |
446 | |
447 (defun org-mouse-agenda-type (type) | |
448 (case type | |
449 ('tags "Tags: ") | |
450 ('todo "TODO: ") | |
451 ('tags-tree "Tags tree: ") | |
452 ('todo-tree "TODO tree: ") | |
453 ('occur-tree "Occur tree: ") | |
454 (t "Agenda command ???"))) | |
455 | |
456 | |
457 (defun org-mouse-list-options-menu (alloptions &optional function) | |
458 (let ((options (save-match-data | |
459 (split-string (match-string-no-properties 1))))) | |
460 (print options) | |
461 (loop for name in alloptions | |
462 collect | |
463 (vector name | |
464 `(progn | |
465 (replace-match | |
466 (mapconcat 'identity | |
467 (sort (if (member ',name ',options) | |
468 (delete ',name ',options) | |
469 (cons ',name ',options)) | |
470 'string-lessp) | |
471 " ") | |
472 nil nil nil 1) | |
473 (when (functionp ',function) (funcall ',function))) | |
474 :style 'toggle | |
475 :selected (and (member name options) t))))) | |
476 | |
477 (defun org-mouse-clip-text (text maxlength) | |
478 (if (> (length text) maxlength) | |
479 (concat (substring text 0 (- maxlength 3)) "...") | |
480 text)) | |
481 | |
482 (defun org-mouse-popup-global-menu () | |
483 (popup-menu | |
484 `("Main Menu" | |
485 ["Show Overview" org-mouse-show-overview t] | |
486 ["Show Headlines" org-mouse-show-headlines t] | |
487 ["Show All" show-all t] | |
488 ["Remove Highlights" org-remove-occur-highlights | |
489 :visible org-occur-highlights] | |
490 "--" | |
491 ["Check Deadlines" | |
492 (if (functionp 'org-check-deadlines-and-todos) | |
493 (org-check-deadlines-and-todos org-deadline-warning-days) | |
494 (org-check-deadlines org-deadline-warning-days)) t] | |
495 ["Check TODOs" org-show-todo-tree t] | |
496 ("Check Tags" | |
497 ,@(org-mouse-keyword-menu | |
498 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | |
499 '(lambda (tag) (org-tags-sparse-tree nil tag))) | |
500 "--" | |
501 ["Custom Tag ..." org-tags-sparse-tree t]) | |
502 ["Check Phrase ..." org-occur] | |
503 "--" | |
504 ["Display Agenda" org-agenda-list t] | |
505 ["Display Timeline" org-timeline t] | |
506 ["Display TODO List" org-todo-list t] | |
507 ("Display Tags" | |
508 ,@(org-mouse-keyword-menu | |
509 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | |
510 '(lambda (tag) (org-tags-view nil tag))) | |
511 "--" | |
512 ["Custom Tag ..." org-tags-view t]) | |
513 ["Display Calendar" org-goto-calendar t] | |
514 "--" | |
515 ,@(org-mouse-keyword-menu | |
516 (mapcar 'car org-agenda-custom-commands) | |
517 '(lambda (key) | |
518 (eval `(flet ((read-char-exclusive () (string-to-char ,key))) | |
519 (org-agenda nil)))) | |
520 nil | |
521 '(lambda (key) | |
522 (let ((entry (assoc key org-agenda-custom-commands))) | |
523 (org-mouse-clip-text | |
524 (cond | |
525 ((stringp (nth 1 entry)) (nth 1 entry)) | |
526 ((stringp (nth 2 entry)) | |
527 (concat (org-mouse-agenda-type (nth 1 entry)) | |
528 (nth 2 entry))) | |
529 (t "Agenda Command '%s'")) | |
530 30)))) | |
531 "--" | |
532 ["Delete Blank Lines" delete-blank-lines | |
533 :visible (org-mouse-empty-line)] | |
534 ["Insert Checkbox" org-mouse-insert-checkbox | |
535 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] | |
536 ["Insert Checkboxes" | |
537 (org-mouse-for-each-item 'org-mouse-insert-checkbox) | |
538 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] | |
539 ["Plain List to Outline" org-mouse-transform-to-outline | |
540 :visible (org-at-item-p)]))) | |
541 | |
542 | |
543 (defun org-mouse-get-context (contextlist context) | |
544 (let ((contextdata (assq context contextlist))) | |
545 (when contextdata | |
546 (save-excursion | |
547 (goto-char (second contextdata)) | |
548 (re-search-forward ".*" (third contextdata)))))) | |
549 | |
550 (defun org-mouse-for-each-item (function) | |
551 (save-excursion | |
552 (ignore-errors | |
553 (while t (org-previous-item))) | |
554 (ignore-errors | |
555 (while t | |
556 (funcall function) | |
557 (org-next-item))))) | |
558 | |
559 (defun org-mouse-bolp () | |
560 "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" | |
561 (save-excursion | |
562 (skip-chars-backward " \t*") (bolp))) | |
563 | |
564 (defun org-mouse-insert-item (text) | |
565 (case (org-mouse-line-position) | |
566 (:beginning ; insert before | |
567 (beginning-of-line) | |
568 (looking-at "[ \t]*") | |
569 (open-line 1) | |
570 (indent-to (- (match-end 0) (match-beginning 0))) | |
571 (insert "+ ")) | |
572 | |
573 (:middle ; insert after | |
574 (end-of-line) | |
575 (newline t) | |
576 (indent-relative) | |
577 (insert "+ ")) | |
578 | |
579 (:end ; insert text here | |
580 (skip-chars-backward " \t") | |
581 (kill-region (point) (point-at-eol)) | |
582 (unless (looking-back org-mouse-punctuation) | |
583 (insert (concat org-mouse-punctuation " "))))) | |
584 | |
585 (insert text) | |
586 (beginning-of-line)) | |
587 | |
588 (defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) | |
589 (if (eq major-mode 'org-mode) | |
590 (org-mouse-insert-item text) | |
591 ad-do-it)) | |
592 | |
593 (defadvice dnd-open-file (around org-mouse-dnd-open-file activate) | |
594 (if (eq major-mode 'org-mode) | |
595 (org-mouse-insert-item uri) | |
596 ad-do-it)) | |
597 | |
598 (defun org-mouse-match-closure (function) | |
599 (let ((match (match-data t))) | |
600 `(lambda (&rest rest) | |
601 (save-match-data | |
602 (set-match-data ',match) | |
603 (apply ',function rest))))) | |
604 | |
605 (defun org-mouse-todo-keywords () | |
606 (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords)) | |
607 | |
608 (defun org-mouse-match-todo-keyword () | |
609 (save-excursion | |
610 (org-back-to-heading) | |
611 (if (looking-at outline-regexp) (goto-char (match-end 0))) | |
612 (or (looking-at (concat " +" org-todo-regexp " *")) | |
613 (looking-at " \\( *\\)")))) | |
614 | |
615 (defun org-mouse-yank-link (click) | |
616 (interactive "e") | |
617 ;; Give temporary modes such as isearch a chance to turn off. | |
618 (run-hooks 'mouse-leave-buffer-hook) | |
619 (mouse-set-point click) | |
620 (setq mouse-selection-click-count 0) | |
621 (delete-horizontal-space) | |
622 (insert-for-yank (concat " [[" (current-kill 0) "]] "))) | |
623 | |
624 (defun org-mouse-context-menu (&optional event) | |
625 (let ((stamp-prefixes (list org-deadline-string org-scheduled-string)) | |
626 (contextlist (org-context))) | |
627 (flet ((get-context (context) (org-mouse-get-context contextlist context))) | |
628 (cond | |
629 ((org-mouse-mark-active) | |
630 (let ((region-string (buffer-substring (region-beginning) (region-end)))) | |
631 (popup-menu | |
632 `(nil | |
633 ["Sparse Tree" (org-occur ',region-string)] | |
634 ["Find in Buffer" (occur ',region-string)] | |
635 ["Grep in Current Dir" | |
636 (grep (format "grep -rnH -e '%s' *" ',region-string))] | |
637 ["Grep in Parent Dir" | |
638 (grep (format "grep -rnH -e '%s' ../*" ',region-string))] | |
639 "--" | |
640 ["Convert to Link" | |
641 (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) | |
642 (save-excursion (goto-char (region-end)) (insert "]]")))] | |
643 ["Insert Link Here" (org-mouse-yank-link ',event)])))) | |
644 | |
645 ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) | |
646 (popup-menu | |
647 `(nil | |
648 ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) | |
649 'org-mode-restart)))) | |
650 ((or (eolp) | |
651 (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") | |
652 (looking-back " \\|\t"))) | |
653 (org-mouse-popup-global-menu)) | |
654 ((get-context :checkbox) | |
655 (popup-menu | |
656 '(nil | |
657 ["Toggle" org-toggle-checkbox t] | |
658 ["Remove" org-mouse-remove-match-and-spaces t] | |
659 "" | |
660 ["All Clear" (org-mouse-for-each-item | |
661 (lambda () | |
662 (when (save-excursion (org-at-item-checkbox-p)) | |
663 (replace-match "[ ]"))))] | |
664 ["All Set" (org-mouse-for-each-item | |
665 (lambda () | |
666 (when (save-excursion (org-at-item-checkbox-p)) | |
667 (replace-match "[X]"))))] | |
668 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] | |
669 ["All Remove" (org-mouse-for-each-item | |
670 (lambda () | |
671 (when (save-excursion (org-at-item-checkbox-p)) | |
672 (org-mouse-remove-match-and-spaces))))] | |
673 ))) | |
674 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") | |
675 (member (match-string 0) (org-mouse-todo-keywords))) | |
676 (popup-menu | |
677 `(nil | |
678 ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)) | |
679 "--" | |
680 ["Check TODOs" org-show-todo-tree t] | |
681 ["List all TODO keywords" org-todo-list t] | |
682 [,(format "List only %s" (match-string 0)) | |
683 (org-todo-list (match-string 0)) t] | |
684 ))) | |
685 ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") | |
686 (member (match-string 0) stamp-prefixes)) | |
687 (popup-menu | |
688 `(nil | |
689 ,@(org-mouse-keyword-replace-menu stamp-prefixes) | |
690 "--" | |
691 ["Check Deadlines" org-check-deadlines t] | |
692 ))) | |
693 ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority | |
694 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu | |
695 (org-mouse-priority-list) 1 "Priority %s" t)))) | |
696 ((get-context :link) | |
697 (popup-menu | |
698 '(nil | |
699 ["Open" org-open-at-point t] | |
700 ["Open in Emacs" (org-open-at-point t) t] | |
701 "--" | |
702 ["Copy link" (kill-new (match-string 0))] | |
703 ["Cut link" | |
704 (progn | |
705 (kill-region (match-beginning 0) (match-end 0)) | |
706 (just-one-space))] | |
707 "--" | |
708 ["Grep for TODOs" | |
709 (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] | |
710 ; ["Paste file link" ((insert "file:") (yank))] | |
711 ))) | |
712 ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags | |
713 (popup-menu | |
714 `(nil | |
715 [,(format "Display '%s'" (match-string 1)) | |
716 (org-tags-view nil ,(match-string 1))] | |
717 [,(format "Sparse Tree '%s'" (match-string 1)) | |
718 (org-tags-sparse-tree nil ,(match-string 1))] | |
719 "--" | |
720 ,@(org-mouse-tag-menu)))) | |
721 ((org-at-timestamp-p) | |
722 (popup-menu | |
723 '(nil | |
724 ["Show Day" org-open-at-point t] | |
725 ["Change Timestamp" org-time-stamp t] | |
726 ["Delete Timestamp" (org-mouse-delete-timestamp) t] | |
727 ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] | |
728 "--" | |
729 ["Set for Today" org-mouse-timestamp-today] | |
730 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] | |
731 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] | |
732 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] | |
733 ["Set in a Month" (org-mouse-timestamp-today 1 'month)] | |
734 "--" | |
735 ["+ 1 Day" (org-timestamp-change 1 'day)] | |
736 ["+ 1 Week" (org-timestamp-change 7 'day)] | |
737 ["+ 1 Month" (org-timestamp-change 1 'month)] | |
738 "--" | |
739 ["- 1 Day" (org-timestamp-change -1 'day)] | |
740 ["- 1 Week" (org-timestamp-change -7 'day)] | |
741 ["- 1 Month" (org-timestamp-change -1 'month)]))) | |
742 ((get-context :table-special) | |
743 (let ((mdata (match-data))) | |
744 (incf (car mdata) 2) | |
745 (store-match-data mdata)) | |
746 (message "match: %S" (match-string 0)) | |
747 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu | |
748 '(" " "!" "^" "_" "$" "#" "*" "'") 0 | |
749 (lambda (mark) | |
750 (case (string-to-char mark) | |
751 (? "( ) Nothing Special") | |
752 (?! "(!) Column Names") | |
753 (?^ "(^) Field Names Above") | |
754 (?_ "(^) Field Names Below") | |
755 (?$ "($) Formula Parameters") | |
756 (?# "(#) Recalculation: Auto") | |
757 (?* "(*) Recalculation: Manual") | |
758 (?' "(') Recalculation: None"))) t)))) | |
759 ((assq :table contextlist) | |
760 (popup-menu | |
761 '(nil | |
762 ["Align Table" org-ctrl-c-ctrl-c] | |
763 ["Blank Field" org-table-blank-field] | |
764 ["Edit Field" org-table-edit-field] | |
765 "--" | |
766 ("Column" | |
767 ["Move Column Left" org-metaleft] | |
768 ["Move Column Right" org-metaright] | |
769 ["Delete Column" org-shiftmetaleft] | |
770 ["Insert Column" org-shiftmetaright] | |
771 "--" | |
772 ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) | |
773 ("Row" | |
774 ["Move Row Up" org-metaup] | |
775 ["Move Row Down" org-metadown] | |
776 ["Delete Row" org-shiftmetaup] | |
777 ["Insert Row" org-shiftmetadown] | |
778 ["Sort lines in region" org-table-sort-lines (org-at-table-p)] | |
779 "--" | |
780 ["Insert Hline" org-table-insert-hline]) | |
781 ("Rectangle" | |
782 ["Copy Rectangle" org-copy-special] | |
783 ["Cut Rectangle" org-cut-special] | |
784 ["Paste Rectangle" org-paste-special] | |
785 ["Fill Rectangle" org-table-wrap-region]) | |
786 "--" | |
787 ["Set Column Formula" org-table-eval-formula] | |
788 ["Set Field Formula" (org-table-eval-formula '(4))] | |
789 ["Edit Formulas" org-table-edit-formulas] | |
790 "--" | |
791 ["Recalculate Line" org-table-recalculate] | |
792 ["Recalculate All" (org-table-recalculate '(4))] | |
793 ["Iterate All" (org-table-recalculate '(16))] | |
794 "--" | |
795 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] | |
796 ["Sum Column/Rectangle" org-table-sum | |
797 :active (or (org-at-table-p) (org-region-active-p))] | |
798 ["Field Info" org-table-field-info] | |
799 ["Debug Formulas" | |
800 (setq org-table-formula-debug (not org-table-formula-debug)) | |
801 :style toggle :selected org-table-formula-debug] | |
802 ))) | |
803 ((and (assq :headline contextlist) (not (eolp))) | |
804 (let ((priority (org-mouse-get-priority t))) | |
805 (popup-menu | |
806 `("Headline Menu" | |
807 ("Tags and Priorities" | |
808 ,@(org-mouse-keyword-menu | |
809 (org-mouse-priority-list) | |
810 '(lambda (keyword) | |
811 (org-mouse-set-priority (string-to-char keyword))) | |
812 priority "Priority %s") | |
813 "--" | |
814 ,@(org-mouse-tag-menu)) | |
815 ("TODO Status" | |
816 ,@(progn (org-mouse-match-todo-keyword) | |
817 (org-mouse-keyword-replace-menu (org-mouse-todo-keywords) | |
818 1))) | |
819 ["Show Tags" | |
820 (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) | |
821 :visible (not org-mouse-direct)] | |
822 ["Show Priority" | |
823 (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) | |
824 :visible (not org-mouse-direct)] | |
825 ,@(if org-mouse-direct '("--") nil) | |
826 ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] | |
827 ["Set Deadline" | |
828 (progn (org-mouse-end-headline) (insert " ") (org-deadline)) | |
829 :active (not (save-excursion | |
830 (org-mouse-re-search-line org-deadline-regexp)))] | |
831 ["Schedule Task" | |
832 (progn (org-mouse-end-headline) (insert " ") (org-schedule)) | |
833 :active (not (save-excursion | |
834 (org-mouse-re-search-line org-scheduled-regexp)))] | |
835 ["Insert Timestamp" | |
836 (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] | |
837 ; ["Timestamp (inactive)" org-time-stamp-inactive t] | |
838 "--" | |
839 ["Archive Subtree" org-archive-subtree] | |
840 ["Cut Subtree" org-cut-special] | |
841 ["Copy Subtree" org-copy-special] | |
842 ["Paste Subtree" org-paste-special :visible org-mouse-direct] | |
843 ("Sort Children" | |
844 ["Alphabetically" (org-sort-entries nil ?a)] | |
845 ["Numerically" (org-sort-entries nil ?n)] | |
846 ["By Time/Date" (org-sort-entries nil ?t)] | |
847 "--" | |
848 ["Reverse Alphabetically" (org-sort-entries nil ?A)] | |
849 ["Reverse Numerically" (org-sort-entries nil ?N)] | |
850 ["Reverse By Time/Date" (org-sort-entries nil ?T)]) | |
851 "--" | |
852 ["Move Trees" org-mouse-move-tree :active nil] | |
853 )))) | |
854 (t | |
855 (org-mouse-popup-global-menu)))))) | |
856 | |
857 ;; (defun org-mouse-at-regexp (regexp) | |
858 ;; (save-excursion | |
859 ;; (let ((point (point)) | |
860 ;; (bol (progn (beginning-of-line) (point))) | |
861 ;; (eol (progn (end-of-line) (point)))) | |
862 ;; (goto-char point) | |
863 ;; (re-search-backward regexp bol 1) | |
864 ;; (and (not (eolp)) | |
865 ;; (progn (forward-char) | |
866 ;; (re-search-forward regexp eol t)) | |
867 ;; (<= (match-beginning 0) point))))) | |
868 | |
869 (defun org-mouse-mark-active () | |
870 (and mark-active transient-mark-mode)) | |
871 | |
872 (defun org-mouse-in-region-p (pos) | |
873 (and (org-mouse-mark-active) | |
874 (>= pos (region-beginning)) | |
875 (< pos (region-end)))) | |
876 | |
877 (defun org-mouse-down-mouse (event) | |
878 (interactive "e") | |
879 (setq this-command last-command) | |
880 (unless (and (= 1 (event-click-count event)) | |
881 (org-mouse-in-region-p (posn-point (event-start event)))) | |
882 (mouse-drag-region event))) | |
883 | |
884 (add-hook 'org-mode-hook | |
885 '(lambda () | |
886 (setq org-mouse-context-menu-function 'org-mouse-context-menu) | |
887 | |
888 ; (define-key org-mouse-map [follow-link] 'mouse-face) | |
889 (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) | |
890 (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu) | |
891 (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) | |
892 (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) | |
893 (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start) | |
894 (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) | |
895 (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link) | |
896 (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) | |
897 (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start) | |
898 | |
899 (font-lock-add-keywords nil | |
900 `((,outline-regexp | |
901 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) | |
902 'prepend) | |
903 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" | |
904 (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend)) | |
905 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" | |
906 (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) | |
907 t) | |
908 | |
909 (defadvice org-open-at-point (around org-mouse-open-at-point activate) | |
910 (let ((context (org-context))) | |
911 (cond | |
912 ((assq :headline-stars context) (org-cycle)) | |
913 ((assq :checkbox context) (org-toggle-checkbox)) | |
914 ((assq :item-bullet context) | |
915 (let ((org-cycle-include-plain-lists t)) (org-cycle))) | |
916 (t ad-do-it)))))) | |
917 | |
918 (defun org-mouse-move-tree-start (event) | |
919 (interactive "e") | |
920 (message "Same line: promote/demote, (***):move before, (text): make a child")) | |
921 | |
922 | |
923 (defun org-mouse-make-marker (position) | |
924 (with-current-buffer (window-buffer (posn-window position)) | |
925 (copy-marker (posn-point position)))) | |
926 | |
927 (defun org-mouse-move-tree (event) | |
928 ;; todo: handle movements between different buffers | |
929 (interactive "e") | |
930 (save-excursion | |
931 (let* ((start (org-mouse-make-marker (event-start event))) | |
932 (end (org-mouse-make-marker (event-end event))) | |
933 (sbuf (marker-buffer start)) | |
934 (ebuf (marker-buffer end))) | |
935 | |
936 (when (and sbuf ebuf) | |
937 (set-buffer sbuf) | |
938 (goto-char start) | |
939 (org-back-to-heading) | |
940 (if (and (eq sbuf ebuf) | |
941 (equal | |
942 (point) | |
943 (save-excursion (goto-char end) (org-back-to-heading) (point)))) | |
944 ;; if the same line then promote/demote | |
945 (if (>= end start) (org-demote-subtree) (org-promote-subtree)) | |
946 ;; if different lines then move | |
947 (org-cut-subtree) | |
948 | |
949 (set-buffer ebuf) | |
950 (goto-char end) | |
951 (org-back-to-heading) | |
952 (when (and (eq sbuf ebuf) | |
953 (equal | |
954 (point) | |
955 (save-excursion (goto-char start) | |
956 (org-back-to-heading) (point)))) | |
957 (outline-end-of-subtree) | |
958 (end-of-line) | |
959 (if (eobp) (newline) (forward-char))) | |
960 | |
961 (when (looking-at outline-regexp) | |
962 (let ((level (- (match-end 0) (match-beginning 0)))) | |
963 (when (> end (match-end 0)) | |
964 (outline-end-of-subtree) | |
965 (end-of-line) | |
966 (if (eobp) (newline) (forward-char)) | |
967 (setq level (1+ level))) | |
968 (org-paste-subtree level) | |
969 (save-excursion | |
970 (outline-end-of-subtree) | |
971 (when (bolp) (delete-char -1)))))))))) | |
972 | |
973 | |
974 (defun org-mouse-transform-to-outline () | |
975 (interactive) | |
976 (org-back-to-heading) | |
977 (let ((minlevel 1000) | |
978 (replace-text (concat (match-string 0) "* "))) | |
979 (beginning-of-line 2) | |
980 (save-excursion | |
981 (while (not (or (eobp) (looking-at outline-regexp))) | |
982 (when (looking-at org-mouse-plain-list-regexp) | |
983 (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) | |
984 (forward-line))) | |
985 (while (not (or (eobp) (looking-at outline-regexp))) | |
986 (when (and (looking-at org-mouse-plain-list-regexp) | |
987 (eq minlevel (- (match-end 1) (match-beginning 1)))) | |
988 (replace-match replace-text)) | |
989 (forward-line)))) | |
990 | |
991 (defvar _cmd) ;dynamically scoped from `org-with-remote-undo'. | |
992 | |
993 (defun org-mouse-do-remotely (command) | |
994 ; (org-agenda-check-no-diary) | |
995 (when (get-text-property (point) 'org-marker) | |
996 (let* ((anticol (- (point-at-eol) (point))) | |
997 (marker (get-text-property (point) 'org-marker)) | |
998 (buffer (marker-buffer marker)) | |
999 (pos (marker-position marker)) | |
1000 (hdmarker (get-text-property (point) 'org-hd-marker)) | |
1001 (buffer-read-only nil) | |
1002 (newhead "--- removed ---") | |
1003 (org-mouse-direct nil) | |
1004 (org-mouse-main-buffer (current-buffer))) | |
1005 (when (eq (with-current-buffer buffer major-mode) 'org-mode) | |
1006 (let ((endmarker (save-excursion | |
1007 (set-buffer buffer) | |
1008 (outline-end-of-subtree) | |
1009 (forward-char 1) | |
1010 (copy-marker (point))))) | |
1011 (org-with-remote-undo buffer | |
1012 (with-current-buffer buffer | |
1013 (widen) | |
1014 (goto-char pos) | |
1015 (org-show-hidden-entry) | |
1016 (save-excursion | |
1017 (and (outline-next-heading) | |
1018 (org-flag-heading nil))) ; show the next heading | |
1019 (org-back-to-heading) | |
1020 (setq marker (copy-marker (point))) | |
1021 (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) | |
1022 (funcall command) | |
1023 (message "_cmd: %S" _cmd) | |
1024 (message "this-command: %S" this-command) | |
1025 (unless (eq (marker-position marker) (marker-position endmarker)) | |
1026 (setq newhead (org-get-heading)))) | |
1027 | |
1028 (beginning-of-line 1) | |
1029 (save-excursion | |
1030 (org-agenda-change-all-lines newhead hdmarker 'fixface)))) | |
1031 t)))) | |
1032 | |
1033 (defun org-mouse-agenda-context-menu (&optional event) | |
1034 (or (org-mouse-do-remotely 'org-mouse-context-menu) | |
1035 (popup-menu | |
1036 '("Agenda" | |
1037 ("Agenda Files") | |
1038 "--" | |
1039 ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo)) | |
1040 :visible (if (eq last-command 'org-agenda-undo) | |
1041 org-agenda-pending-undo-list | |
1042 org-agenda-undo-list)] | |
1043 ["Rebuild Buffer" org-agenda-redo t] | |
1044 ["New Diary Entry" | |
1045 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] | |
1046 "--" | |
1047 ["Goto Today" org-agenda-goto-today | |
1048 (org-agenda-check-type nil 'agenda 'timeline) t] | |
1049 ["Display Calendar" org-agenda-goto-calendar | |
1050 (org-agenda-check-type nil 'agenda 'timeline) t] | |
1051 ("Calendar Commands" | |
1052 ["Phases of the Moon" org-agenda-phases-of-moon | |
1053 (org-agenda-check-type nil 'agenda 'timeline)] | |
1054 ["Sunrise/Sunset" org-agenda-sunrise-sunset | |
1055 (org-agenda-check-type nil 'agenda 'timeline)] | |
1056 ["Holidays" org-agenda-holidays | |
1057 (org-agenda-check-type nil 'agenda 'timeline)] | |
1058 ["Convert" org-agenda-convert-date | |
1059 (org-agenda-check-type nil 'agenda 'timeline)] | |
1060 "--" | |
1061 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) | |
1062 "--" | |
1063 ["Day View" org-agenda-day-view | |
1064 :active (org-agenda-check-type nil 'agenda) | |
1065 :style radio :selected (equal org-agenda-ndays 1)] | |
1066 ["Week View" org-agenda-week-view | |
1067 :active (org-agenda-check-type nil 'agenda) | |
1068 :style radio :selected (equal org-agenda-ndays 7)] | |
1069 "--" | |
1070 ["Show Logbook entries" org-agenda-log-mode | |
1071 :style toggle :selected org-agenda-show-log | |
1072 :active (org-agenda-check-type nil 'agenda 'timeline)] | |
1073 ["Include Diary" org-agenda-toggle-diary | |
1074 :style toggle :selected org-agenda-include-diary | |
1075 :active (org-agenda-check-type nil 'agenda)] | |
1076 ["Use Time Grid" org-agenda-toggle-time-grid | |
1077 :style toggle :selected org-agenda-use-time-grid | |
1078 :active (org-agenda-check-type nil 'agenda)] | |
1079 ["Follow Mode" org-agenda-follow-mode | |
1080 :style toggle :selected org-agenda-follow-mode] | |
1081 "--" | |
1082 ["Quit" org-agenda-quit t] | |
1083 ["Exit and Release Buffers" org-agenda-exit t] | |
1084 )))) | |
1085 | |
1086 (defun org-mouse-get-gesture (event) | |
1087 (let ((startxy (posn-x-y (event-start event))) | |
1088 (endxy (posn-x-y (event-end event)))) | |
1089 (if (< (car startxy) (car endxy)) :right :left))) | |
1090 | |
1091 | |
1092 ; (setq org-agenda-mode-hook nil) | |
1093 (add-hook 'org-agenda-mode-hook | |
1094 '(lambda () | |
1095 (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) | |
1096 (define-key org-agenda-keymap | |
1097 (if (featurep 'xemacs) [button3] [mouse-3]) | |
1098 'org-mouse-show-context-menu) | |
1099 (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start) | |
1100 (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier) | |
1101 (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later) | |
1102 (define-key org-agenda-keymap [drag-mouse-3] | |
1103 '(lambda (event) (interactive "e") | |
1104 (case (org-mouse-get-gesture event) | |
1105 (:left (org-agenda-earlier 1)) | |
1106 (:right (org-agenda-later 1))))))) | |
1107 | |
1108 (provide 'org-mouse) | |
87846 | 1109 |
1110 ;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f |