emacs: lisp/org/org-mouse.el comparison

comparison lisp/org/org-mouse.el @ 94414:d86cb59eea9f

2008-04-27 Carsten Dominik <dominik@science.uva.nl> * org/org.el (org-html-level-start): Always have id's in HTML (org-export-as-html): Use `org-link-protocols' to retrieve the export form of the link. (org-add-link-type): Final parameter renamed from PUBLISH. Better documentation of how it is to be used. Avoid double entries for the same link type. (org-add-link-props): New function. (org-modules-loaded): New variable. (org-load-modules-maybe, org-set-modules): New function. (org-modules): New option. (org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode) (orgtbl-mode, org-store-link, org-insert-link-global) (org-open-at-point): Call `org-load-modules-maybe'. (org-search-view): Add more text properties. (org-agenda-schedule, org-agenda-deadline): Allow also in search-type agendas. (org-search-view): Order of arguments has been changed. Interpret prefix-arg as TODO-ONLY. (org-agenda, org-run-agenda-series, org-agenda-manipulate-query): Take new argument order of `org-search-view' into account. (org-todo-only): New variable. (org-search-syntax-table): New variable and function. (org-search-view): Do the search with the special syntax table. (define-obsolete-function-alias): Make work with XEmacs. (org-add-planning-info): Use old date as default when modifying an existing deadline or scheduled item. (org-agenda-compute-time-span): Make argument N optional. (org-agenda-format-date-aligned): Require `cal-iso'. (org-agenda-list): Include week into into agenda heading, don't list it at each date (only on Mondays). (org-read-date-analyze): Define local variable `iso-date'. (org-agenda-format-date-aligned): Remove dependency on `calendar-time-from-absolute'. (org-remember-apply-template, org-go-to-remember-target): Interpret filenames relative to `org-directory'. (org-complete): Silently fail when trying to complete keywords that don't have a default value. (org-get-current-options): Added a #+DATE: option. (org-additional-option-like-keywords): Removed "DATE:" from the list of additional keywords. (org-export-as-html): Removed (current-time) as unnecessary second argument of `format-time-string'. (org-clock-find-position): Handle special case at end of buffer. (org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to `org-agenda-change-time-span'. (org-agenda-week-view): New argument ISO-WEEK, pass it on to `org-agenda-change-time-span'. (org-agenda-month-view): New argument MONTH, pass it on to `org-agenda-change-time-span'. (org-agenda-year-view): New argument YEAR, pass it on to `org-agenda-change-time-span'. (org-agenda-change-time-span): New optional argument N, pass it on to `org-agenda-compute-time-span'. (org-agenda-compute-time-span): New argument N, interpret it by changing the starting day. (org-small-year-to-year): New function. (org-scheduled-past-days): Respect `org-scheduled-past-days'. (org-auto-repeat-maybe): Make sure that repeating dates are pushed into the future, and that the shift is at least one interval, never 0. (org-update-checkbox-count): Fix bug with checkbox counting. (org-add-note): New command. (org-add-log-setup): Renamed from `org-add-log-maybe'. (org-log-note-headings): New entry for plain notes (i.e. notes not related to state changes or clocking). (org-get-org-file): Check for availability of `remember-data-file'. (org-cached-entry-get): Allow a regexp value for `org-use-property-inheritance'. (org-use-property-inheritance): Allow regexp value. Fix bug in customization type. (org-use-tag-inheritance): Allow a list and a regexp value for this variable. (org-scan-tags, org-get-tags-at): Implement selective tag inheritance. (org-entry-get): Respect value `selective' for the INHERIT argument. (org-tag-inherit-p, org-property-inherit-p): New functions. (org-agenda-format-date-aligned): Allow 10 characters for weekday, to acomodate German locale. (org-add-archive-files): New function. (org-agenda-files): New argument `ext', to get archive files as well. (org-tbl-menu): Protect the use of variables that are only available when org-table.el gets loaded. (org-read-agenda-file-list): Error if `org-agenda-files' is a single directory. (org-open-file): Allow a batch process to trigger waiting after executing a system command. (org-store-link): Link to headline when there is not target and no region in an org-mode buffer when creating a link. (org-link-types-re): New variable. (org-make-link-regexps): Compute `org-link-types-re'. (org-make-link-description-function): New option. (org-agenda-date, org-agenda-date-weekend): New faces. (org-archive-sibling-heading): New option. (org-archive-to-archive-sibling): New function. (org-iswitchb): New command. (org-buffer-list): New function. (org-agenda-columns): Also try the #+COLUMNS line in the buffer associated with the entry at point (or with the first entry in the agenda view). (org-modules): Add entry for org-bibtex.el. (org-completion-fallback-command): Moved into `org-completion' group. (org-clock-heading-function): Moved to `org-progress' group. (org-auto-repeat-maybe): Make sure that a note can be enforces if `org-log-repeat' is `note'. (org-modules): Allow additional symbols for external packages. (org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be undefined. (org-clock-goto): Hide drawers after showing an entry with `org-clock-goto.' (org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try also a clocktable block shift. (org-clocktable-try-shift): New function. (org-columns-hscoll-title): New function. (org-columns-previous-hscroll): New variable. (org-columns-full-header-line-format): New variable. (org-columns-display-here-title, org-columns-remove-overlays): Install `org-columns-hscoll-title' in post-command-hook. * org/org.el: Split into many small files. * org/org-agenda.el: New file, split off from org.el. * org/org-archive.el: New file, split off from org.el. * org/org-bbdb.el: New file. * org/org-bibtex.el: New file, split off from org.el. * org/org-clock.el: New file, split off from org.el. * org/org-colview.el: New file, split off from org.el. * org/org-compat.el: New file, split off from org.el. * org/org-exp.el: New file, split off from org.el. * org/org-faces.el: New file, split off from org.el. * org/org-gnus.el: New file, split off from org.el. * org/org-info.el: New file, split off from org.el. * org/org-infojs.el: New file. * org/org-irc.el: New file. * org/org-macs.el: New file, split off from org.el. * org/org-mew.el: New file. * org/org-mhe.el: New file, split off from org.el. * org/org-publish.el: New file, split off from org.el. * org/org-remember.el: New file, split off from org.el. * org/org-rmail.el: New file, split off from org.el. * org/org-table.el: New file, split off from org.el. * org/org-vm.el: New file, split off from org.el. * org/org-wl.el: New file, split off from org.el. 2008-04-27 Jason Riedy <jason@acm.org> * lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines parameter that supresses lines that evaluate to NIL. (orgtbl-get-fmt): New inline function for picking apart formats that may be lists. (orgtbl-apply-fmt): New inline function for applying formats that may be functions. (orgtbl-eval-str): New inline function for strings that may be functions. (orgtbl-format-line, orgtbl-to-generic): Use and document. (orgtbl-to-latex, orgtbl-to-texinfo): Document. (*orgtbl-llfmt*, *orgtbl-llstart*) (*orgtbl-llend*): Dynamic variables for last-line formatting. (orgtbl-format-section): Shift formatting to support detecting the last line and formatting it specially. (orgtbl-to-generic): Document :ll* formats. Set to the non-ll formats unless overridden. (orgtbl-to-latex): Suggest using :llend to suppress the final \\. (*orgtbl-table*, *orgtbl-rtn*): Dynamically bound variables to hold the input collection of lines and output formatted text. (*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*, (*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound format parameters. (orgtbl-format-line): New function encapsulating formatting for a single line. (orgtbl-format-section): Similar for each section. Rebinding the dynamic vars customizes the formatting for each section. (orgtbl-to-generic): Use orgtbl-format-line and orgtbl-format-section. (org-get-param): Now unused, so delete. (orgtbl-gather-send-defs): New function to gather all the SEND definitions before a table. (orgtbl-send-replace-tbl): New function to find the RECEIVE corresponding to the current name. (orgtbl-send-table): Use the previous two functions and implement multiple destinations for each table. * doc/org.texi (A LaTeX example): Note that fmt may be a one-argument function, and efmt may be a two-argument function. (Radio tables): Document multiple destinations. 2008-04-27 Carsten Dominik <dominik@science.uva.nl> * org/org-agenda.el (org-add-to-diary-list): New function. (org-prefix-has-effort): New variable. (org-sort-agenda-noeffort-is-high): New option. (org-agenda-columns-show-summaries) (org-agenda-columns-compute-summary-properties): New options. (org-format-agenda-item): Compute the duration of the item. (org-agenda-weekend-days): New variable. (org-agenda-list, org-timeline): Use the proper faces for dates in the agenda and timeline buffers. (org-agenda-archive-to-archive-sibling): New command. (org-agenda-start-with-clockreport-mode): New option. (org-agenda-clockreport-parameter-plist): New option. (org-agenda-clocktable-mode): New variable. (org-agenda-deadline-leaders): Allow a function value for the deadline leader. (org-agenda-get-deadlines): Deal with new function value. * lisp/org-clock.el (org-clock): New customization group. (org-clock-into-drawer, org-clock-out-when-done) (org-clock-in-switch-to-state, org-clock-heading-function): Moved into the new group. (org-clock-out-remove-zero-time-clocks): New option. (org-clock-out): Use `org-clock-out-remove-zero-time-clocks'. (org-dblock-write:clocktable): Allow a Lisp form for the scope parameter. (org-dblock-write:clocktable): Fixed bug with total time calculation. (org-dblock-write:clocktable): Request the unrestricted list of files. (org-get-clocktable): New function. (org-dblock-write:clocktable): Make sure :tstart and :tend can not only be strings but also integers (an absolute day number) and lists (m d y). * org/org-colview.el (org-columns-next-allowed-value) (org-columns-edit-value): Limit the effort for updatig in the agenda to recomputing a single file. (org-columns-compute): Only write property value if it has changed. This avoids raising the buffer-change-flag unnecessarily. (org-agenda-colview-summarize) (org-agenda-colview-compute): New functions. (org-agenda-columns): Call `org-agenda-colview-summarize'. * org/org-exp.el (org-export-run-in-background): New option. (org-export-icalendar): Allow a batch process to trigger waiting after executing a system command. (org-export-preprocess-string): Renamed-from `org-cleaned-string-for-export'. (org-export-html-style): Made target class look like normal text. (org-export-as-html): Make use of the better proprocessing in `org-cleaned-string-for-export'. (org-cleaned-string-for-export): Better treatment of heuristic targets, many more internal links will now work in HTML export. (org-get-current-options): Incorporate LINK_UP, LINK_HOME, and INFOJS. (org-export-inbuffer-options-extra): New variable. (org-export-options-filters): New hook. (org-infile-export-plist): Find also the settings keywords in `org-export-inbuffer-options-extra'. (org-infile-export-plist): Allow multiple #+OPTIONS lines and multiple #+INFOJS_OPT lines. (org-export-html-handle-js-options): New function. (org-export-html-infojs-setup): New option. (org-export-as-html): Call `org-export-html-handle-js-options'. Add autoload to all entry points. (org-skip-comments): Function removed. * org/org-table.el (org-table-make-reference): Extra parenthesis around single fields, to make sure that algebraic formulas get correctly interpreted by calc. (org-table-current-column): No longer interactive. * org/org-export-latex.el (org-export-latex-preprocess): Renamed from `org-export-latex-cleaned-string'. 2008-04-27 Bastien Guerry <bzg@altern.org> * org/org-publish.el (org-publish-get-base-files-1): New function. (org-publish-get-base-files): Use it. (org-publish-temp-files): New variable. Don't require 'dired-aux anymore. (org-publish-initial-buffer): New variable. (org-publish-org-to, org-publish): Use it. (org-publish-get-base-files-1): Bug fix: get the proper list of files when recursing thru a directory. (org-publish-get-base-files): Use the :exclude property to skip both files and directories.

author	Carsten Dominik <dominik@science.uva.nl>
date	Sun, 27 Apr 2008 18:33:39 +0000
parents	dda2c82177dc
children	ba3167bc4143

comparison

equal deleted inserted replaced

-:90289baecd6a
+:d86cb59eea9f
 ;; 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
+;; Version: 6.02b
 ;;
 ;; 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
 ;;    + 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:
 ;; 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
 ;; + 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.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-agenda-allow-remote-undo)
+(defvar org-agenda-undo-list)
+(defvar org-agenda-custom-commands)
+(declare-function org-agenda-change-all-lines "org-agenda"
+		  (newhead hdmarker &optional fixface))
+(declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
 (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.
 (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)))
 (: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))
 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.
 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."
 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 ()
 (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
 ;; 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)
 ('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)
 				 " ")
 (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 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 ()
 (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))
 			 (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)]
 ((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")
 	)))
 ((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))
 (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)
 (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))))))
 (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)
 	   (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)
 	      (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
 	(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]

Mercurial > emacs

comparison lisp/org/org-mouse.el @ 94414:d86cb59eea9f