diff options
Diffstat (limited to 'lisp/org/org-mouse.el')
| -rw-r--r-- | lisp/org/org-mouse.el | 714 |
1 files changed, 355 insertions, 359 deletions
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index b467064b888..b5a6dad733a 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -260,7 +260,7 @@ after the current heading." (interactive) (case (org-mouse-line-position) (:beginning (beginning-of-line) - (org-insert-heading)) + (org-insert-heading)) (t (org-mouse-next-heading) (org-insert-heading)))) @@ -269,10 +269,8 @@ after the current 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. @@ -295,19 +293,19 @@ string to (format ITEMFORMAT keyword). If it is neither a string 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." @@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly." (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. @@ -410,8 +407,8 @@ 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." @@ -464,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (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 @@ -488,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" " ") 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) @@ -532,19 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ,@(org-mouse-keyword-menu (mapcar 'car org-agenda-custom-commands) #'(lambda (key) - (eval `(flet ((read-char-exclusive () (string-to-char ,key))) - (org-agenda nil)))) + (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)))) + (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)] @@ -597,21 +593,21 @@ This means, between the beginning of line and the point." (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))))) + (save-match-data + (set-match-data ',match) + (apply ',function rest))))) (defun org-mouse-yank-link (click) (interactive "e") @@ -623,234 +619,234 @@ This means, between the beginning of line and the point." (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))] "--" - ["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)] + ["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] + "--" + ("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)))))) + ["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)) @@ -868,55 +864,55 @@ This means, between the beginning of line and the point." (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 - `((,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)))))) + #'(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") @@ -936,42 +932,42 @@ This means, between the beginning of line and the point." (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 org-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 () @@ -994,7 +990,7 @@ This means, between the beginning of line and the point." (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)) @@ -1091,20 +1087,20 @@ This means, between the beginning of line and the point." (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) |