mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-23 07:18:53 +00:00
859 lines
28 KiB
EmacsLisp
859 lines
28 KiB
EmacsLisp
|
;;; org-mouse.el --- Better mouse support for org-mode
|
||
|
|
|
||
|
|
;; Copyright (c) 2006 Piotr Zielinski
|
||
|
|
;;
|
||
|
|
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
|
||
|
|
;; Version: 0.18
|
||
|
|
;; $Id: org-mouse.el 254 2006-10-26 21:15:52Z pz215 $
|
||
|
|
;;
|
||
|
|
;; The latest version of this file is available from
|
||
|
|
;;
|
||
|
|
;; http://www.cl.cam.ac.uk/~pz215/files/org-mouse.el
|
||
|
|
;;
|
||
|
|
;; This file is *NOT* part of GNU Emacs.
|
||
|
|
;; This file is distributed under the same terms as GNU Emacs.
|
||
|
|
|
||
|
|
;; This program is free software; you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU General Public License as
|
||
|
|
;; published by the Free Software Foundation; either version 2 of
|
||
|
|
;; the License, or (at your option) any later version.
|
||
|
|
|
||
|
|
;; This program is distributed in the hope that it will be
|
||
|
|
;; useful, but WITHOUT ANY WARRANTY; without even the implied
|
||
|
|
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
|
||
|
|
;; PURPOSE. See the GNU General Public License for more details.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU General Public
|
||
|
|
;; License along with this program; if not, write to the Free
|
||
|
|
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
|
||
|
|
;; MA 02111-1307 USA
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;;
|
||
|
|
;; Org-mouse provides better mouse support for org-mode. Org-mode is
|
||
|
|
;; a mode for keeping notes, maintaining ToDo lists, and doing project
|
||
|
|
;; planning with a fast and effective plain-text system. It is
|
||
|
|
;; available from
|
||
|
|
;;
|
||
|
|
;; http://staff.science.uva.nl/~dominik/Tools/org/
|
||
|
|
;;
|
||
|
|
;; Org-mouse implements the following features:
|
||
|
|
;; * following links with the left mouse button (in Emacs 22)
|
||
|
|
;; * subtree expansion/collapse (org-cycle) with the left mouse button
|
||
|
|
;; * several context menus on the right mouse button:
|
||
|
|
;; + general text
|
||
|
|
;; + headlines
|
||
|
|
;; + timestamps
|
||
|
|
;; + priorities
|
||
|
|
;; + links
|
||
|
|
;; + tags
|
||
|
|
;; * promoting/demoting/moving subtrees with mouse-3
|
||
|
|
;; + if the drag starts and ends in the same line then promote/demote
|
||
|
|
;; + otherwise move the subtree
|
||
|
|
;; * date/time extraction from selected text (requires a python script)
|
||
|
|
;; (eg. select text from your email and click "Add Appointment")
|
||
|
|
;;
|
||
|
|
;; The python script that automatically extracts date/time information
|
||
|
|
;; from a piece of English text is available from:
|
||
|
|
;;
|
||
|
|
;; http://www.cl.cam.ac.uk/~pz215/files/timeparser.py
|
||
|
|
;;
|
||
|
|
;; Use
|
||
|
|
;; ------------
|
||
|
|
;;
|
||
|
|
;; To use this package, put the following line in your .emacs:
|
||
|
|
;;
|
||
|
|
;; (require 'org-mouse)
|
||
|
|
;;
|
||
|
|
;; Tested with Emacs 22.0.50, org-mode 4.33
|
||
|
|
|
||
|
|
;; Fixme:
|
||
|
|
;; + deal with folding / unfolding issues
|
||
|
|
|
||
|
|
;; TODO (This list is only theoretical, if you'd like to have some
|
||
|
|
;; feature implemented or a bug fix please send me an email, even if
|
||
|
|
;; something similar appears in the list below. This will help me get
|
||
|
|
;; the priorities right.):
|
||
|
|
|
||
|
|
;; + The "New Appointment" menu entry seems out of place. Remove it
|
||
|
|
;; and enhance the time/data selection function so that if the text
|
||
|
|
;; in the clipboard contains a date/time, then set that date as the
|
||
|
|
;; default (instead of "today")
|
||
|
|
|
||
|
|
;; + org-store-link, insert link
|
||
|
|
;; + org tables
|
||
|
|
;; + occur with the current word/tag (same menu item)
|
||
|
|
;; + ctrl-c ctrl-c, for example, renumber the current list
|
||
|
|
;; + internal links
|
||
|
|
|
||
|
|
;; Please email me with new feature suggestions / bugs
|
||
|
|
|
||
|
|
;; History:
|
||
|
|
;;
|
||
|
|
;; Version 0.19
|
||
|
|
;; + added support for dragging URLs to the org-buffer
|
||
|
|
;;
|
||
|
|
;; Version 0.18
|
||
|
|
;; + added support for agenda blocks
|
||
|
|
;;
|
||
|
|
;; Version 0.17
|
||
|
|
;; + toggle checkboxes with a single click
|
||
|
|
;;
|
||
|
|
;; Version 0.16
|
||
|
|
;; + added support for checkboxes
|
||
|
|
;;
|
||
|
|
;; Version 0.15
|
||
|
|
;; + org-mode now works with the Agenda buffer as well
|
||
|
|
;;
|
||
|
|
;; Version 0.14
|
||
|
|
;; + added a menu option that converts plain list items to outline items
|
||
|
|
;;
|
||
|
|
;; Version 0.13
|
||
|
|
;; + "Insert Heading" now inserts a sibling heading if the point is
|
||
|
|
;; on "***" and a child heading otherwise
|
||
|
|
;;
|
||
|
|
;; Version 0.12
|
||
|
|
;; + compatible with Emacs 21
|
||
|
|
;; + custom agenda commands added to the main menu
|
||
|
|
;; + moving trees should now work between windows in the same frame
|
||
|
|
;;
|
||
|
|
;; Version 0.11
|
||
|
|
;; + fixed org-mouse-at-link (thanks to Carsten)
|
||
|
|
;; + removed [follow-link] bindings
|
||
|
|
;;
|
||
|
|
;; Version 0.10
|
||
|
|
;; + added a menu option to remove highlights
|
||
|
|
;; + compatible with org-mode 4.21 now
|
||
|
|
;;
|
||
|
|
;; Version 0.08:
|
||
|
|
;; + trees can be moved/promoted/demoted by dragging with the right
|
||
|
|
;; mouse button (mouse-3)
|
||
|
|
;; + small changes in the above function
|
||
|
|
;;
|
||
|
|
;; Versions 0.01 -- 0.07: (I don't remember)
|
||
|
|
|
||
|
|
(eval-when-compile (require 'cl))
|
||
|
|
|
||
|
|
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) ")
|
||
|
|
(defvar org-mouse-direct t)
|
||
|
|
|
||
|
|
(defgroup org-mouse nil
|
||
|
|
"Org-mouse"
|
||
|
|
:tag "Org Mouse."
|
||
|
|
:group 'org)
|
||
|
|
|
||
|
|
(defcustom org-mouse-punctuation ":"
|
||
|
|
""
|
||
|
|
:group 'org-mouse
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-re-search-line (regexp)
|
||
|
|
"Searches the current line for a given regular expression."
|
||
|
|
(beginning-of-line)
|
||
|
|
(re-search-forward regexp (point-at-eol) t))
|
||
|
|
|
||
|
|
(defun org-mouse-end-headline ()
|
||
|
|
"Go to the end of current headline (ignoring tags)."
|
||
|
|
(interactive)
|
||
|
|
(end-of-line)
|
||
|
|
(skip-chars-backward "\t ")
|
||
|
|
(when (looking-back ":[A-Za-z]+:")
|
||
|
|
(skip-chars-backward ":A-Za-z")
|
||
|
|
(skip-chars-backward "\t ")))
|
||
|
|
|
||
|
|
(defun org-mouse-show-context-menu (event prefix)
|
||
|
|
(interactive "@e \nP")
|
||
|
|
(if (and (= (event-click-count event) 1)
|
||
|
|
(or (not mark-active)
|
||
|
|
(sit-for (/ double-click-time 1000.0))))
|
||
|
|
(progn
|
||
|
|
(select-window (posn-window (event-start event)))
|
||
|
|
(goto-char (posn-point (event-start event)))
|
||
|
|
(when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
|
||
|
|
(let ((redisplay-dont-pause t))
|
||
|
|
(sit-for 0))
|
||
|
|
(if (functionp org-mouse-context-menu-function)
|
||
|
|
(funcall org-mouse-context-menu-function)
|
||
|
|
(mouse-major-mode-menu event prefix))
|
||
|
|
)
|
||
|
|
(setq this-command 'mouse-save-then-kill)
|
||
|
|
(mouse-save-then-kill event)))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-line-position ()
|
||
|
|
"Returns :beginning :middle :end"
|
||
|
|
(cond
|
||
|
|
((eolp) :end)
|
||
|
|
((org-mouse-bolp) :begin)
|
||
|
|
(t :middle)))
|
||
|
|
|
||
|
|
(defun org-mouse-empty-line ()
|
||
|
|
(save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
|
||
|
|
|
||
|
|
(defun org-mouse-next-heading ()
|
||
|
|
"Goes to the next heading and if there is none, it ensures that the point is at the beginning of an empty line."
|
||
|
|
(unless (outline-next-heading)
|
||
|
|
(beginning-of-line)
|
||
|
|
(unless (org-mouse-empty-line)
|
||
|
|
(end-of-line)
|
||
|
|
(newline))))
|
||
|
|
|
||
|
|
(defun org-mouse-insert-heading ()
|
||
|
|
(interactive)
|
||
|
|
(case (org-mouse-line-position)
|
||
|
|
(:begin (beginning-of-line)
|
||
|
|
(org-insert-heading))
|
||
|
|
(t (org-mouse-next-heading)
|
||
|
|
(org-insert-heading))))
|
||
|
|
|
||
|
|
(defun org-mouse-timestamp-today (&optional shift units)
|
||
|
|
(interactive)
|
||
|
|
(flet ((org-read-date (x &optional y) (current-time)))
|
||
|
|
(org-time-stamp nil))
|
||
|
|
(when shift
|
||
|
|
(org-timestamp-change shift units)))
|
||
|
|
|
||
|
|
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
|
||
|
|
(mapcar
|
||
|
|
(lambda (keyword)
|
||
|
|
(vector (cond
|
||
|
|
((functionp itemformat) (funcall itemformat keyword))
|
||
|
|
((stringp itemformat) (format itemformat keyword))
|
||
|
|
(t keyword))
|
||
|
|
`(funcall ,function ,keyword)
|
||
|
|
:style (cond
|
||
|
|
((null selected) t)
|
||
|
|
((functionp selected) 'toggle)
|
||
|
|
(t 'radio))
|
||
|
|
:selected `(if (functionp ,selected)
|
||
|
|
(funcall ,selected ,keyword)
|
||
|
|
(equal ,selected ,keyword))))
|
||
|
|
keywords))
|
||
|
|
|
||
|
|
(defun org-mouse-remove-match-and-spaces ()
|
||
|
|
(interactive)
|
||
|
|
(replace-match "")
|
||
|
|
(when (looking-at " +")
|
||
|
|
(replace-match "")))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat)
|
||
|
|
(setq group (or group 0))
|
||
|
|
(append
|
||
|
|
(org-mouse-keyword-menu
|
||
|
|
keywords
|
||
|
|
`(lambda (keyword) (replace-match keyword t t nil ,group))
|
||
|
|
`(match-string ,group)
|
||
|
|
itemformat)
|
||
|
|
'(["None" org-mouse-remove-match-and-spaces t])))
|
||
|
|
|
||
|
|
(defvar org-mouse-context-menu-function nil)
|
||
|
|
(make-variable-buffer-local 'org-mouse-context-menu-function)
|
||
|
|
|
||
|
|
(defun org-mouse-show-headlines ()
|
||
|
|
(interactive)
|
||
|
|
(let ((this-command 'org-cycle)
|
||
|
|
(last-command 'org-cycle)
|
||
|
|
(org-cycle-global-status nil))
|
||
|
|
(org-cycle '(4))
|
||
|
|
(org-cycle '(4))))
|
||
|
|
|
||
|
|
(defun org-mouse-show-overview ()
|
||
|
|
(interactive)
|
||
|
|
(let ((org-cycle-global-status nil))
|
||
|
|
(org-cycle '(4))))
|
||
|
|
|
||
|
|
(defun org-mouse-set-priority (priority)
|
||
|
|
(flet ((read-char-exclusive () priority))
|
||
|
|
(org-priority)))
|
||
|
|
|
||
|
|
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
|
||
|
|
"Regular expression matching the priority indicator. Differs from `org-priority-regexp' in that it doesn't contain the leading '.*?'.")
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-get-priority (&optional default)
|
||
|
|
(save-excursion
|
||
|
|
(if (org-mouse-re-search-line org-mouse-priority-regexp)
|
||
|
|
(match-string 1)
|
||
|
|
(when default (char-to-string org-default-priority)))))
|
||
|
|
|
||
|
|
(defun org-mouse-at-link ()
|
||
|
|
(and (eq (get-text-property (point) 'face) 'org-link)
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (previous-single-property-change (point) 'face))
|
||
|
|
(or (looking-at org-bracket-link-regexp)
|
||
|
|
(looking-at org-angle-link-re)
|
||
|
|
(looking-at org-plain-link-re)))))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-delete-timestamp ()
|
||
|
|
"Deletes the current timestamp as well as the preceding
|
||
|
|
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
|
||
|
|
(when (or (org-at-date-range-p) (org-at-timestamp-p))
|
||
|
|
(replace-match "") ; delete the timestamp
|
||
|
|
(skip-chars-backward " :A-Z")
|
||
|
|
(when (looking-at " *[A-Z][A-Z]+:")
|
||
|
|
(replace-match ""))))
|
||
|
|
|
||
|
|
(defun org-mouse-looking-at (regexp skipchars &optional movechars)
|
||
|
|
(save-excursion
|
||
|
|
(let ((point (point)))
|
||
|
|
(if (looking-at regexp) t
|
||
|
|
(skip-chars-backward skipchars)
|
||
|
|
(forward-char (or movechars 0))
|
||
|
|
(when (looking-at regexp)
|
||
|
|
(> (match-end 0) point))))))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-priority-list ()
|
||
|
|
(let ((ret) (current org-lowest-priority))
|
||
|
|
(while (>= current ?A)
|
||
|
|
(push (char-to-string current) ret)
|
||
|
|
(decf current))
|
||
|
|
ret))
|
||
|
|
|
||
|
|
(defun org-mouse-tag-menu () ;todo
|
||
|
|
(append
|
||
|
|
(let ((tags (org-split-string (org-get-tags) ":")))
|
||
|
|
(org-mouse-keyword-menu
|
||
|
|
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||
|
|
`(lambda (tag)
|
||
|
|
(org-mouse-set-tags
|
||
|
|
(sort (if (member tag (quote ,tags))
|
||
|
|
(delete tag (quote ,tags))
|
||
|
|
(cons tag (quote ,tags)))
|
||
|
|
'string-lessp)))
|
||
|
|
`(lambda (tag) (member tag (quote ,tags)))
|
||
|
|
))
|
||
|
|
'("--"
|
||
|
|
["Align Tags Here" (org-set-tags nil t) t]
|
||
|
|
["Align Tags in Buffer" (org-set-tags t t) t]
|
||
|
|
["Set Tags ..." (org-set-tags) t])))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-set-tags (tags)
|
||
|
|
(save-excursion
|
||
|
|
;; remove existing tags first
|
||
|
|
(beginning-of-line)
|
||
|
|
(when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
|
||
|
|
(replace-match ""))
|
||
|
|
|
||
|
|
;; set new tags if any
|
||
|
|
(when tags
|
||
|
|
(end-of-line)
|
||
|
|
(insert " :" (mapconcat 'identity tags ":") ":")
|
||
|
|
(org-set-tags nil t))))
|
||
|
|
|
||
|
|
(defun org-mouse-insert-checkbox ()
|
||
|
|
(interactive)
|
||
|
|
(and (org-at-item-p)
|
||
|
|
(goto-char (match-end 0))
|
||
|
|
(unless (org-at-item-checkbox-p)
|
||
|
|
(delete-horizontal-space)
|
||
|
|
(insert " [ ] "))))
|
||
|
|
|
||
|
|
(defun org-mouse-agenda-type (type)
|
||
|
|
(case type
|
||
|
|
('tags "Tags: ")
|
||
|
|
('todo "TODO: ")
|
||
|
|
('tags-tree "Tags tree: ")
|
||
|
|
('todo-tree "TODO tree: ")
|
||
|
|
('occur-tree "Occur tree: ")
|
||
|
|
(t "Agenda command ???")))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-clip-text (text maxlength)
|
||
|
|
(if (> (length text) maxlength)
|
||
|
|
(concat (substring text 0 (- maxlength 3)) "...")
|
||
|
|
text))
|
||
|
|
|
||
|
|
(defun org-mouse-popup-global-menu ()
|
||
|
|
(popup-menu
|
||
|
|
`("Main Menu"
|
||
|
|
["Show Overview" org-mouse-show-overview t]
|
||
|
|
["Show Headlines" org-mouse-show-headlines t]
|
||
|
|
["Show All" show-all t]
|
||
|
|
["Remove Highlights" org-remove-occur-highlights
|
||
|
|
:visible org-occur-highlights]
|
||
|
|
"--"
|
||
|
|
["Check Deadlines"
|
||
|
|
(if (functionp 'org-check-deadlines-and-todos)
|
||
|
|
(org-check-deadlines-and-todos org-deadline-warning-days)
|
||
|
|
(org-check-deadlines org-deadline-warning-days)) t]
|
||
|
|
["Check TODOs" org-show-todo-tree t]
|
||
|
|
("Check Tags"
|
||
|
|
,@(org-mouse-keyword-menu
|
||
|
|
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||
|
|
'(lambda (tag) (org-tags-sparse-tree nil tag)))
|
||
|
|
"--"
|
||
|
|
["Custom Tag ..." org-tags-sparse-tree t])
|
||
|
|
["Check Phrase ..." org-occur]
|
||
|
|
"--"
|
||
|
|
["Display Agenda" org-agenda-list t]
|
||
|
|
["Display Timeline" org-timeline t]
|
||
|
|
["Display TODO List" org-todo-list t]
|
||
|
|
("Display Tags"
|
||
|
|
,@(org-mouse-keyword-menu
|
||
|
|
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||
|
|
'(lambda (tag) (org-tags-view nil tag)))
|
||
|
|
"--"
|
||
|
|
["Custom Tag ..." org-tags-view t])
|
||
|
|
["Display Calendar" org-goto-calendar t]
|
||
|
|
"--"
|
||
|
|
;; ("Custom Commands"
|
||
|
|
;; ,@(org-mouse-keyword-menu
|
||
|
|
;; (mapcar 'car org-agenda-custom-commands)
|
||
|
|
;; '(lambda (key)
|
||
|
|
;; (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
|
||
|
|
;; (let ((current-prefix-arg t))
|
||
|
|
;; (org-agenda nil)))))
|
||
|
|
;; nil "Agenda (TODO) '%s'")
|
||
|
|
;; "--"
|
||
|
|
,@(org-mouse-keyword-menu
|
||
|
|
(mapcar 'car org-agenda-custom-commands)
|
||
|
|
'(lambda (key)
|
||
|
|
(eval `(flet ((read-char-exclusive () (string-to-char ,key)))
|
||
|
|
(org-agenda nil))))
|
||
|
|
nil
|
||
|
|
'(lambda (key)
|
||
|
|
(let ((entry (assoc key org-agenda-custom-commands)))
|
||
|
|
(org-mouse-clip-text
|
||
|
|
(cond
|
||
|
|
((stringp (nth 1 entry)) (nth 1 entry))
|
||
|
|
((stringp (nth 2 entry))
|
||
|
|
(concat (org-mouse-agenda-type (nth 1 entry))
|
||
|
|
(nth 2 entry)))
|
||
|
|
(t "Agenda Command '%s'"))
|
||
|
|
30))))
|
||
|
|
;; )
|
||
|
|
"--"
|
||
|
|
["Delete Blank Lines" delete-blank-lines
|
||
|
|
:visible (org-mouse-empty-line)]
|
||
|
|
["Insert Checkbox" org-mouse-insert-checkbox
|
||
|
|
:visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
|
||
|
|
["Insert Checkboxes"
|
||
|
|
(org-mouse-for-each-item 'org-mouse-insert-checkbox)
|
||
|
|
:visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
|
||
|
|
["Plain List to Outline" org-mouse-transform-to-outline
|
||
|
|
:visible (org-at-item-p)])))
|
||
|
|
|
||
|
|
|
||
|
|
; ["Jump" org-goto])))
|
||
|
|
|
||
|
|
(defun org-mouse-get-context (contextlist context)
|
||
|
|
(let ((contextdata (find-if (lambda (x) (eq (car x) context)) contextlist)))
|
||
|
|
(when contextdata
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (nth 1 contextdata))
|
||
|
|
; (looking-at regexp)))))
|
||
|
|
(re-search-forward ".*" (nth 2 contextdata))))))
|
||
|
|
|
||
|
|
(defun org-mouse-for-each-item (function)
|
||
|
|
(save-excursion
|
||
|
|
(ignore-errors
|
||
|
|
(while t (org-previous-item)))
|
||
|
|
(ignore-errors
|
||
|
|
(while t
|
||
|
|
(funcall function)
|
||
|
|
(org-next-item)))))
|
||
|
|
|
||
|
|
(defun org-mouse-bolp ()
|
||
|
|
"Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
|
||
|
|
(save-excursion
|
||
|
|
(skip-chars-backward " \t*") (bolp)))
|
||
|
|
|
||
|
|
|
||
|
|
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
|
||
|
|
(if (eq major-mode 'org-mode)
|
||
|
|
(case (org-mouse-line-position)
|
||
|
|
(:begin ; insert before
|
||
|
|
(beginning-of-line)
|
||
|
|
(looking-at "[ \t]*")
|
||
|
|
(open-line 1)
|
||
|
|
(indent-to (- (match-end 0) (match-beginning 0)))
|
||
|
|
(insert "+ "))
|
||
|
|
|
||
|
|
(:middle ; insert after
|
||
|
|
(end-of-line)
|
||
|
|
(newline t)
|
||
|
|
(indent-relative)
|
||
|
|
(insert "+ "))
|
||
|
|
|
||
|
|
(:end ; insert text here
|
||
|
|
(skip-chars-backward " \t")
|
||
|
|
(kill-region (point) (point-at-eol))
|
||
|
|
(unless (looking-back org-mouse-punctuation)
|
||
|
|
(insert (concat org-mouse-punctuation " "))))
|
||
|
|
|
||
|
|
(insert text)
|
||
|
|
(beginning-of-line))
|
||
|
|
ad-do-it))
|
||
|
|
|
||
|
|
(defun org-mouse-context-menu ()
|
||
|
|
(let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
|
||
|
|
(contextlist (org-context)))
|
||
|
|
(flet ((get-context (context) (org-mouse-get-context contextlist context)))
|
||
|
|
(cond
|
||
|
|
((or (eolp)
|
||
|
|
(and (looking-at " \\|\t") (looking-back " \\|\t")))
|
||
|
|
(org-mouse-popup-global-menu))
|
||
|
|
;; ((get-context :todo-keyword)
|
||
|
|
((get-context :checkbox)
|
||
|
|
(popup-menu
|
||
|
|
'(nil
|
||
|
|
["Toggle" org-toggle-checkbox t]
|
||
|
|
["Remove" org-mouse-remove-match-and-spaces t]
|
||
|
|
""
|
||
|
|
["All Clear" (org-mouse-for-each-item
|
||
|
|
(lambda ()
|
||
|
|
(when (save-excursion (org-at-item-checkbox-p))
|
||
|
|
(replace-match "[ ]"))))]
|
||
|
|
["All Set" (org-mouse-for-each-item
|
||
|
|
(lambda ()
|
||
|
|
(when (save-excursion (org-at-item-checkbox-p))
|
||
|
|
(replace-match "[X]"))))]
|
||
|
|
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
|
||
|
|
["All Remove" (org-mouse-for-each-item
|
||
|
|
(lambda ()
|
||
|
|
(when (save-excursion (org-at-item-checkbox-p))
|
||
|
|
(org-mouse-remove-match-and-spaces))))]
|
||
|
|
)))
|
||
|
|
((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
|
||
|
|
(member (match-string 0) org-todo-keywords))
|
||
|
|
(popup-menu
|
||
|
|
`(nil
|
||
|
|
,@(org-mouse-keyword-replace-menu org-todo-keywords)
|
||
|
|
"--"
|
||
|
|
["Check TODOs" org-show-todo-tree t]
|
||
|
|
["Display TODO List" org-todo-list t]
|
||
|
|
)))
|
||
|
|
((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
|
||
|
|
(member (match-string 0) stamp-prefixes))
|
||
|
|
(popup-menu
|
||
|
|
`(nil
|
||
|
|
,@(org-mouse-keyword-replace-menu stamp-prefixes)
|
||
|
|
"--"
|
||
|
|
["Check Deadlines" org-check-deadlines t]
|
||
|
|
)))
|
||
|
|
((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
|
||
|
|
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
|
||
|
|
(org-mouse-priority-list) 1 "Priority %s"))))
|
||
|
|
((org-mouse-at-link)
|
||
|
|
(popup-menu
|
||
|
|
'(nil
|
||
|
|
["Open" org-open-at-point t]
|
||
|
|
["Open in Emacs" (org-open-at-point t) t]
|
||
|
|
"--"
|
||
|
|
["Copy link" (kill-new (match-string 0))]
|
||
|
|
["Cut link" (kill-region (match-beginning 0) (match-end 0))]
|
||
|
|
; ["Paste file link" ((insert "file:") (yank))]
|
||
|
|
)))
|
||
|
|
((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
|
||
|
|
(popup-menu
|
||
|
|
`(nil
|
||
|
|
[,(format "Display '%s'" (match-string 1))
|
||
|
|
(org-tags-view nil ,(match-string 1))]
|
||
|
|
[,(format "Narrow to '%s'" (match-string 1))
|
||
|
|
(org-tags-sparse-tree nil ,(match-string 1))]
|
||
|
|
"--"
|
||
|
|
,@(org-mouse-tag-menu))))
|
||
|
|
((org-at-timestamp-p)
|
||
|
|
(popup-menu
|
||
|
|
'(nil
|
||
|
|
["Show Day" org-open-at-point t]
|
||
|
|
["Change Timestamp" org-time-stamp t]
|
||
|
|
["Delete Timestamp" (org-mouse-delete-timestamp) t]
|
||
|
|
["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
|
||
|
|
"--"
|
||
|
|
["Set for Today" org-mouse-timestamp-today]
|
||
|
|
["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
|
||
|
|
["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
|
||
|
|
["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
|
||
|
|
["Set in a Month" (org-mouse-timestamp-today 1 'month)]
|
||
|
|
"--"
|
||
|
|
["+ 1 Day" (org-timestamp-change 1 'day)]
|
||
|
|
["+ 1 Week" (org-timestamp-change 7 'day)]
|
||
|
|
["+ 1 Month" (org-timestamp-change 1 'month)]
|
||
|
|
"--"
|
||
|
|
["- 1 Day" (org-timestamp-change -1 'day)]
|
||
|
|
["- 1 Week" (org-timestamp-change -7 'day)]
|
||
|
|
["- 1 Month" (org-timestamp-change -1 'month)])))
|
||
|
|
((and (assq :headline contextlist) (not (eolp)))
|
||
|
|
(let ((priority (org-mouse-get-priority t)))
|
||
|
|
(popup-menu
|
||
|
|
`("Headline Menu"
|
||
|
|
("Tags and Priorities"
|
||
|
|
,@(org-mouse-keyword-menu
|
||
|
|
(org-mouse-priority-list)
|
||
|
|
'(lambda (keyword)
|
||
|
|
(org-mouse-set-priority (string-to-char keyword)))
|
||
|
|
priority "Priority %s")
|
||
|
|
"--"
|
||
|
|
,@(org-mouse-tag-menu))
|
||
|
|
["Show Tags"
|
||
|
|
(with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
|
||
|
|
:visible (not org-mouse-direct)]
|
||
|
|
["Show Priority"
|
||
|
|
(with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
|
||
|
|
:visible (not org-mouse-direct)]
|
||
|
|
,@(if org-mouse-direct '("--") nil)
|
||
|
|
["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
|
||
|
|
;; ["New Appointment" org-mouse-new-appointment :visible org-mouse-direct]
|
||
|
|
;; "--"
|
||
|
|
["Cycle TODO" org-todo]
|
||
|
|
["Set Deadline"
|
||
|
|
(progn (org-mouse-end-headline) (insert " ") (org-deadline))
|
||
|
|
:active (not (save-excursion
|
||
|
|
(org-mouse-re-search-line org-deadline-regexp)))]
|
||
|
|
["Schedule Task"
|
||
|
|
(progn (org-mouse-end-headline) (insert " ") (org-schedule))
|
||
|
|
:active (not (save-excursion
|
||
|
|
(org-mouse-re-search-line org-scheduled-regexp)))]
|
||
|
|
["Insert Timestamp"
|
||
|
|
(progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
|
||
|
|
; ["Timestamp (inactive)" org-time-stamp-inactive t]
|
||
|
|
"--"
|
||
|
|
["Archive Subtree" org-archive-subtree]
|
||
|
|
["Cut Subtree" org-cut-special]
|
||
|
|
["Copy Subtree" org-copy-special]
|
||
|
|
["Paste Subtree" org-paste-special :visible org-mouse-direct]
|
||
|
|
"--"
|
||
|
|
;; ["Promote Subtree" org-shiftmetaleft]
|
||
|
|
;; ["Demote Subtree" org-shiftmetaright]
|
||
|
|
;; ["Promote Heading" org-metaleft]
|
||
|
|
;; ["Demote Heading" org-metaright]
|
||
|
|
;; "--"
|
||
|
|
["Move Trees" org-mouse-move-tree :active nil]
|
||
|
|
))))
|
||
|
|
(t
|
||
|
|
(org-mouse-popup-global-menu))))))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
;; (defun org-mouse-at-regexp (regexp)
|
||
|
|
;; (save-excursion
|
||
|
|
;; (let ((point (point))
|
||
|
|
;; (bol (progn (beginning-of-line) (point)))
|
||
|
|
;; (eol (progn (end-of-line) (point))))
|
||
|
|
;; (goto-char point)
|
||
|
|
;; (re-search-backward regexp bol 1)
|
||
|
|
;; (and (not (eolp))
|
||
|
|
;; (progn (forward-char)
|
||
|
|
;; (re-search-forward regexp eol t))
|
||
|
|
;; (<= (match-beginning 0) point)))))
|
||
|
|
|
||
|
|
(defun org-mouse-in-region-p (pos)
|
||
|
|
(and mark-active (>= pos (region-beginning)) (< pos (region-end))))
|
||
|
|
|
||
|
|
(defun org-mouse-down-mouse (event)
|
||
|
|
(interactive "e")
|
||
|
|
(setq this-command last-command)
|
||
|
|
(unless (and transient-mark-mode
|
||
|
|
(= 1 (event-click-count event))
|
||
|
|
(org-mouse-in-region-p (posn-point (event-start event))))
|
||
|
|
(mouse-drag-region event)))
|
||
|
|
|
||
|
|
(add-hook 'org-mode-hook
|
||
|
|
'(lambda ()
|
||
|
|
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
|
||
|
|
|
||
|
|
; (define-key org-mouse-map [follow-link] 'mouse-face)
|
||
|
|
(define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil)
|
||
|
|
(define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
|
||
|
|
(define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
|
||
|
|
(define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
|
||
|
|
(define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
|
||
|
|
(define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
|
||
|
|
(define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
|
||
|
|
|
||
|
|
(font-lock-add-keywords nil
|
||
|
|
`((,outline-regexp
|
||
|
|
0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
|
||
|
|
'prepend)
|
||
|
|
("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
|
||
|
|
(1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
|
||
|
|
("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
|
||
|
|
(2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
|
||
|
|
t)
|
||
|
|
|
||
|
|
(defadvice org-open-at-point (around org-mouse-open-at-point activate)
|
||
|
|
(let ((context (org-context)))
|
||
|
|
(cond
|
||
|
|
((assq :headline-stars context) (org-cycle))
|
||
|
|
((assq :checkbox context) (org-toggle-checkbox))
|
||
|
|
((assq :item-bullet context)
|
||
|
|
(let ((org-cycle-include-plain-lists t)) (org-cycle)))
|
||
|
|
(t ad-do-it))))))
|
||
|
|
|
||
|
|
(defun org-mouse-move-tree-start (event)
|
||
|
|
(interactive "e")
|
||
|
|
(message "Same line: promote/demote, (***):move before, (text): make a child"))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-make-marker (position)
|
||
|
|
(with-current-buffer (window-buffer (posn-window position))
|
||
|
|
(copy-marker (posn-point position))))
|
||
|
|
|
||
|
|
(defun org-mouse-move-tree (event)
|
||
|
|
;; todo: handle movements between different buffers
|
||
|
|
(interactive "e")
|
||
|
|
(save-excursion
|
||
|
|
(let* ((start (org-mouse-make-marker (event-start event)))
|
||
|
|
(end (org-mouse-make-marker (event-end event)))
|
||
|
|
(sbuf (marker-buffer start))
|
||
|
|
(ebuf (marker-buffer end)))
|
||
|
|
|
||
|
|
(when (and sbuf ebuf)
|
||
|
|
(set-buffer sbuf)
|
||
|
|
(goto-char start)
|
||
|
|
(org-back-to-heading)
|
||
|
|
(if (and (eq sbuf ebuf)
|
||
|
|
(equal
|
||
|
|
(point)
|
||
|
|
(save-excursion (goto-char end) (org-back-to-heading) (point))))
|
||
|
|
;; if the same line then promote/demote
|
||
|
|
(if (>= end start) (org-demote-subtree) (org-promote-subtree))
|
||
|
|
;; if different lines then move
|
||
|
|
(org-cut-subtree)
|
||
|
|
|
||
|
|
(set-buffer ebuf)
|
||
|
|
(goto-char end)
|
||
|
|
(org-back-to-heading)
|
||
|
|
(when (and (eq sbuf ebuf)
|
||
|
|
(equal
|
||
|
|
(point)
|
||
|
|
(save-excursion (goto-char start)
|
||
|
|
(org-back-to-heading) (point))))
|
||
|
|
(outline-end-of-subtree)
|
||
|
|
(end-of-line)
|
||
|
|
(if (eobp) (newline) (forward-char)))
|
||
|
|
|
||
|
|
(when (looking-at outline-regexp)
|
||
|
|
(let ((level (- (match-end 0) (match-beginning 0))))
|
||
|
|
(when (> end (match-end 0))
|
||
|
|
(outline-end-of-subtree)
|
||
|
|
(end-of-line)
|
||
|
|
(if (eobp) (newline) (forward-char))
|
||
|
|
(setq level (1+ level)))
|
||
|
|
(org-paste-subtree level)
|
||
|
|
(save-excursion
|
||
|
|
(outline-end-of-subtree)
|
||
|
|
(when (bolp) (delete-char -1))))))))))
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-transform-to-outline ()
|
||
|
|
(interactive)
|
||
|
|
(org-back-to-heading)
|
||
|
|
(let ((minlevel 1000)
|
||
|
|
(replace-text (concat (match-string 0) "* ")))
|
||
|
|
(beginning-of-line 2)
|
||
|
|
(save-excursion
|
||
|
|
(while (not (or (eobp) (looking-at outline-regexp)))
|
||
|
|
(when (looking-at org-mouse-plain-list-regexp)
|
||
|
|
(setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
|
||
|
|
(forward-line)))
|
||
|
|
(while (not (or (eobp) (looking-at outline-regexp)))
|
||
|
|
(when (and (looking-at org-mouse-plain-list-regexp)
|
||
|
|
(eq minlevel (- (match-end 1) (match-beginning 1))))
|
||
|
|
(replace-match replace-text))
|
||
|
|
(forward-line))))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(defun org-mouse-do-remotely (command)
|
||
|
|
; (org-agenda-check-no-diary)
|
||
|
|
(when (get-text-property (point) 'org-marker)
|
||
|
|
(let* ((anticol (- (point-at-eol) (point)))
|
||
|
|
(marker (get-text-property (point) 'org-marker))
|
||
|
|
(buffer (marker-buffer marker))
|
||
|
|
(pos (marker-position marker))
|
||
|
|
(hdmarker (get-text-property (point) 'org-hd-marker))
|
||
|
|
(buffer-read-only nil)
|
||
|
|
(newhead "--- removed ---")
|
||
|
|
(org-mouse-direct nil)
|
||
|
|
(org-mouse-main-buffer (current-buffer)))
|
||
|
|
(when (eq (with-current-buffer buffer major-mode) 'org-mode)
|
||
|
|
(let ((endmarker (save-excursion
|
||
|
|
(set-buffer buffer)
|
||
|
|
(outline-end-of-subtree)
|
||
|
|
(forward-char 1)
|
||
|
|
(copy-marker (point)))))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(widen)
|
||
|
|
(goto-char pos)
|
||
|
|
(org-show-hidden-entry)
|
||
|
|
(save-excursion
|
||
|
|
(and (outline-next-heading)
|
||
|
|
(org-flag-heading nil))) ; show the next heading
|
||
|
|
(org-back-to-heading)
|
||
|
|
(setq marker (copy-marker (point)))
|
||
|
|
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
|
||
|
|
(funcall command)
|
||
|
|
(unless (eq (marker-position marker) (marker-position endmarker))
|
||
|
|
(setq newhead (org-get-heading))))
|
||
|
|
|
||
|
|
(beginning-of-line 1)
|
||
|
|
(save-excursion
|
||
|
|
(org-agenda-change-all-lines newhead hdmarker 'fixface)))
|
||
|
|
t))))
|
||
|
|
|
||
|
|
(defun org-mouse-agenda-context-menu ()
|
||
|
|
(or (org-mouse-do-remotely 'org-mouse-context-menu)
|
||
|
|
(popup-menu
|
||
|
|
'("Agenda"
|
||
|
|
("Agenda Files")
|
||
|
|
"--"
|
||
|
|
["Rebuild Buffer" org-agenda-redo t]
|
||
|
|
["New Diary Entry"
|
||
|
|
org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
"--"
|
||
|
|
["Goto Today" org-agenda-goto-today
|
||
|
|
(org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
["Display Calendar" org-agenda-goto-calendar
|
||
|
|
(org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
("Calendar Commands"
|
||
|
|
["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
"--"
|
||
|
|
["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
|
||
|
|
"--"
|
||
|
|
["Day View" org-agenda-day-view
|
||
|
|
:active (org-agenda-check-type nil 'agenda)
|
||
|
|
:style radio :selected (equal org-agenda-ndays 1)]
|
||
|
|
["Week View" org-agenda-week-view
|
||
|
|
:active (org-agenda-check-type nil 'agenda)
|
||
|
|
:style radio :selected (equal org-agenda-ndays 7)]
|
||
|
|
"--"
|
||
|
|
["Show Logbook entries" org-agenda-log-mode
|
||
|
|
:style toggle :selected org-agenda-show-log
|
||
|
|
:active (org-agenda-check-type nil 'agenda 'timeline)]
|
||
|
|
["Include Diary" org-agenda-toggle-diary
|
||
|
|
:style toggle :selected org-agenda-include-diary
|
||
|
|
:active (org-agenda-check-type nil 'agenda)]
|
||
|
|
["Use Time Grid" org-agenda-toggle-time-grid
|
||
|
|
:style toggle :selected org-agenda-use-time-grid
|
||
|
|
:active (org-agenda-check-type nil 'agenda)]
|
||
|
|
["Follow Mode" org-agenda-follow-mode
|
||
|
|
:style toggle :selected org-agenda-follow-mode]
|
||
|
|
"--"
|
||
|
|
["Quit" org-agenda-quit t]
|
||
|
|
["Exit and Release Buffers" org-agenda-exit t]
|
||
|
|
))))
|
||
|
|
|
||
|
|
|
||
|
|
; (setq org-agenda-mode-hook nil)
|
||
|
|
(add-hook 'org-agenda-mode-hook
|
||
|
|
'(lambda ()
|
||
|
|
; (define-key org-agenda-keymap [follow-link] 'mouse-face)
|
||
|
|
(setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
|
||
|
|
(define-key org-agenda-keymap
|
||
|
|
(if (featurep 'xemacs) [button3] [mouse-3]) 'org-mouse-show-context-menu)))
|
||
|
|
|
||
|
|
(provide 'org-mouse)
|
||
|
|
|