emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 61134:ac45ed541a16

* org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset) (org-agenda-convert-date, org-agenda-goto-calendar): New commands. (org-diary-default-entry): New function. (org-get-entries-from-diary): Better parsing of diary entries (org-agenda-check-no-diary): New function. ("diary-lib"): Advice to function `add-to-diary-list', to allow linking to diary entries. (org-agenda-execute-calendar-command): New function (org-agenda): Improved visible section in window. And use `org-fit-agenda-window'. (org-fit-agenda-window): New option. (org-move-subtree-down): Better handling of empty lines at end of subtree. (org-cycle): Numeric prefix is interpreted now as show-subtree N levels up. (org-fontify-done-headline): New option. (org-headline-done-face): New face. (org-set-font-lock-defaults): Use `org-headline-done-face'. (org-table-copy-down): renamed from `org-table-copy-from-above'. When current field is non-empty, it is copied to next row. (org-table-copy-from-above): Fixed bug which made it impossible to copy fields containing only a single non-white character.

author	Carsten Dominik <dominik@science.uva.nl>
date	Wed, 30 Mar 2005 12:37:04 +0000
parents	58a53f588384
children	6939a6683ac3 4da4a09e8b1b

comparison

equal deleted inserted replaced

-:2338a101c46a
+:ac45ed541a16
 ;; org.el --- Outline-based notes management and organizer
 ;; Carstens outline-mode for keeping track of everything.
-;; Copyright (c) 2003, 2004, 2005 Free Software Foundation
+;; Copyright (c) 2004, 2005 Free Software Foundation
+;;
 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
 ;; Keywords: outlines, hypermedia, calendar
 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 3.04
+;; Version: 3.05
+;;
 ;; 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 2, or (at your option)
 ;; any later version.
 ;;
 ;; Documentation
 ;; -------------
 ;; The documentation of Org-mode can be found in the TeXInfo file.
 ;; This distribution also contains a PDF version of it.  At the homepage
-;; of Org-mode, you can find and read online the same text as HTML.
+;; of Org-mode, you can read online the same text online as HTML.
 ;;
 ;; Changes:
 ;; -------
+;; Version 3.05
+;;    - Agenda entries from the diary are linked to the diary file, so
+;;      adding and editing diary entries can be done directly from the agenda.
+;;    - Many calendar/diary commands available directly from agenda.
+;;    - Field copying in tables with S-RET does increment.
+;;    - C-c C-x C-v extracts the visible part of the buffer for printing.
+;;    - Moving subtrees up and down preserves the whitespace at the tree end.
+;;
 ;; Version 3.04
 ;;    - Table editor optimized to need fewer realignments, and to keep
 ;;      table shape when typing in fields.
 ;;    - A new minor mode, orgtbl-mode, introduces the Org-mode table editor
 ;;      into arbitrary major modes.
 (require 'time-date)
 (require 'easymenu)
 ;;; Customization variables
-(defvar org-version "3.04"
+(defvar org-version "3.05"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
 "Options concerning startup of Org-mode."
 :tag "Org Startup"
 :group 'org)
 (defcustom org-startup-folded t
-"Non-nil means, entering Org-mode will switch to OVERVIEW."
+"Non-nil means, entering Org-mode will switch to OVERVIEW.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+#+STARTUP: fold
+#+STARTUP: nofold
+"
 :group 'org-startup
 :type 'boolean)
 (defcustom org-startup-truncated t
 "Non-nil means, entering Org-mode will set `truncate-lines'.
 :type 'boolean)
 (defcustom org-startup-with-deadline-check nil
 "Non-nil means, entering Org-mode will run the deadline check.
 This means, if you start editing an org file, you will get an
-immediate reminder of any due deadlines."
+immediate reminder of any due deadlines.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+#+STARTUP: dlcheck
+#+STARTUP: nodlcheck
+"
 :group 'org-startup
 :type 'boolean)
 (defcustom org-insert-mode-line-in-empty-file t
 "Non-nil means insert the first line setting Org-mode in empty files.
 "Non-nil means, after creating an agenda, move cursor into Agenda window.
 When nil, cursor will remain in the current window."
 :group 'org-agenda
 :type 'boolean)
+(defcustom org-fit-agenda-window t
+"Non-nil means, change windo size of agenda to fit content."
+:group 'org-agenda
+:type 'boolean)
 (defcustom org-agenda-show-all-dates t
 "Non-nil means, `org-agenda' shows every day in the selected range.
 When nil, only the days which actually have entries are shown."
 :group 'org-agenda
 :type 'boolean)
 `delete-char', and `backward-delete-char' in Org-mode buffers, with a
 slight (in fact: unnoticable) speed impact for normal typing.  Org-mode is
 very good at guessing when a re-align will be necessary, but you can always
 force one with `C-c C-c'.
-I you would like to use the optimized version in Org-mode, but the un-optimized
+If you would like to use the optimized version in Org-mode, but the un-optimized
 version in OrgTbl-mode, see the variable `orgtbl-optimized'.
 This variable can be used to turn on and off the table editor during a session,
 but in order to toggle optimization, a restart is required."
 :group 'org-table
 "Non-nil means, highlight the first table line.
 In HTML export, this means use <th> instead of <td>.
 In tables created with table.el, this applies to the first table line.
 In Org-mode tables, all lines before the first horizontal separator
 line will be formatted with <th> tags."
+:group 'org-table
+:type 'boolean)
+(defcustom org-table-copy-increment t
+"Non-nil means, increment when copying current field with \\[org-table-copy-down]."
 :group 'org-table
 :type 'boolean)
 (defcustom org-table-tab-recognizes-table.el t
 "Non-nil means, TAB will automatically notice a table.el table.
 (((class color) (background dark)) (:foreground "LightSteelBlue"))
 (t (:bold t)))
 "Face used for level 7 headlines."
 :group 'org-faces)
-(defface org-level-8-face ;;font-lock-string-face
+(defface org-level-8-face ;; font-lock-string-face
 '((((type tty) (class color)) (:foreground "green"))
 (((class color) (background light)) (:foreground "RosyBrown"))
 (((class color) (background dark)) (:foreground "LightSalmon"))
 (t (:italic t)))
 "Face used for level 8 headlines."
 (((class color) (background dark)) (:foreground "Pink" :bold t))
 (t (:inverse-video t :bold t)))
 "Face for deadlines and TODO keyords."
 :group 'org-faces)
-;; Inheritance does not work for xemacs, unfortunately.
+(defcustom org-fontify-done-headline nil
-;; We just copy the definitions and waste some space....
+"Non-nil means, change the face of a headline if it is marked DONE.
+Normally, only the TODO/DONE keyword indicates the state of a headline.
+When this is non-nil, the headline after the keyword is set to the
+`org-headline-done-face' as an additional indication."
+:group 'org-faces
+:type 'boolean)
+(defface org-headline-done-face ;; font-lock-string-face
+'((((type tty) (class color)) (:foreground "green"))
+(((class color) (background light)) (:foreground "RosyBrown"))
+(((class color) (background dark)) (:foreground "LightSalmon"))
+(t (:italic t)))
+"Face used to indicate that a headline is DONE.  See also the variable
+`org-fontify-done-headline'."
+:group 'org-faces)
+;; Inheritance does not yet work for xemacs. So we just copy...
 (defface org-deadline-announce-face
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "Blue"))
 (((class color) (background dark)) (:foreground "LightSkyBlue"))
 org-level-7-face
 org-level-8-face
 ))
 (defvar org-n-levels (length org-level-faces))
 ;; Tell the compiler about dynamically scoped variables,
 ;; and variables from other packages
 (eval-when-compile
 (defvar zmacs-regions)
+(defvar original-date)
 (defvar org-transient-mark-mode)
 (defvar org-old-auto-fill-inhibit-regexp)
 (defvar orgtbl-mode-menu)
 (defvar org-html-entities)
 (defvar org-goto-start-pos)
 ;; (3 'underline))
 '("\\<FIXME\\>" (0 'org-warning-face t))
 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
 '(1 'org-warning-face t))
 '("^#.*" (0 'font-lock-comment-face t))
-(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
+(if org-fontify-done-headline
-'(1 'org-done-face t))
+(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
+'(1 'org-done-face t) '(2 'org-headline-done-face t))
+(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
+'(1 'org-done-face t)))
 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
 (1 'org-table-face t))
 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t)))))
 (set (make-local-variable 'org-font-lock-keywords)
 (append
 ;;; Visibility cycling
 (defvar org-cycle-global-status nil)
 (defvar org-cycle-subtree-status nil)
 (defun org-cycle (&optional arg)
-"Visibility cycling for org-mode.
+"Visibility cycling for Org-mode.
 - When this function is called with a prefix argument, rotate the entire
 buffer through 3 states (global cycling)
 1. OVERVIEW: Show only top-level headlines.
 2. CONTENTS: Show all headlines of all levels, but no body text.
 2. CHILDREN: The main headline and the direct children are shown.  From
 this state, you can move to one of the children and
 zoom in further.
 3. SUBTREE:  Show the entire subtree, including body text.
+- When there is a numeric prefix, go ARG levels up and do a `show-subtree',
+keeping cursor position.
 - When point is not at the beginning of a headline, execute
 `indent-relative', like TAB normally does.  See the option
 `org-cycle-emulate-tab' for details.
 - Special case: if point is the the beginning of the buffer and there is
 no headline in line 1, this function will act as if called with prefix arg."
 (interactive "P")
-(if (and (bobp) (not (looking-at outline-regexp)))
+(if (or (and (bobp) (not (looking-at outline-regexp)))
-; special case:  use global cycling
+(equal arg '(4)))
+;; special case:  use global cycling
 (setq arg t))
 (cond
 ((org-at-table-p 'any)
 (or (org-table-recognize-table.el)
 (progn
 (org-table-justify-field-maybe)
 (org-table-next-field))))
-(arg ;; Global cycling
+((eq arg t) ;; Global cycling
 (cond
 ((and (eq last-command this-command)
 	   (eq org-cycle-global-status 'overview))
 ;; We just created the overview - now do table of contents
 		      (looking-at outline-regexp))
 	    (show-branches)
 	    (if (bobp) (throw 'exit nil))))
 	(message "CONTENTS...done"))
 (setq org-cycle-global-status 'contents))
 ((and (eq last-command this-command)
 	   (eq org-cycle-global-status 'contents))
 ;; We just showed the table of contents - now show everything
 (show-all)
 (message "SHOW ALL")
 (setq org-cycle-global-status 'all))
 (t
 ;; Default action: go to overview
 (hide-sublevels 1)
 (message "OVERVIEW")
 (setq org-cycle-global-status 'overview))))
+((integerp arg)
+;; Show-subtree, ARG levels up from here.
+(save-excursion
+(org-back-to-heading)
+(outline-up-heading arg)
+(show-subtree)))
 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
 ;; At a heading: rotate between three different views
 (org-back-to-heading)
 (let ((goal-column 0) beg eoh eol eos nxh)
 (setq beg (point))
 (save-match-data
 (save-excursion (outline-end-of-heading)
 		      (setq folded (org-invisible-p)))
 (outline-end-of-subtree))
-(if (equal (char-after) ?\n) (forward-char 1))
+(outline-next-heading)
 (setq end (point))
 ;; Find insertion point, with error handling
 (goto-char beg)
 (while (> cnt 0)
 (or (and (funcall movfunc) (looking-at outline-regexp))
 		 (error "Cannot move past superior level or buffer limit")))
 (setq cnt (1- cnt)))
 (if (> arg 0)
 	;; Moving forward - still need to move over subtree
 	(progn (outline-end-of-subtree)
-	       (if (equal (char-after) ?\n) (forward-char 1))))
+(outline-next-heading)
+(if (not (or (looking-at (concat "^" outline-regexp))
+(bolp)))
+(newline))))
 (move-marker ins-point (point))
 (setq txt (buffer-substring beg end))
 (delete-region beg end)
 (insert txt)
 (goto-char ins-point)
 (if folded (hide-subtree))
 (move-marker ins-point nil)))
 (defvar org-subtree-clip ""
 "Clipboard for cut and paste of subtrees.
-This is actually only a cpoy of the kill, because we use the normal kill
+This is actually only a copy of the kill, because we use the normal kill
 ring.  We need it to check if the kill was created by `org-copy-subtree'.")
 (defvar org-subtree-clip-folded nil
 "Was the last copied suptree folded?
 This is used to fold the tree back after pasting.")
 (define-key org-agenda-mode-map "x" 'org-agenda-exit)
 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
 (define-key org-agenda-mode-map "p" 'org-agenda-priority)
 (define-key org-agenda-mode-map "," 'org-agenda-priority)
 (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry)
+(define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar)
+(define-key org-agenda-mode-map "C" 'org-agenda-convert-date)
+(define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon)
+(define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
+(define-key org-agenda-mode-map "s" 'org-agenda-sunrise-sunset)
+(define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
+(define-key org-agenda-mode-map "h" 'org-agenda-holidays)
+(define-key org-agenda-mode-map "H" 'org-agenda-holidays)
 (define-key org-agenda-mode-map "+" 'org-agenda-priority-up)
 (define-key org-agenda-mode-map "-" 'org-agenda-priority-down)
 (define-key org-agenda-mode-map [(right)] 'org-agenda-later)
 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
 ["Week/Day View" org-agenda-week-view (local-variable-p 'starting-day)]
 ["Include Diary" org-agenda-toggle-diary
 :style toggle :selected org-agenda-include-diary :active t]
 "--"
 ["New Diary Entry" org-agenda-diary-entry t]
+("Calendar commands"
+["Goto calendar" org-agenda-goto-calendar t]
+["Phases of the Moon" org-agenda-phases-of-moon t]
+["Sunrise/Sunset" org-agenda-sunrise-sunset t]
+["Holidays" org-agenda-holidays t]
+["Convert" org-agenda-convert-date t])
 "--"
 ["Quit" org-agenda-quit t]
 ["Exit and Release Buffers" org-agenda-exit t]
 ))
 (calendar-gregorian-from-absolute sd)))
 (n1 org-agenda-start-on-weekday)
 (d (- nt n1)))
 (- sd (+ (if (< d 0) 7 0) d)))))
 (day-numbers (list start))
-s e rtn rtnall file date d start-pos)
+s e rtn rtnall file date d start-pos end-pos)
 (setq org-agenda-redo-command
 (list 'org-agenda include-all start-day ndays))
 ;; Make the list of days
 (setq ndays (or ndays org-agenda-ndays))
 (while (> ndays 1)
 (while (setq d (pop day-numbers))
 (setq date (calendar-gregorian-from-absolute d)
 s (point))
 (if (or (= d today)
 (and (not start-pos) (= d sd)))
-(setq start-pos (point)))
+(setq start-pos (point))
+(if (and start-pos (not end-pos))
+(setq end-pos (point))))
 (setq files org-agenda-files
 rtnall nil)
 (while (setq file (pop files))
 (catch 'nextfile
 (org-check-agenda-file file)
 'org-link-face)
 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))
 (put-text-property s (1- (point)) 'day d))))
 (goto-char (point-min))
 (setq buffer-read-only t)
+(if org-fit-agenda-window
+(fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
+(/ (frame-height) 2)))
+(unless (and (pos-visible-in-window-p (point-min))
+(pos-visible-in-window-p (point-max)))
+(goto-char (1- (point-max)))
+(recenter -1)
+(if (not (pos-visible-in-window-p (or start-pos 1)))
+(progn
+(goto-char (or start-pos 1))
+(recenter 1))))
 (goto-char (or start-pos 1))
 (if (not org-select-agenda-window) (select-window win))
 (message "")))
 (defun org-check-agenda-file (file)
 (defun org-agenda-set-mode-name ()
 "Set the mode name to indicate all the small mode seetings."
 (setq mode-name
 (concat "Org-Agenda"
-(if (equal org-agenda-ndays 1) " Day" "")
+(if (equal org-agenda-ndays 1) " Day"    "")
-(if (equal org-agenda-ndays 7) " Week" "")
+(if (equal org-agenda-ndays 7) " Week"   "")
-(if org-agenda-follow-mode " Follow" "")
+(if org-agenda-follow-mode     " Follow" "")
-(if org-agenda-include-diary " Diary" "")))
+(if org-agenda-include-diary   " Diary"  "")))
 (force-mode-line-update))
 (defun org-agenda-post-command-hook ()
 (if (and org-agenda-follow-mode
 (get-text-property (point) 'org-marker))
 (org-agenda-show)))
 (defun org-get-entries-from-diary (date)
 "Get the (emacs calendar) diary entries for DATE."
 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
-(diary-display-hook '(sort-diary-entries fancy-diary-display))
+(diary-display-hook '(fancy-diary-display))
+(list-diary-entries-hook
+(cons 'org-diary-default-entry list-diary-entries-hook))
 entries
-(disable-org-agenda t))
+(disable-org-diary t))
 (save-excursion
 (save-window-excursion
 (list-diary-entries date 1)))
 (if (not (get-buffer fancy-diary-buffer))
 (setq entries nil)
 (save-excursion
-(set-buffer fancy-diary-buffer)
+(switch-to-buffer fancy-diary-buffer)
 (setq buffer-read-only nil)
 (if (= (point-max) 1)
 ;; No entries
 (setq entries nil)
-;; Omit the date
+;; Omit the date and other unnecessary stuff
-(beginning-of-line 3)
+(org-agenda-cleanup-fancy-diary)
-(delete-region (point-min) (point))
+;; Add prefix to each line and extend the text properties
+(goto-char (point-min))
 (while (and (re-search-forward "^" nil t) (not (eobp)))
-(replace-match "  Diary:     "))
+(replace-match "  Diary:     ")
-(setq entries (buffer-substring (point-min) (- (point-max) 1))))
+(add-text-properties (point-at-bol) (point)
+(text-properties-at (point))))
+(if (= (point-max) 1)
+(setq entries nil)
+(setq entries (buffer-substring (point-min) (- (point-max) 1)))))
 (set-buffer-modified-p nil)
 (kill-buffer fancy-diary-buffer)))
 (when entries
 (setq entries (org-split-string entries "\n"))
 (setq entries
 (match-string 1 x)))
 (string-to-number (match-string 2 x))))
 x))
 x)
 entries)))))
+(defun org-agenda-cleanup-fancy-diary ()
+"Remove unwanted stuff in buffer created by fancy-diary-display.
+This gets rid of the date, the underline under the date, and
+the dummy entry installed by org-mode to ensure non-empty diary for each
+date."
+(goto-char (point-min))
+(if (looking-at ".*?:[ \t]*")
+(progn
+(replace-match "")
+(re-search-forward "\n=+$" nil t)
+(replace-match "")
+(while (re-search-backward "^ +" nil t) (replace-match "")))
+(re-search-forward "\n=+$" nil t)
+(delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
+(if (re-search-forward "^Org-mode dummy\n?" nil t)
+(replace-match "")))
+;; Advise the add-to-diary-list function to allow org to jump to
+;; diary entires. Wrapped into eval-after-load to avoid loading
+;; advice unnecessarily
+(eval-after-load "diary-lib"
+'(defadvice add-to-diary-list (before org-mark-diary-entry activate)
+"Make the position visible."
+(if (and (boundp 'disable-org-diary)  ;; called from org-agenda
+(stringp string)
+(buffer-file-name))
+(add-text-properties
+0 (length string)
+(list 'mouse-face 'highlight
+'keymap org-agenda-keymap
+'help-echo
+(format
+"mouse-2 or RET jump to diary file %s"
+(abbreviate-file-name (buffer-file-name)))
+'org-agenda-diary-link t
+'org-marker (org-agenda-new-marker (point-at-bol)))
+string))))
+(defun org-diary-default-entry ()
+"Add a dummy entry to the diary.
+Needed to avoid empty dates which mess up holiday display."
+(add-to-diary-list original-date "Org-mode dummy" ""))
 (defun org-add-file (&optional file)
 "Add current file to the list of files in variable `org-agenda-files'.
 These are the files which are being checked for agenda entries.
 Optional argument FILE means, use this file instead of the current.
 (list entry)
 org-agenda-files))
 file rtn results)
 ;; If this is called during org-agenda, don't return any entries to
 ;; the calendar.  Org Agenda will list these entries itself.
-(if (boundp 'disable-org-agenda) (setq files nil))
+(if (boundp 'disable-org-diary) (setq files nil))
 (while (setq file (pop files))
 (setq rtn (apply 'org-agenda-get-day-entries file date args))
 (setq results (append results rtn)))
 (concat (org-finalize-agenda-entries results) "\n")))
 and by additional input from the age of a schedules or deadline entry."
 (interactive)
 (let* ((pri (get-text-property (point-at-bol) 'priority)))
 (message "Priority is %d" (if pri pri -1000))))
 (defun org-agenda-goto ()
 "Go to the Org-mode file which contains the item at point."
 (interactive)
 (let* ((marker (or (get-text-property (point) 'org-marker)
 (org-agenda-error)))
 (buffer (marker-buffer marker))
 (pos (marker-position marker)))
 (switch-to-buffer-other-window buffer)
 (widen)
 (goto-char pos)
-(org-show-hidden-entry)
+(when (eq major-mode 'org-mode)
-(save-excursion
+(org-show-hidden-entry)
-(and (outline-next-heading)
+(save-excursion
-(org-flag-heading nil)))))  ; show the next heading
+(and (outline-next-heading)
+(org-flag-heading nil))))))  ; show the next heading
 (defun org-agenda-switch-to ()
 "Go to the Org-mode file which contains the item at point."
 (interactive)
 (let* ((marker (or (get-text-property (point) 'org-marker)
 (pos (marker-position marker)))
 (switch-to-buffer buffer)
 (delete-other-windows)
 (widen)
 (goto-char pos)
-(org-show-hidden-entry)
+(when (eq major-mode 'org-mode)
-(save-excursion
+(org-show-hidden-entry)
-(and (outline-next-heading)
+(save-excursion
-(org-flag-heading nil)))))  ; show the next heading
+(and (outline-next-heading)
+(org-flag-heading nil))))))  ; show the next heading
 (defun org-agenda-goto-mouse (ev)
 "Go to the Org-mode file which contains the deadline at the mouse click."
 (interactive "e")
 (mouse-set-point ev)
 "Display the Org-mode file which contains the deadline at the mouse click."
 (interactive "e")
 (mouse-set-point ev)
 (org-agenda-show))
+(defun org-agenda-check-no-diary ()
+"Check if the entry is a diary link and abort if yes."
+(if (get-text-property (point) 'org-agenda-diary-link)
+(org-agenda-error)))
 (defun org-agenda-error ()
 (error "Command not allowed in this line."))
 (defun org-agenda-todo ()
 "Cycle TODO state of line at point, also in Org-mode file."
 (interactive)
+(org-agenda-check-no-diary)
 (let* ((props (text-properties-at (point)))
 (col (current-column))
 (marker (or (get-text-property (point) 'org-marker)
 (org-agenda-error)))
 (pl (get-text-property (point-at-bol) 'prefix-length))
 (org-agenda-priority 'down))
 (defun org-agenda-priority (&optional force-direction)
 "Set the priority of line at point, also in Org-mode file."
 (interactive)
+(org-agenda-check-no-diary)
 (let* ((props (text-properties-at (point)))
 (col (current-column))
 (marker (or (get-text-property (point) 'org-marker)
 (org-agenda-error)))
 (pl (get-text-property (point-at-bol) 'prefix-length))
 (error "Line update did not work"))))
 (defun org-agenda-date-later (arg &optional what)
 "Change the date of this item to one day later."
 (interactive "p")
+(org-agenda-check-no-diary)
 (let* ((marker (or (get-text-property (point) 'org-marker)
 (org-agenda-error)))
 (buffer (marker-buffer marker))
 (pos (marker-position marker)))
 (save-excursion
 "Change the date of this item to one day earlier."
 (interactive "p")
 (org-agenda-date-later (- arg) what))
 (defun org-agenda-date-today (arg)
-"Change the date of this item to one day later."
+"Change the date of this item to today."
 (interactive "p")
+(org-agenda-check-no-diary)
 (let* ((marker (or (get-text-property (point) 'org-marker)
 (org-agenda-error)))
 (buffer (marker-buffer marker))
 (pos (marker-position marker)))
 (save-excursion
 (lambda (&optional error)
 (calendar-gregorian-from-absolute
 (get-text-property point 'day))))
 (call-interactively cmd))
 (fset 'calendar-cursor-to-date oldf)))))
+(defun org-agenda-execute-calendar-command (cmd)
+"Execute a calendar command from the agenda, with the date associated to
+the cursor position."
+(require 'diary-lib)
+(unless (get-text-property (point) 'day)
+(error "Don't know which date to use for calendar command"))
+(let* ((oldf (symbol-function 'calendar-cursor-to-date))
+(point (point))
+(mark (or (mark t) (point)))
+(date (calendar-gregorian-from-absolute
+(get-text-property point 'day)))
+(displayed-day (extract-calendar-day date))
+(displayed-month (extract-calendar-month date))
+(displayed-year (extract-calendar-year date)))
+(unwind-protect
+(progn
+(fset 'calendar-cursor-to-date
+(lambda (&optional error)
+(calendar-gregorian-from-absolute
+(get-text-property point 'day))))
+(call-interactively cmd))
+(fset 'calendar-cursor-to-date oldf))))
+(defun org-agenda-phases-of-moon ()
+"Display the phases of the moon for 3 month around cursor date."
+(interactive)
+(org-agenda-execute-calendar-command 'calendar-phases-of-moon))
+(defun org-agenda-holidays ()
+"Display the holidays for 3 month around cursor date."
+(interactive)
+(org-agenda-execute-calendar-command 'list-calendar-holidays))
+(defun org-agenda-sunrise-sunset (arg)
+"Display sunrise and sunset for the cursor date.
+Latitude and longitude can be specified with the variables
+`calendar-latitude' and `calendar-longitude'.  When called with prefix
+argument, location will be prompted for."
+(interactive "P")
+(let ((calendar-longitude (if arg nil calendar-longitude))
+(calendar-latitude  (if arg nil calendar-latitude))
+(calendar-location-name nil))
+(org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
+(defun org-agenda-goto-calendar ()
+"Open the Emacs calendar with the date at the cursor."
+(interactive)
+(let* ((day (or (get-text-property (point) 'day)
+(error "Don't know which date to open in calendar")))
+(date (calendar-gregorian-from-absolute day)))
+(calendar)
+(calendar-goto-date date)))
+(defun org-agenda-convert-date ()
+(interactive)
+(let ((day (get-text-property (point) 'day))
+date s)
+(unless day
+(error "Don't know which date to convert"))
+(setq date (calendar-gregorian-from-absolute day))
+(require 'cal-julian)
+(require 'cal-hebrew)
+(require 'cal-islam)
+(require 'cal-french)
+(require 'cal-mayan)
+(require 'cal-coptic)
+(require 'cal-persia)
+(require 'cal-china)
+(setq s (concat
+"Gregorian:  " (calendar-date-string date) "\n"
+"Julian:     " (calendar-julian-date-string date) "\n"
+"Astronomic: " (calendar-astro-date-string date) " (at noon UTC)\n"
+"Hebrew:     " (calendar-hebrew-date-string date) "\n"
+"Islamic:    " (calendar-islamic-date-string date) "\n"
+"French:     " (calendar-french-date-string date) "\n"
+"Maya:       " (calendar-mayan-date-string date) "\n"
+"Coptic:     " (calendar-coptic-date-string date) "\n"
+"Persian:    " (calendar-persian-date-string date) "\n"
+"Chineese:   " (calendar-chinese-date-string date) "\n"))
+(with-output-to-temp-buffer "*Dates*"
+(princ s))
+(fit-window-to-buffer (get-buffer-window "*Dates*"))))
 ;;; Link Stuff
 (defun org-find-file-at-mouse (ev)
 "Open file link or URL at mouse."
 (interactive "e")
 (org-table-insert-row 'below)))
 (org-table-goto-column col)
 (skip-chars-backward "^|\n\r")
 (if (looking-at " ") (forward-char 1)))))
-(defun org-table-copy-from-above (n)
+(defun org-table-copy-down (n)
-"Copy into the current column the nearest non-empty field from above.
+"Copy a field down in the current column.
-With prefix argument N, take the Nth non-empty field."
+If the field at the cursor is empty, copy into it the content of the nearest
+non-empty field above.  With argument N, use the Nth non-empty field.
+If the current fields is not empty, it is copied down to the next row, and
+the cursor is moved with it.  Therefore, repeating this command causes the
+column to be filled row-by-row.
+If the variable `org-table-copy-increment' is non-nil and the field is an
+integer, it will be incremented while copying."
 (interactive "p")
-(let ((colpos (org-table-current-column))
+(let* ((colpos (org-table-current-column))
-(beg (org-table-begin))
+(field (org-table-get-field))
-txt)
+(non-empty (string-match "[^ \t]" field))
+(beg (org-table-begin))
+txt)
 (org-table-check-inside-data-field)
+(if non-empty (progn (org-table-next-row) (org-table-blank-field)))
 (if (save-excursion
 (setq txt
 (catch 'exit
 (while (progn (beginning-of-line 1)
 (re-search-backward org-table-dataline-regexp
 beg t))
 (org-table-goto-column colpos t)
 (if (and (looking-at
-"|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|")
+"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
 (= (setq n (1- n)) 0))
 (throw 'exit (match-string 1)))))))
 (progn
+(if (and org-table-copy-increment
+(string-match "^[0-9]+$" txt))
+(setq txt (format "%d" (+ (string-to-int txt) 1))))
 (insert txt)
 (org-table-align))
 (error "No non-empty field found"))))
 (defun org-table-check-inside-data-field ()
 ("\C-c\C-y"           org-table-paste-rectangle)
 ("\C-c-"              org-table-insert-hline)
 ([(shift tab)]        org-table-previous-field)
 ("\C-c\C-c"           org-table-align)
 ([(return)]           org-table-next-row)
-([(shift return)]     org-table-copy-from-above)
+([(shift return)]     org-table-copy-down)
 ([(meta return)]      org-table-wrap-region)
 ("\C-c\C-q"           org-table-wrap-region)
 ("\C-c?"              org-table-current-column)
 ("\C-c "              org-table-blank-field)
 ("\C-c+"              org-table-sum)
 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
 ["Next row" org-return :active (org-at-table-p) :keys "RET"]
 "--"
 ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
 ["Copy field from above"
-org-table-copy-from-above :active (org-at-table-p) :keys "S-RET"]
+org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
 "--"
 ("Column"
 ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
 ["Move column right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
 ["Delete column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
 (not (equal (char-before (1- (point))) ?\n)))
 (insert "\n"))
 (setq char (nth (- umax level) (reverse org-ascii-underline)))
 (if org-export-with-section-numbers
 (setq title (concat (org-section-number level) " " title)))
-(insert title "\n" (make-string (length title) char) "\n"))))
+(insert title "\n" (make-string (string-width title) char) "\n"))))
+(defun org-export-copy-visible (&optional arg)
+"Copy the visible part of the buffer to another buffer, for printing.
+Also removes the first line of the buffer it is specifies a mode,
+and all options lines."
+(interactive "P")
+(let* ((filename (concat (file-name-sans-extension (buffer-file-name))
+".txt"))
+(buffer (find-file-noselect filename))
+(ore (concat
+(org-make-options-regexp
+'("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"
+"TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
+(if org-noutline-p "\\(\n\\|$\\)" "")))
+s e)
+(save-excursion
+(set-buffer buffer)
+(erase-buffer)
+(text-mode))
+(save-excursion
+(setq s (goto-char (point-min)))
+(while (not (= (point) (point-max)))
+(goto-char (org-find-invisible))
+(append-to-buffer buffer s (point))
+(setq s (goto-char (org-find-visible)))))
+(switch-to-buffer-other-window buffer)
+(newline)
+(goto-char (point-min))
+(if (looking-at ".*-\\*- mode:.*\n")
+(replace-match ""))
+(while (re-search-forward ore nil t)
+(replace-match ""))
+(goto-char (point-min))))
+(defun org-find-visible ()
+(if (featurep 'noutline)
+(let ((s (point)))
+(while (and (not (= (point-max) (setq s (next-overlay-change s))))
+(get-char-property s 'invisible)))
+s)
+(skip-chars-forward "^\n")
+(point)))
+(defun org-find-invisible ()
+(if (featurep 'noutline)
+(let ((s (point)))
+(while (and (not (= (point-max) (setq s (next-overlay-change s))))
+(not (get-char-property s 'invisible))))
+s)
+(skip-chars-forward "^\r")
+(point)))
 ;; HTML
 (defun org-get-current-options ()
 "Return a string with current options as keyword options.
 (unless org-xemacs-p
 (define-key org-mode-map [S-iso-lefttab]  'org-shifttab))
 (define-key org-mode-map [(shift tab)]    'org-shifttab)
 (define-key org-mode-map "\C-c\C-c"       'org-ctrl-c-ctrl-c)
 (define-key org-mode-map [(return)]       'org-return)
-(define-key org-mode-map [(shift return)] 'org-table-copy-from-above)
+(define-key org-mode-map [(shift return)] 'org-table-copy-down)
 (define-key org-mode-map [(meta return)]  'org-meta-return)
 (define-key org-mode-map [(control up)]   'org-move-line-up)
 (define-key org-mode-map [(control down)] 'org-move-line-down)
 (define-key org-mode-map "\C-c?"          'org-table-current-column)
 (define-key org-mode-map "\C-c "          'org-table-blank-field)
 (define-key org-mode-map "\C-c="          'org-table-eval-formula)
 (define-key org-mode-map "\C-c#"          'org-table-create-with-table.el)
 (define-key org-mode-map "\C-c\C-q"       'org-table-wrap-region)
 (define-key org-mode-map "\C-c\C-xa"      'org-export-as-ascii)
 (define-key org-mode-map "\C-c\C-x\C-a"   'org-export-as-ascii)
+(define-key org-mode-map "\C-c\C-xv"      'org-export-copy-visible)
+(define-key org-mode-map "\C-c\C-x\C-v"   'org-export-copy-visible)
+(define-key org-mode-map "\C-c\C-xo"      'org-export-as-opml)
+(define-key org-mode-map "\C-c\C-x\C-o"   'org-export-as-opml)
 (define-key org-mode-map "\C-c\C-xt"      'org-insert-export-options-template)
 (define-key org-mode-map "\C-c:"          'org-toggle-fixed-width-section)
 (define-key org-mode-map "\C-c\C-xh"      'org-export-as-html)
 (define-key org-mode-map "\C-c\C-x\C-h"   'org-export-as-html-and-open)
 ;; FIXME:  Do we really need to save match data in these commands?
 ;; I would like to remove it in order to minimize impact.
-;; Self-insert already does not preserve it.  How much resources does this take???
+;; Self-insert already does not preserve it. How much resources used by this???
 (defsubst org-table-p ()
 (if (and (eq major-mode 'org-mode) font-lock-mode)
 (eq (get-text-property (point) 'face) 'org-table-face)
 (save-match-data (org-at-table-p))))
 (setq org-table-may-need-update t)
 (self-insert-command N)))
 ;; FIXME:
 ;; The following two functions might still be optimized to trigger
-;; re-alignment less frequently.  Right now they raise the flag each time
+;; re-alignment less frequently.
-;; (through before-change-functions).  Here is how this could be minimized:
-;; Basically, check if the non-white field width before deletion is
-;; equal to the column width.  If yes, the delete should trigger a
-;; re-align.  I have not implemented this so far because it is not so
-;; easy, requires grabbing the field etc.  So it may finally have some
-;; impact on typing performance which we don't want.
-;; The defsubst is only a draft, untested...
-;; Maybe it is not so important to get rid of realigns - maybe the most
-;; important aspect is to keep the table look noce as long as possible,
-;; which is already achieved...
-;(defsubst org-check-delete-triggers-realign ()
-;  (let ((pos (point)))
-;    (skip-chars-backward "^|\n")
-;    (and (looking-at " *\\(.*?\\) *|")
-;         (= (nth (1- (org-table-current-column))
-;                 org-table-last-column-widths)
-;            (- (match-end 1) (match-beginning 1)))
-;         (setq org-table-may-need-update t))))
 (defun org-delete-backward-char (N)
 "Like `delete-backward-char', insert whitespace at field end in tables.
 When deleting backwards, in tables this function will insert whitespace in
 front of the next \"|\" separator, to keep the table aligned.  The table will
 ["Next field" org-cycle (org-at-table-p)]
 ["Previous Field" org-shifttab (org-at-table-p)]
 ["Next row" org-return (org-at-table-p)]
 "--"
 ["Blank field" org-table-blank-field (org-at-table-p)]
-["Copy field from above" org-table-copy-from-above (org-at-table-p)]
+["Copy field from above" org-table-copy-down (org-at-table-p)]
 "--"
 ("Column"
 ["Move column left" org-metaleft (org-at-table-p)]
 ["Move column right" org-metaright (org-at-table-p)]
 ["Delete column" org-shiftmetaleft (org-at-table-p)]
 "--"
 ["Create/convert from/to table.el" org-table-create-with-table.el t])
 "--"
 ("Export"
 ["ASCII" org-export-as-ascii t]
+["Extract visible text" org-export-copy-visible t]
 ["HTML"  org-export-as-html t]
 ["HTML, and open" org-export-as-html-and-open t]
+["OPML" org-export-as-opml nil]
 "--"
 ["Option template" org-insert-export-options-template t]
 ["Toggle fixed width" org-toggle-fixed-width-section t])
 "--"
 ("Documentation"
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here

Mercurial > emacs

comparison lisp/textmodes/org.el @ 61134:ac45ed541a16