forked from mirrors/org-mode
Backport commit 5746fd57a from Emacs
* lisp/org-mouse.el: Make use of lexical scoping. (org-mouse-todo-menu): Simplify by eta-reduction. (org-mouse-popup-global-menu): Remove redundant `eval`. (org-mouse-keyword-menu, org-mouse-keyword-replace-menu) (org-mouse-tag-menu, org-mouse-match-closure): Use proper closures. lisp/org/org-mouse.el: Make use of lexical scoping 5746fd57ab7c9d27bcc6220f2b9faaba2982deba Stefan Monnier Tue May 18 19:51:26 2021 -0400
This commit is contained in:
Stefan Monnier
Kyle Meyer
parent
08d7b359b8
commit
64689d9bb7
|
|
@ -167,14 +167,12 @@ indirectly, for example, through the agenda buffer.")
|
|||
|
||||
(defcustom org-mouse-punctuation ":"
|
||||
"Punctuation used when inserting text by drag and drop."
|
||||
:group 'org-mouse
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-mouse-features
|
||||
'(context-menu yank-link activate-stars activate-bullets activate-checkboxes)
|
||||
"The features of org-mouse that should be activated.
|
||||
Changing this variable requires a restart of Emacs to get activated."
|
||||
:group 'org-mouse
|
||||
:type '(set :greedy t
|
||||
(const :tag "Mouse-3 shows context menu" context-menu)
|
||||
(const :tag "C-mouse-1 and mouse-3 move trees" move-tree)
|
||||
|
|
@ -292,19 +290,19 @@ argument. If it is a string, it is interpreted as the format
|
|||
string to (format ITEMFORMAT keyword). If it is neither a string
|
||||
nor a function, elements of KEYWORDS are used directly."
|
||||
(mapcar
|
||||
`(lambda (keyword)
|
||||
(lambda (keyword)
|
||||
(vector (cond
|
||||
((functionp ,itemformat) (funcall ,itemformat keyword))
|
||||
((stringp ,itemformat) (format ,itemformat keyword))
|
||||
((functionp itemformat) (funcall itemformat keyword))
|
||||
((stringp itemformat) (format itemformat keyword))
|
||||
(t keyword))
|
||||
(list 'funcall ,function keyword)
|
||||
(list 'funcall function keyword)
|
||||
:style (cond
|
||||
((null ,selected) t)
|
||||
((functionp ,selected) 'toggle)
|
||||
((null selected) t)
|
||||
((functionp selected) 'toggle)
|
||||
(t 'radio))
|
||||
:selected (if (functionp ,selected)
|
||||
(and (funcall ,selected keyword) t)
|
||||
(equal ,selected keyword))))
|
||||
:selected (if (functionp selected)
|
||||
(and (funcall selected keyword) t)
|
||||
(equal selected keyword))))
|
||||
keywords))
|
||||
|
||||
(defun org-mouse-remove-match-and-spaces ()
|
||||
|
|
@ -344,12 +342,12 @@ string to (format ITEMFORMAT keyword). If it is neither a string
|
|||
nor a function, elements of KEYWORDS are used directly."
|
||||
(setq group (or group 0))
|
||||
(let ((replace (org-mouse-match-closure
|
||||
(if nosurround 'replace-match
|
||||
'org-mouse-replace-match-and-surround))))
|
||||
(if nosurround #'replace-match
|
||||
#'org-mouse-replace-match-and-surround))))
|
||||
(append
|
||||
(org-mouse-keyword-menu
|
||||
keywords
|
||||
`(lambda (keyword) (funcall ,replace keyword t t nil ,group))
|
||||
(lambda (keyword) (funcall replace keyword t t nil group))
|
||||
(match-string group)
|
||||
itemformat)
|
||||
`(["None" org-mouse-remove-match-and-spaces
|
||||
|
|
@ -416,7 +414,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
|
|||
(let ((kwds org-todo-keywords-1))
|
||||
(org-mouse-keyword-menu
|
||||
kwds
|
||||
`(lambda (kwd) (org-todo kwd))
|
||||
#'org-todo
|
||||
(lambda (kwd) (equal state kwd))))))
|
||||
|
||||
(defun org-mouse-tag-menu () ;todo
|
||||
|
|
@ -424,14 +422,14 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
|
|||
(append
|
||||
(let ((tags (org-get-tags nil t)))
|
||||
(org-mouse-keyword-menu
|
||||
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||||
`(lambda (tag)
|
||||
(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)))
|
||||
(sort (if (member tag tags)
|
||||
(delete tag tags)
|
||||
(cons tag tags))
|
||||
#'string-lessp)))
|
||||
(lambda (tag) (member tag tags))
|
||||
))
|
||||
'("--"
|
||||
["Align Tags Here" (org-align-tags) t]
|
||||
|
|
@ -500,7 +498,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
|
|||
["Check TODOs" org-show-todo-tree t]
|
||||
("Check Tags"
|
||||
,@(org-mouse-keyword-menu
|
||||
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||||
(sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
|
||||
#'(lambda (tag) (org-tags-sparse-tree nil tag)))
|
||||
"--"
|
||||
["Custom Tag ..." org-tags-sparse-tree t])
|
||||
|
|
@ -510,16 +508,16 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
|
|||
["Display TODO List" org-todo-list t]
|
||||
("Display Tags"
|
||||
,@(org-mouse-keyword-menu
|
||||
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
|
||||
(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]
|
||||
"--"
|
||||
,@(org-mouse-keyword-menu
|
||||
(mapcar 'car org-agenda-custom-commands)
|
||||
(mapcar #'car org-agenda-custom-commands)
|
||||
#'(lambda (key)
|
||||
(eval `(org-agenda nil (string-to-char ,key))))
|
||||
(org-agenda nil (string-to-char key)))
|
||||
nil
|
||||
#'(lambda (key)
|
||||
(let ((entry (assoc key org-agenda-custom-commands)))
|
||||
|
|
@ -594,10 +592,10 @@ This means, between the beginning of line and the point."
|
|||
|
||||
(defun org-mouse-match-closure (function)
|
||||
(let ((match (match-data t)))
|
||||
`(lambda (&rest rest)
|
||||
(save-match-data
|
||||
(set-match-data ',match)
|
||||
(apply ',function rest)))))
|
||||
(lambda (&rest rest)
|
||||
(save-match-data
|
||||
(set-match-data match)
|
||||
(apply function rest)))))
|
||||
|
||||
(defun org-mouse-yank-link (click)
|
||||
(interactive "e")
|
||||
|
|
@ -631,7 +629,7 @@ This means, between the beginning of line and the point."
|
|||
((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
|
||||
(popup-menu
|
||||
`(nil
|
||||
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
|
||||
,@(org-mouse-list-options-menu (mapcar #'car org-startup-options)
|
||||
'org-mode-restart))))
|
||||
((or (eolp)
|
||||
(and (looking-at "\\( \\|\t\\)\\(\\+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
|
||||
|
|
@ -857,21 +855,21 @@ This means, between the beginning of line and the point."
|
|||
|
||||
(add-hook 'org-mode-hook
|
||||
#'(lambda ()
|
||||
(setq org-mouse-context-menu-function 'org-mouse-context-menu)
|
||||
(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)
|
||||
(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))
|
||||
(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))
|
||||
(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))
|
||||
(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
|
||||
|
|
@ -1086,11 +1084,11 @@ This means, between the beginning of line and the point."
|
|||
(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)
|
||||
(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")
|
||||
(cl-case (org-mouse-get-gesture event)
|
||||
|
|
|
|||
Loading…
Reference in New Issue