summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2012-08-10 14:57:19 +0200
committerBastien Guerry <bzg@altern.org>2012-08-10 14:57:19 +0200
commit090634584ed42f3681b2ac0021b0163bd97edd12 (patch)
treeccaf1a476bad8c7b482490e27db8e0533bb8ff22
parent4cc6a9db5e4c808780c2b1cdc2de8ff3f861b9b7 (diff)
downloadorg-mode-090634584ed42f3681b2ac0021b0163bd97edd12.tar.gz
org-mouse.el: Don't use `org-flet'
* org-mouse.el (org-mouse-timestamp-today) (org-mouse-set-priority, org-mouse-popup-global-menu) (org-mouse-context-menu): Don't use ̀org-flet'.
-rw-r--r--lisp/org-mouse.el446
1 files changed, 221 insertions, 225 deletions
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 81e4724..01e2dee 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -269,10 +269,8 @@ after the current heading."
For the acceptable UNITS, see `org-timestamp-change'."
(interactive)
- (org-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.
@@ -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."
- (org-flet ((read-char-exclusive () priority))
- (org-priority)))
+ (org-priority priority))
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator.
@@ -532,8 +529,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
,@(org-mouse-keyword-menu
(mapcar 'car org-agenda-custom-commands)
#'(lambda (key)
- (eval `(org-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)))
@@ -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)))
- (org-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))