;;; org-mouse.el --- Better mouse support for org-mode
-;; Copyright (C) 2006-2011 Free Software Foundation
-;;
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
-;; Version: 7.4
-;;
+
;; This file is part of GNU Emacs.
-;;
+
;; GNU Emacs 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 3 of the License, or
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+
;;; Commentary:
;;
;; Org-mouse provides mouse support for org-mode.
;;
;; Since version 5.10: Changes are listed in the general org-mode docs.
;;
-;; Version 5.09
-;; + Version number synchronization with Org-mode.
+;; Version 5.09;; + Version number synchronization with Org-mode.
;;
;; Version 0.25
;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
(newhead hdmarker &optional fixface just-this))
(declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
(declare-function org-apply-on-list "org-list" (function init-value &rest args))
+(declare-function org-agenda-earlier "org-agenda" (arg))
+(declare-function org-agenda-later "org-agenda" (arg))
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
(interactive)
(case (org-mouse-line-position)
(:beginning (beginning-of-line)
- (org-insert-heading))
+ (org-insert-heading))
(t (org-mouse-next-heading)
(org-insert-heading))))
For the acceptable UNITS, see `org-timestamp-change'."
(interactive)
- (flet ((org-read-date (&rest rest) (current-time)))
- (org-time-stamp nil))
- (when shift
- (org-timestamp-change shift units)))
+ (org-time-stamp nil)
+ (when shift (org-timestamp-change shift units)))
(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
"A helper function.
nor a function, elements of KEYWORDS are used directly."
(mapcar
`(lambda (keyword)
- (vector (cond
- ((functionp ,itemformat) (funcall ,itemformat keyword))
- ((stringp ,itemformat) (format ,itemformat keyword))
- (t keyword))
- (list 'funcall ,function keyword)
- :style (cond
- ((null ,selected) t)
- ((functionp ,selected) 'toggle)
- (t 'radio))
- :selected (if (functionp ,selected)
- (and (funcall ,selected keyword) t)
- (equal ,selected keyword))))
- keywords))
+ (vector (cond
+ ((functionp ,itemformat) (funcall ,itemformat keyword))
+ ((stringp ,itemformat) (format ,itemformat keyword))
+ (t keyword))
+ (list 'funcall ,function keyword)
+ :style (cond
+ ((null ,selected) t)
+ ((functionp ,selected) 'toggle)
+ (t 'radio))
+ :selected (if (functionp ,selected)
+ (and (funcall ,selected keyword) t)
+ (equal ,selected keyword))))
+ keywords))
(defun org-mouse-remove-match-and-spaces ()
"Remove the match, make just one space around the point."
(replace-match "")
(just-one-space))
-(defvar rest)
+(defvar org-mouse-rest)
(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
literal string subexp)
"The same as `replace-match', but surrounds the replacement with spaces."
- (apply 'replace-match rest)
+ (apply 'replace-match org-mouse-rest)
(save-excursion
(goto-char (match-beginning (or subexp 0)))
(just-one-space)
(goto-char (match-end (or subexp 0)))
(just-one-space)))
-
(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
nosurround)
"A helper function.
(defun org-mouse-set-priority (priority)
"Set the priority of the current headline to PRIORITY."
- (flet ((read-char-exclusive () priority))
- (org-priority)))
+ (org-priority priority))
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator.
(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 keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
- (loop for priority from ?A to org-lowest-priority
- collect (char-to-string priority)))
+ (loop for priority from ?A to org-lowest-priority
+ collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
"Create the menu with TODO keywords."
["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
(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 ???")))
-
+ ('tags "Tags: ")
+ ('todo "TODO: ")
+ ('tags-tree "Tags tree: ")
+ ('todo-tree "TODO tree: ")
+ ('occur-tree "Occur tree: ")
+ (t "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
" ")
nil nil nil 1)
(when (functionp ',function) (funcall ',function)))
- :style 'toggle
- :selected (and (member name options) t)))))
+ :style 'toggle
+ :selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
("Check Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
- (lambda (tag) (org-tags-sparse-tree nil tag)))
+ #'(lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
["Check Phrase ..." org-occur]
("Display Tags"
,@(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
- (lambda (tag) (org-tags-view nil tag)))
+ #'(lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
- (lambda (key)
- (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
- (org-agenda nil))))
+ #'(lambda (key)
+ (eval `(org-agenda nil (string-to-char ,key))))
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))))
+ #'(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)]
["Plain List to Outline" org-mouse-transform-to-outline
:visible (org-at-item-p)])))
-
(defun org-mouse-get-context (contextlist context)
(let ((contextdata (assq context contextlist)))
(when contextdata
(defun org-mouse-for-each-item (funct)
;; Functions called by `org-apply-on-list' need an argument
(let ((wrap-fun (lambda (c) (funcall funct))))
- (when (org-in-item-p)
- (org-apply-on-list wrap-fun nil))))
+ (when (ignore-errors (goto-char (org-in-item-p)))
+ (save-excursion (org-apply-on-list wrap-fun nil)))))
(defun org-mouse-bolp ()
"Return true if there only spaces, tabs, and '*' before point.
(open-line 1)
(org-indent-to-column (- (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 (org-looking-back org-mouse-punctuation)
(insert (concat org-mouse-punctuation " ")))))
-
(insert text)
(beginning-of-line))
(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-mouse-insert-item text)
ad-do-it))
(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
- (if (eq major-mode 'org-mode)
+ (if (derived-mode-p 'org-mode)
(org-mouse-insert-item uri)
ad-do-it))
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
`(lambda (&rest rest)
- (save-match-data
- (set-match-data ',match)
- (apply ',function rest)))))
-
-(defun org-mouse-match-todo-keyword ()
- (save-excursion
- (org-back-to-heading)
- (if (looking-at outline-regexp) (goto-char (match-end 0)))
- (or (looking-at (concat " +" org-todo-regexp " *"))
- (looking-at " \\( *\\)"))))
+ (save-match-data
+ (set-match-data ',match)
+ (apply ',function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
(insert-for-yank (concat " [[" (current-kill 0) "]] ")))
(defun org-mouse-context-menu (&optional event)
- (let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
- (contextlist (org-context)))
- (flet ((get-context (context) (org-mouse-get-context contextlist context)))
- (cond
- ((org-mouse-mark-active)
- (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string))
+ (contextlist (org-context))
+ (get-context (lambda (context) (org-mouse-get-context contextlist context))))
+ (cond
+ ((org-mouse-mark-active)
+ (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (popup-menu
+ `(nil
+ ["Sparse Tree" (org-occur ',region-string)]
+ ["Find in Buffer" (occur ',region-string)]
+ ["Grep in Current Dir"
+ (grep (format "grep -rnH -e '%s' *" ',region-string))]
+ ["Grep in Parent Dir"
+ (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
+ "--"
+ ["Convert to Link"
+ (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
+ (save-excursion (goto-char (region-end)) (insert "]]")))]
+ ["Insert Link Here" (org-mouse-yank-link ',event)]))))
+ ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
- ["Sparse Tree" (org-occur ',region-string)]
- ["Find in Buffer" (occur ',region-string)]
- ["Grep in Current Dir"
- (grep (format "grep -rnH -e '%s' *" ',region-string))]
- ["Grep in Parent Dir"
- (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
- "--"
- ["Convert to Link"
- (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
- (save-excursion (goto-char (region-end)) (insert "]]")))]
- ["Insert Link Here" (org-mouse-yank-link ',event)]))))
-
- ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
- (popup-menu
- `(nil
- ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
- 'org-mode-restart))))
- ((or (eolp)
- (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t")))
- (org-mouse-popup-global-menu))
- ((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
+ ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
+ 'org-mode-restart))))
+ ((or (eolp)
+ (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
+ (org-looking-back " \\|\t")))
+ (org-mouse-popup-global-menu))
+ ((funcall 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-1))
- (popup-menu
- `(nil
- ,@(org-mouse-todo-menu (match-string 0))
- "--"
- ["Check TODOs" org-show-todo-tree t]
- ["List all TODO keywords" org-todo-list t]
- [,(format "List only %s" (match-string 0))
- (org-todo-list (match-string 0)) 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" t))))
- ((get-context :link)
- (popup-menu
- '(nil
- ["Open" org-open-at-point t]
- ["Open in Emacs" (org-open-at-point t) t]
- "--"
- ["Copy link" (org-kill-new (match-string 0))]
- ["Cut link"
- (progn
- (kill-region (match-beginning 0) (match-end 0))
- (just-one-space))]
- "--"
- ["Grep for TODOs"
- (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
-; ["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 "Sparse Tree '%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)])))
- ((get-context :table-special)
- (let ((mdata (match-data)))
- (incf (car mdata) 2)
- (store-match-data mdata))
- (message "match: %S" (match-string 0))
- (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
- '(" " "!" "^" "_" "$" "#" "*" "'") 0
- (lambda (mark)
- (case (string-to-char mark)
- (? "( ) Nothing Special")
- (?! "(!) Column Names")
- (?^ "(^) Field Names Above")
- (?_ "(^) Field Names Below")
- (?$ "($) Formula Parameters")
- (?# "(#) Recalculation: Auto")
- (?* "(*) Recalculation: Manual")
- (?' "(') Recalculation: None"))) t))))
- ((assq :table contextlist)
- (popup-menu
- '(nil
- ["Align Table" org-ctrl-c-ctrl-c]
- ["Blank Field" org-table-blank-field]
- ["Edit Field" org-table-edit-field]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft]
- ["Move Column Right" org-metaright]
- ["Delete Column" org-shiftmetaleft]
- ["Insert Column" org-shiftmetaright]
+ ["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-1))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-todo-menu (match-string 0))
"--"
- ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
- ("Row"
- ["Move Row Up" org-metaup]
- ["Move Row Down" org-metadown]
- ["Delete Row" org-shiftmetaup]
- ["Insert Row" org-shiftmetadown]
- ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+ ["Check TODOs" org-show-todo-tree t]
+ ["List all TODO keywords" org-todo-list t]
+ [,(format "List only %s" (match-string 0))
+ (org-todo-list (match-string 0)) 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)
"--"
- ["Insert Hline" org-table-insert-hline])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special]
- ["Cut Rectangle" org-cut-special]
- ["Paste Rectangle" org-paste-special]
- ["Fill Rectangle" org-table-wrap-region])
- "--"
- ["Set Column Formula" org-table-eval-formula]
- ["Set Field Formula" (org-table-eval-formula '(4))]
- ["Edit Formulas" org-table-edit-formulas]
- "--"
- ["Recalculate Line" org-table-recalculate]
- ["Recalculate All" (org-table-recalculate '(4))]
- ["Iterate All" (org-table-recalculate '(16))]
- "--"
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
- ["Sum Column/Rectangle" org-table-sum
- :active (or (org-at-table-p) (org-region-active-p))]
- ["Field Info" org-table-field-info]
- ["Debug Formulas"
- (setq org-table-formula-debug (not org-table-formula-debug))
- :style toggle :selected org-table-formula-debug]
- )))
- ((and (assq :headline contextlist) (not (eolp)))
- (let ((priority (org-mouse-get-priority t)))
+ ["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" t))))
+ ((funcall get-context :link)
(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))
- ("TODO Status"
- ,@(org-mouse-todo-menu (org-get-todo-state)))
- ["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]
- ["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]
+ '(nil
+ ["Open" org-open-at-point t]
+ ["Open in Emacs" (org-open-at-point t) t]
+ "--"
+ ["Copy link" (org-kill-new (match-string 0))]
+ ["Cut link"
+ (progn
+ (kill-region (match-beginning 0) (match-end 0))
+ (just-one-space))]
+ "--"
+ ["Grep for TODOs"
+ (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
+ ; ["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 "Sparse Tree '%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)])))
+ ((funcall get-context :table-special)
+ (let ((mdata (match-data)))
+ (incf (car mdata) 2)
+ (store-match-data mdata))
+ (message "match: %S" (match-string 0))
+ (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+ '(" " "!" "^" "_" "$" "#" "*" "'") 0
+ (lambda (mark)
+ (case (string-to-char mark)
+ (? "( ) Nothing Special")
+ (?! "(!) Column Names")
+ (?^ "(^) Field Names Above")
+ (?_ "(^) Field Names Below")
+ (?$ "($) Formula Parameters")
+ (?# "(#) Recalculation: Auto")
+ (?* "(*) Recalculation: Manual")
+ (?' "(') Recalculation: None"))) t))))
+ ((assq :table contextlist)
+ (popup-menu
+ '(nil
+ ["Align Table" org-ctrl-c-ctrl-c]
+ ["Blank Field" org-table-blank-field]
+ ["Edit Field" org-table-edit-field]
"--"
- ["Archive Subtree" org-archive-subtree]
- ["Cut Subtree" org-cut-special]
- ["Copy Subtree" org-copy-special]
- ["Paste Subtree" org-paste-special :visible org-mouse-direct]
- ("Sort Children"
- ["Alphabetically" (org-sort-entries nil ?a)]
- ["Numerically" (org-sort-entries nil ?n)]
- ["By Time/Date" (org-sort-entries nil ?t)]
+ ("Column"
+ ["Move Column Left" org-metaleft]
+ ["Move Column Right" org-metaright]
+ ["Delete Column" org-shiftmetaleft]
+ ["Insert Column" org-shiftmetaright]
+ "--"
+ ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
+ ("Row"
+ ["Move Row Up" org-metaup]
+ ["Move Row Down" org-metadown]
+ ["Delete Row" org-shiftmetaup]
+ ["Insert Row" org-shiftmetadown]
+ ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
"--"
- ["Reverse Alphabetically" (org-sort-entries nil ?A)]
- ["Reverse Numerically" (org-sort-entries nil ?N)]
- ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ ["Insert Hline" org-table-insert-hline])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special]
+ ["Cut Rectangle" org-cut-special]
+ ["Paste Rectangle" org-paste-special]
+ ["Fill Rectangle" org-table-wrap-region])
"--"
- ["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)))))
+ ["Set Column Formula" org-table-eval-formula]
+ ["Set Field Formula" (org-table-eval-formula '(4))]
+ ["Edit Formulas" org-table-edit-formulas]
+ "--"
+ ["Recalculate Line" org-table-recalculate]
+ ["Recalculate All" (org-table-recalculate '(4))]
+ ["Iterate All" (org-table-recalculate '(16))]
+ "--"
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p))]
+ ["Field Info" org-table-field-info]
+ ["Debug Formulas"
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ :style toggle :selected org-table-formula-debug]
+ )))
+ ((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))
+ ("TODO Status"
+ ,@(org-mouse-todo-menu (org-get-todo-state)))
+ ["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]
+ ["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]
+ ("Sort Children"
+ ["Alphabetically" (org-sort-entries nil ?a)]
+ ["Numerically" (org-sort-entries nil ?n)]
+ ["By Time/Date" (org-sort-entries nil ?t)]
+ "--"
+ ["Reverse Alphabetically" (org-sort-entries nil ?A)]
+ ["Reverse Numerically" (org-sort-entries nil ?N)]
+ ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ "--"
+ ["Move Trees" org-mouse-move-tree :active nil]
+ ))))
+ (t
+ (org-mouse-popup-global-menu)))))
(defun org-mouse-mark-active ()
(and mark-active transient-mark-mode))
(mouse-drag-region event)))
(add-hook 'org-mode-hook
- (lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-context-menu)
-
- (when (memq 'context-menu org-mouse-features)
- (org-defkey org-mouse-map [mouse-3] nil)
- (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
- (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
- (when (memq 'context-menu org-mouse-features)
- (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
- (when (memq 'yank-link org-mouse-features)
- (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
- (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
- (when (memq 'move-tree org-mouse-features)
- (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
-
- (when (memq 'activate-stars org-mouse-features)
- (font-lock-add-keywords
- nil
- `((,outline-regexp
- 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
- 'prepend))
- t))
-
- (when (memq 'activate-bullets org-mouse-features)
- (font-lock-add-keywords
- nil
- `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
- (1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
- 'prepend)))
- t))
-
- (when (memq 'activate-checkboxes org-mouse-features)
- (font-lock-add-keywords
- nil
- `(("^[ \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))))))
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-context-menu)
+
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [mouse-3] nil)
+ (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
+ (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
+ (when (memq 'yank-link org-mouse-features)
+ (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
+ (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
+ (when (memq 'move-tree org-mouse-features)
+ (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
+
+ (when (memq 'activate-stars org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `((,org-outline-regexp
+ 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
+ 'prepend))
+ t))
+
+ (when (memq 'activate-bullets org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
+ (1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
+ 'prepend)))
+ t))
+
+ (when (memq 'activate-checkboxes org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \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)))
+ ((org-footnote-at-reference-p) nil)
+ (t ad-do-it))))))
(defun org-mouse-move-tree-start (event)
(interactive "e")
(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))
+ (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))
- (setq level (1+ level)))
- (org-paste-subtree level)
- (save-excursion
- (outline-end-of-subtree)
- (when (bolp) (delete-char -1))))))))))
+ (if (eobp) (newline) (forward-char)))
+
+ (when (looking-at org-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 ()
(replace-text (concat (match-string 0) "* ")))
(beginning-of-line 2)
(save-excursion
- (while (not (or (eobp) (looking-at outline-regexp)))
+ (while (not (or (eobp) (looking-at org-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)))
+ (while (not (or (eobp) (looking-at org-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))))
-(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'.
+(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
-; (org-agenda-check-no-diary)
+ ; (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))
(setq marker (copy-marker (point)))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command)
- (message "_cmd: %S" _cmd)
+ (message "_cmd: %S" org-mouse-cmd)
(message "this-command: %S" this-command)
(unless (eq (marker-position marker) (marker-position endmarker))
(setq newhead (org-get-heading))))
(if (< (car startxy) (car endxy)) :right :left)))
-; (setq org-agenda-mode-hook nil)
+ ; (setq org-agenda-mode-hook nil)
+(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
- (lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
- (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
- (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
- (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
- (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
- (org-defkey org-agenda-mode-map [drag-mouse-3]
- (lambda (event) (interactive "e")
- (case (org-mouse-get-gesture event)
- (:left (org-agenda-earlier 1))
- (:right (org-agenda-later 1)))))))
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
+ (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
+ (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
+ (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
+ (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
+ (org-defkey org-agenda-mode-map [drag-mouse-3]
+ #'(lambda (event) (interactive "e")
+ (case (org-mouse-get-gesture event)
+ (:left (org-agenda-earlier 1))
+ (:right (org-agenda-later 1)))))))
(provide 'org-mouse)
-
;;; org-mouse.el ends here