[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
org-mouse.el --- Better mouse support for org-mode (version 0.05)
From: |
Piotr Zielinski |
Subject: |
org-mouse.el --- Better mouse support for org-mode (version 0.05) |
Date: |
9 Feb 2006 06:54:21 -0800 |
User-agent: |
G2/0.2 |
;;; org-mouse.el --- Better mouse support for org-mode
;; Copyright (c) 2006 Piotr Zielinski
;;
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Version: 0.05
;; $Id: org-mouse.el 31 2006-02-06 14:44:01Z pz215 $
;;
;; The latest version of this file is available from
;;
;; http://www.cl.cam.ac.uk/~pz215/files/org-mouse.el
;;
;; This file is *NOT* part of GNU Emacs.
;; This file is distributed under the same terms as GNU Emacs.
;; This program 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 2 of
;; the License, or (at your option) any later version.
;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Org-mouse provides better mouse support for org-mode. Org-mode is
;; a mode for keeping notes, maintaining ToDo lists, and doing project
;; planning with a fast and effective plain-text system. It is
;; available from
;;
;; http://staff.science.uva.nl/~dominik/Tools/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
;; + date/time extraction from selected text (requires a python script)
;; (eg. select text from your email and click "Add Appointment")
;;
;; The python script that automatically extracts date/time information
;; from a piece of English text is available from:
;;
;; http://www.cl.cam.ac.uk/~pz215/files/timeparser.py
;;
;; Use
;; ------------
;;
;; To use this package, put the following line in your .emacs:
;;
;; (require 'org-mouse)
;;
;; Tested with Emacs 22.0.50, org-mode 4.03
;; Fixme:
;; + inserting text to a folded part
;; To do:
;; + The "New Appointment" menu entry seems out of place. Remove it
;; and enhance the time/data selection function so that if the text
;; in the clipboard contains a date/time, then set that date as the
;; default (instead of "today")
;; + 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
;; + copy/cut external link
;; + move headlines with a mouse
(defun org-mouse-re-search-line (regexp)
(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 ")))
(defun org-mouse-show-context-menu (event prefix)
(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)))
(goto-char (posn-point (event-start event)))
(let ((redisplay-dont-pause t))
(sit-for 0))
(if (functionp org-mouse-context-menu-function)
(funcall org-mouse-context-menu-function)
(mouse-major-mode-menu event prefix))
)
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
(defun org-mouse-insert-heading ()
"Insert a new headline before the current line."
(interactive)
(beginning-of-line)
(org-insert-heading))
(defun org-mouse-new-appointment ()
(interactive)
(org-mouse-insert-heading)
(save-excursion
(call-process "timeparser.py" nil t nil
(format "%s" (current-kill 0)))
(backward-delete-char 1)))
(defun org-mouse-activate-headlines (limit)
"Run through the buffer and add overlays to *** in headlines."
(if (re-search-forward outline-regexp limit t)
(progn
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
'keymap org-mouse-map))
t)))
(defun org-mouse-at-headline-head ()
(save-excursion
(let ((point (point)))
(beginning-of-line)
(and (looking-at outline-regexp)
(< point (match-end 0))))))
(defun org-mouse-at-headline () ;todo: replace with org-on-heading-p??
(save-excursion
(beginning-of-line)
(looking-at outline-regexp)))
(defun org-mouse-at-headline-tail ()
(save-excursion
(let ((point (point)))
(beginning-of-line)
(and (looking-at outline-regexp)
(>= point (match-end 0))))))
(defun org-mouse-timestamp-today (&optional shift units)
(interactive)
(flet ((org-read-date (x &optional y) (current-time)))
(org-time-stamp nil))
(when shift
(org-timestamp-change shift units)))
(defun org-mouse-realign-tags ()
)
;; (defun org-mouse-priority-set (priority)
;; (replace-match priority t t nil 1))
(defun org-mouse-keyword-menu (keywords function selected &optional
itemformat)
(mapcar
(lambda (keyword)
(vector (if itemformat (format itemformat keyword) keyword)
`(funcall ,function ,keyword)
:style (if (functionp selected) 'toggle 'radio)
:selected `(if (functionp ,selected)
(funcall ,selected ,keyword)
(equal ,selected ,keyword))))
keywords))
(defun org-mouse-keyword-replace-menu (keywords &optional group
itemformat)
(setq group (or group 0))
(append
(org-mouse-keyword-menu
keywords
`(lambda (keyword) (replace-match keyword t t nil ,group))
`(match-string ,group)
itemformat)
'(["None"
(progn
(replace-match "")
(when (equal (char-after) ?\ ) (delete-char 1)))])))
(defvar org-mouse-context-menu-function nil)
(make-variable-buffer-local 'org-mouse-context-menu-function)
(defun org-mouse-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 ()
(interactive)
(let ((org-cycle-global-status nil))
(org-cycle '(4))))
(defun org-mouse-set-priority (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)
(save-excursion
(if (org-mouse-re-search-line org-mouse-priority-regexp)
(match-string 1)
(when default (char-to-string org-default-priority)))))
(setq org-mouse-global-menu
'(nil
["Show Overview" org-mouse-show-overview t]
["Show Headlines" org-mouse-show-headlines t]
["Show All" show-all t]
"--"
["Check TODOs" org-show-todo-tree t]
["Check Deadlines" org-check-deadlines t]
["Check Tags ..." 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 Calendar" org-goto-calendar t]
"--"
["Jump" org-goto]))
(defun org-mouse-at-link ()
(save-excursion
(let ((pos (point)))
(skip-chars-backward
(concat (if org-allow-space-in-links "^" "^ ")
org-non-link-chars))
(or (looking-at org-link-regexp)
(and (re-search-forward org-link-regexp (point-at-eol) t)
(<= (match-beginning 0) pos)
(>= (match-end 0) pos))))))
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding
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 ()
(let ((ret) (current org-lowest-priority))
(while (>= current ?A)
(push (char-to-string current) ret)
(decf current))
ret))
(defun org-mouse-tag-menu () ;todo
(append
(let ((tags (split-string (org-get-tags) ":" t)))
(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-context-menu ()
(let ((stamp-prefixes (list org-deadline-string
org-scheduled-string)))
(cond
((eolp)
(popup-menu org-mouse-global-menu))
((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
(member (match-string 0) org-todo-keywords))
(popup-menu
`(nil
,@(org-mouse-keyword-replace-menu org-todo-keywords)
"--"
["Check TODOs" org-show-todo-tree t]
["Display TODO List" org-todo-list 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"))))
((org-mouse-at-link)
(popup-menu
'(nil
["Open" org-open-at-point t]
["Open in Emacs" (org-open-at-point t) t]
;; ["Copy link" todo]
)))
((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 "Narrow to '%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)])))
((and (org-mouse-at-headline) (not (eolp)))
(let ((priority (org-mouse-get-priority t)))
(message "%S" priority)
(popup-menu
`(nil
("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))
"--"
["New Heading" org-mouse-insert-heading t]
["New Appointment" org-mouse-new-appointment t]
"--"
["Cycle TODO" org-todo]
["Set Deadline"
(progn (org-mouse-end-headline) (insert " ") (org-deadline))
:active (not (org-mouse-re-search-line org-deadline-regexp))]
["Schedule Task"
(progn (org-mouse-end-headline) (insert " ") (org-schedule))
:active (not (org-mouse-re-search-line org-scheduled-regexp))]
["Insert Timestamp"
(progn (org-mouse-end-headline) (insert " ") (org-time-stamp)) 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]
"--"
["Promote Heading" org-metaleft]
["Promote Subtree" org-shiftmetaleft]
["Demote Heading" org-metaright]
["Demote Subtree" org-shiftmetaright]
))))
(t
(popup-menu org-mouse-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-in-region-p (pos)
(and mark-active (>= pos (region-beginning)) (< pos (region-end))))
(defun org-mouse-down-mouse (event)
(interactive "e")
(setq this-command last-command)
(unless (and transient-mark-mode
(= 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 org-xemacs-p [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)
(font-lock-add-keywords nil
'((org-mouse-activate-headlines (0 'org-link 'prepend))) t)
(defadvice org-open-at-point (around org-mouse-open-at-point
activate)
(if (org-mouse-at-headline-head)
(org-cycle)
ad-do-it))))
(add-hook 'org-agenda-mode-hook
'(lambda ()
(define-key org-agenda-keymap [follow-link] 'mouse-face)
(define-key org-agenda-keymap
(if org-xemacs-p [button3] [mouse-3]) 'org-mouse-show-context-menu)))
(provide 'org-mouse)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- org-mouse.el --- Better mouse support for org-mode (version 0.05),
Piotr Zielinski <=