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