[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to textmodes/org-mouse.el
|
From: |
Carsten Dominik |
|
Subject: |
[Emacs-diffs] Changes to textmodes/org-mouse.el |
|
Date: |
Sat, 22 Mar 2008 05:55:16 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Carsten Dominik <cdominik> 08/03/22 05:55:12
Index: textmodes/org-mouse.el
===================================================================
RCS file: textmodes/org-mouse.el
diff -N textmodes/org-mouse.el
--- textmodes/org-mouse.el 13 Mar 2008 09:00:37 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,1110 +0,0 @@
-;;; org-mouse.el --- Better mouse support for org-mode
-
-;; Copyright (C) 2006, 2007, 2008 Free Software Foundation
-;;
-;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
-;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
-;; Version: 5.23
-;;
-;; 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, or (at your option)
-;; any later version.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; Org-mouse provides mouse support for org-mode.
-;;
-;; http://orgmode.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
-;;
-;; Use
-;; ---
-;;
-;; To use this package, put the following line in your .emacs:
-;;
-;; (require 'org-mouse)
-;;
-
-;; 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.):
-;;
-;; + 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 the maintainer with new feature suggestions / bugs
-
-;; History:
-;;
-;; SInce version 5.10: Changes are listed in the general org-mode docs.
-;;
-;; 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)
-;;
-;; Version 0.24
-;; + minor changes to the table menu
-;;
-;; Version 0.23
-;; + preliminary support for tables and calculation marks
-;; + context menu support for org-agenda-undo & org-sort-entries
-;;
-;; Version 0.22
-;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
-;;
-;; Version 0.21
-;; + selected text activates its context menu
-;; + shift-middleclick or right-drag inserts the text from the clipboard in
the form of a link
-;;
-;; Version 0.20
-;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
-;; + the TODO menu can now list occurrences of a specific TODO keyword
-;; + #+STARTUP line is now recognized
-;;
-;; 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))
-(require 'org)
-
-(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
- "Regular expression that matches a plain list.")
-(defvar org-mouse-direct t
- "Internal variable indicating whether the current action is direct.
-
-If t, then the current action has been invoked directly through the buffer
-it is intended to operate on. If nil, then the action has been invoked
-indirectly, for example, through the agenda buffer.")
-
-(defgroup org-mouse nil
- "Mouse support for org-mode."
- :tag "Org Mouse"
- :group 'org)
-
-(defcustom org-mouse-punctuation ":"
- "Punctuation used when inserting text by drag and drop."
- :group 'org-mouse
- :type 'string)
-
-
-(defun org-mouse-re-search-line (regexp)
- "Search 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 ")))
-
-(defvar org-mouse-context-menu-function nil
- "Function to create the context menu.
-The value of this variable is the function invoked by
-`org-mouse-context-menu' as the context menu.")
-(make-variable-buffer-local 'org-mouse-context-menu-function)
-
-(defun org-mouse-show-context-menu (event prefix)
- "Invoke the context menu.
-
-If the value of `org-mouse-context-menu-function' is a function, then
-this function is called. Otherwise, the current major mode menu is used."
- (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)))
- (when (not (org-mouse-mark-active))
- (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 event)
- (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' or `:middle' or `:end', depending on the point
position.
-
-If the point is at the end of the line, return `:end'.
-If the point is separated from the beginning of the line only by white
-space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise,
-return `:middle'."
- (cond
- ((eolp) :end)
- ((org-mouse-bolp) :beginning)
- (t :middle)))
-
-(defun org-mouse-empty-line ()
- "Return non-nil iff the line contains only white space."
- (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
-
-(defun org-mouse-next-heading ()
- "Go to the next heading.
-If there is none, ensure 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 ()
- "Insert a new heading, as `org-insert-heading'.
-
-If the point is at the :beginning (`org-mouse-line-position') of the line,
-insert the new heading before the current line. Otherwise, insert it
-after the current heading."
- (interactive)
- (case (org-mouse-line-position)
- (:beginning (beginning-of-line)
- (org-insert-heading))
- (t (org-mouse-next-heading)
- (org-insert-heading))))
-
-(defun org-mouse-timestamp-today (&optional shift units)
- "Change the timestamp into SHIFT UNITS in the future.
-
-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)))
-
-(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
- "A helper function.
-
-Returns a menu fragment consisting of KEYWORDS. When a keyword
-is selected by the user, FUNCTION is called with the selected
-keyword as the only argument.
-
-If SELECTED is nil, then all items are normal menu items. If
-SELECTED is a function, then each item is a checkbox, which is
-enabled for a given keyword iff (funcall SELECTED keyword) return
-non-nil. If SELECTED is neither nil nor a function, then the
-items are radio buttons. A radio button is enabled for the
-keyword `equal' to SELECTED.
-
-ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
-is a function, it is invoked with the keyword as the only
-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)
- (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."
- (interactive)
- (replace-match "")
- (just-one-space))
-
-(defvar 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)
- (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.
-
-Returns a menu fragment consisting of KEYWORDS. When a keyword
-is selected, group GROUP of the current match is replaced by the
-keyword. The method ensures that both ends of the replacement
-are separated from the rest of the text in the buffer by
-individual spaces (unless NOSURROND is non-nil).
-
-The final entry of the menu is always \"None\", which removes the
-match.
-
-ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
-is a function, it is invoked with the keyword as the only
-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.
-"
- (setq group (or group 0))
- (let ((replace (org-mouse-match-closure
- (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))
- (match-string group)
- itemformat)
- `(["None" org-mouse-remove-match-and-spaces
- :style radio
- :selected ,(not (member (match-string group) keywords))]))))
-
-(defun org-mouse-show-headlines ()
- "Change the visibility of the current org buffer to only 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 ()
- "Change visibility of current org buffer to first-level headlines only."
- (interactive)
- (let ((org-cycle-global-status nil))
- (org-cycle '(4))))
-
-(defun org-mouse-set-priority (priority)
- "Set the priority of the current headline to 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)
- "Return the priority of the current headline.
-DEFAULT is returned if no priority is given in the headline."
- (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 keyword.
-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 ()
- (loop for priority from ?A to org-lowest-priority
- collect (char-to-string priority)))
-
-(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-list-options-menu (alloptions &optional function)
- (let ((options (save-match-data
- (split-string (match-string-no-properties 1)))))
- (print options)
- (loop for name in alloptions
- collect
- (vector name
- `(progn
- (replace-match
- (mapconcat 'identity
- (sort (if (member ',name ',options)
- (delete ',name ',options)
- (cons ',name ',options))
- 'string-lessp)
- " ")
- nil nil nil 1)
- (when (functionp ',function) (funcall ',function)))
- :style 'toggle
- :selected (and (member name options) t)))))
-
-(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]
- "--"
- ,@(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)])))
-
-
-(defun org-mouse-get-context (contextlist context)
- (let ((contextdata (assq context contextlist)))
- (when contextdata
- (save-excursion
- (goto-char (second contextdata))
- (re-search-forward ".*" (third 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)))
-
-(defun org-mouse-insert-item (text)
- (case (org-mouse-line-position)
- (:beginning ; 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))
-
-(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
- (if (eq major-mode '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)
- (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-todo-keywords ()
- (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords))
-
-(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 " \\( *\\)"))))
-
-(defun org-mouse-yank-link (click)
- (interactive "e")
- ;; Give temporary modes such as isearch a chance to turn off.
- (run-hooks 'mouse-leave-buffer-hook)
- (mouse-set-point click)
- (setq mouse-selection-click-count 0)
- (delete-horizontal-space)
- (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))))
- (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\\)+$")
- (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
- (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-mouse-todo-keywords)))
- (popup-menu
- `(nil
- ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords))
- "--"
- ["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" (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]
- "--"
- ["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)]
- "--"
- ["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)))
- (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"
- ,@(progn (org-mouse-match-todo-keyword)
- (org-mouse-keyword-replace-menu (org-mouse-todo-keywords)
- 1)))
- ["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-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-mark-active ()
- (and mark-active transient-mark-mode))
-
-(defun org-mouse-in-region-p (pos)
- (and (org-mouse-mark-active)
- (>= pos (region-beginning))
- (< pos (region-end))))
-
-(defun org-mouse-down-mouse (event)
- (interactive "e")
- (setq this-command last-command)
- (unless (and (= 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-mode-map [S-mouse-2] 'org-mouse-yank-link)
- (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)
- (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))))
-
-(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'.
-
-(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)))))
- (org-with-remote-undo buffer
- (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)
- (message "_cmd: %S" _cmd)
- (message "this-command: %S" this-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 (&optional event)
- (or (org-mouse-do-remotely 'org-mouse-context-menu)
- (popup-menu
- '("Agenda"
- ("Agenda Files")
- "--"
- ["Undo" (progn (message "last command: %S" last-command) (setq
this-command 'org-agenda-undo) (org-agenda-undo))
- :visible (if (eq last-command 'org-agenda-undo)
- org-agenda-pending-undo-list
- org-agenda-undo-list)]
- ["Rebuild Buffer" org-agenda-redo t]
- ["New Diary Entry"
- org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)
t]
- "--"
- ["Goto Today" org-agenda-goto-today
- (org-agenda-check-type nil 'agenda 'timeline) t]
- ["Display Calendar" org-agenda-goto-calendar
- (org-agenda-check-type nil 'agenda 'timeline) t]
- ("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]
- ))))
-
-(defun org-mouse-get-gesture (event)
- (let ((startxy (posn-x-y (event-start event)))
- (endxy (posn-x-y (event-end event))))
- (if (< (car startxy) (car endxy)) :right :left)))
-
-
-; (setq org-agenda-mode-hook nil)
-(add-hook 'org-agenda-mode-hook
- '(lambda ()
- (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)
- (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start)
- (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier)
- (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later)
- (define-key org-agenda-keymap [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)
-
-;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to textmodes/org-mouse.el,
Carsten Dominik <=