Mercurial > emacs
changeset 70866:7d0efe895341
(org-open-at-point): Use renamed variable
`org-confirm-shell-link-function'.
(org-confirm-shell-link-function): Renamed from
`org-confirm-shell-links'.
(org-export-directory): New function.
(org-export-as-ascii, org-export-as-html, org-export-as-xoxo)
(org-export-icalendar): Use `org-export-directory'.
(org-indent-item): Keep cursor position.
(org-link-file-path-type): New option.
(org-export-as-html): Fixed bug with plain lists starting in
column 0.
(org-export-as-html): Removed deadline formatting, this happens
now already in `org-html-handle-time-stamps'.
(org-export-html-style): Deadline class removed.
(org-insert-labeled-timestamps-at-point): New option.
(org-cycle, org-occur, org-scan-tags): Use `org-overview' instead
of `hide-sublevels 1', in case the first headline is not level 1.
(org-overview, org-content): New fuction.
(org-cycle-global-status, org-cycle-subtree-status): Make these
variables buffer-local.
(org-global-cycle): New command.
(org-shifttab): Use `org-global-cycle'.
(org-insert-heading, org-insert-item): Go to end of new
headline/item after creating it.
(org-export-visible): Renames from `org-export-copy-visible'. Now
creates a temporary org-file and applies an exporting command to
it.
(org-table-eval-formula): Support for lisp forms.
(org-agenda-todo-ignore-scheduled): New option.
(org-agenda-get-todos): Use new option
`org-agenda-todo-ignore-scheduled'.
(org-export-html-inline-images): New value `maybe'.
(org-export-as-html): Inlining of images dependent on link
description.
(org-archive-subtree): Check for end-of-buffer before trying
`kill-line'.
(org-agenda-follow-mode): New option.
(org-export-with-tags, org-export-with-timestamps): New options.
(org-html-handle-time-stamps): New function.
(org-keyword-time-regexp): New variable.
(org-agenda-get-todos): Use `org-agenda-todo-list-sublevels'.
(org-agenda-todo-list-sublevels): New option.
(org-html-level-start): When TITLE is nil, just close all levels.
(org-parse-key-lines, org-parse-export-options): Functions
removed, replaced by `org-infile-export-plist'.
(org-combine-plists, org-infile-export-plist)
(org-default-export-plist): New functions.
(org-export-html-preamble, org-export-html-postamble)
(org-export-html-auto-preamble, org-export-html-auto-postamble):
New variables.
(org-export-publishing-directory): New option.
(org-export-as-html, org-export-as-ascii): Use the new property
lists for settings.
(org-export-copy-visible, org-export-as-xoxo): Respect
`org-export-publishing-directory'.
(org-link-search, org-store-link, org-file-apps): Support for
links to BibTeX database entries..
(org-get-current-options, org-set-regexps-and-options): Implement
logging as a startup option.
(org-store-link): Make sure context string is never empty
(org-insert-link): Use relative path when possible.
(org-at-item-checklet-p): New function.
(org-shifttab, org-shiftmetaleft, org-shiftmetaright)
(org-shiftmetaup, org-shiftmetadown, org-metaleft)
(org-metaright, org-metaup, org-metadown, org-shiftup)
(org-shiftdown, org-shiftright, org-shiftleft)
(org-ctrl-c-ctrl-c, org-cycle, org-return, org-meta-return):
Dispatch using `call-interactively'.
(org-call-with-arg): New defsubst.
(org-tag-alist, org-use-fast-tag-selection): New options.
(org-complete): Use `org-tag-alist'.
(org-fast-tag-insert, org-fast-tag-selection): New functions.
(org-next-item, org-previous-item): New commands.
(org-beginning-of-item, org-end-of-item): Added (interactive) to
make command.
(org-shiftup, org-shiftdown): Accommodate the item-navigation commands.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Wed, 24 May 2006 07:54:46 +0000 |
| parents | 3364480537d9 |
| children | 68e63907ebfb |
| files | lisp/textmodes/org.el |
| diffstat | 1 files changed, 1601 insertions(+), 586 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/textmodes/org.el Wed May 24 02:16:08 2006 +0000 +++ b/lisp/textmodes/org.el Wed May 24 07:54:46 2006 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.26 +;; Version: 4.33 ;; ;; This file is part of GNU Emacs. ;; @@ -52,16 +52,17 @@ ;; (define-key global-map "\C-cl" 'org-store-link) ;; (define-key global-map "\C-ca" 'org-agenda) ;; -;; If you have downloaded Org-mode from the Web, you must byte-compile -;; org.el and put it on your load path. In addition to the Emacs Lisp -;; lines above, you also need to add the following lines to .emacs: +;; Furthermore you need to activate font-lock-mode in org-mode buffers. +;; either of the following two lins will do the trick: +;; +;; (global-font-lock-mode 1) ; for all buffers +;; (add-hook 'org-mode-hook 'turn-on-font-lock) ; org-mode buffers only ;; -;; (autoload 'org-mode "org" "Org mode" t) -;; (autoload 'org-diary "org" "Diary entries from Org mode") -;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) -;; (autoload 'org-store-link "org" "Store a link to the current location" t) -;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) -;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") +;; If you have downloaded Org-mode from the Web, you have to take additional +;; action: Byte-compile org.el and org-publish.el and put them together with +;; org-install.el on your load path. Then also add to your .emacs file: +;; +;; (require 'org-install) ;; ;; This setup will put all files with extension ".org" into Org-mode. As ;; an alternative, make the first line of a file look like this: @@ -81,6 +82,57 @@ ;; ;; Changes since version 4.10: ;; --------------------------- +;; Version 4.33 +;; - New commands to move through plain lists: S-up and S-down. +;; - Bug fixes and documentation update. +;; +;; Version 4.32 +;; - Fast (single-key-per-tag) interface for setting TAGS. +;; - The list of legal tags can be configured globally and locally. +;; - Elisp and Info links (thanks to Todd Neal). +;; - `org-export-publishing-directory' can be an alist, with different +;; directories for different export types. +;; - All context-sensitive commands use `call-interactively' to dispatch. +;; - `org-confirm-shell-links' renamed to `org-confirm-shell-link-function'. +;; - Bug fixes. +;; +;; Version 4.31 +;; - Bug fixes. +;; +;; Version 4.30 +;; - Modified installation: Autoloads have been collected in org-install.el. +;; - Logging (org-log-done) is now a #+STARTUP option. +;; - Checkboxes in plain list items, following up on Frank Ruell's idea. +;; - File links inserted with C-c C-l will use relative paths if the linked +;; file is in the current directory or a subdirectory of it. +;; - New variable `org-link-file-path-type' to specify preference for +;; relative and absolute paths. +;; - New CSS classes for tags, timestamps, timestamp keywords. +;; - Bug and typo fixes. +;; +;; Version 4.29 +;; - Inlining images in HTML export now depends on wheather the link +;; contains a description or not. +;; - TODO items can be scheduled from the global TODO list using C-c C-s. +;; - TODO items already scheduled can be made to disappear from the global +;; todo list, see `org-agenda-todo-ignore-scheduled'. +;; - In Tables, formulas may also be Lisp forms. +;; - Exporting the visible part of an outline with `C-c C-x v' works now +;; for all available exporters. +;; - Bug fixes, lots of them :-( +;; +;; Version 4.28 +;; - Bug fixes. +;; +;; Version 4.27 +;; - HTML exporter generalized to receive external options. +;; As part of the process, author, email and date have been moved to the +;; end of the HTML file. +;; - Support for customizable file search in file links. +;; - BibTeX database links as first application of the above. +;; - New option `org-agenda-todo-list-sublevels' to turn off listing TODO +;; entries that are sublevels of another TODO entry. +;; ;; Version 4.26 ;; - Bug fixes. ;; @@ -137,7 +189,7 @@ ;;; Customization variables -(defvar org-version "4.26" +(defvar org-version "4.33" "The version number of the file org.el.") (defun org-version () (interactive) @@ -325,6 +377,18 @@ :tag "Org Cycle" :group 'org-structure) +(defcustom org-cycle-global-at-bob t + "Cycle globally if cursor is at beginning of buffer and not at a headline. +This makes it possible to do global cycling without having to use S-TAB or +C-u TAB. For this special case to work, the first line of the buffer +must not be a headline - it may be empty ot some other text. When used in +this way, `org-cycle-hook' is disables temporarily, to make sure the +cursor stays at the beginning of the buffer. +When this option is nil, don't do anything special at the beginning +of the buffer." + :group 'org-cycle + :type 'boolean) + (defcustom org-cycle-emulate-tab t "Where should `org-cycle' emulate TAB. nil Never @@ -376,6 +440,11 @@ :group 'org-edit-structure :type 'boolean) +(defcustom org-insert-heading-hook nil + "Hook being run after inserting a new heading." + :group 'org-edit-structure + :type 'boolean) + (defcustom org-enable-fixed-width-editor t "Non-nil means, lines starting with \":\" are treated as fixed-width. This currently only means, they are never auto-wrapped. @@ -756,6 +825,23 @@ (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") (string :tag "Other" :value "<%s>"))) +(defcustom org-link-file-path-type 'adaptive + "How the path name in file links should be stored. +Valid values are: + +relative relative to the current directory, i.e. the directory of the file + into which the link is being inserted. +absolute absolute path, if possible with ~ for home directory. +noabbrev absolute path, no abbreviation of home directory. +adaptive Use relative path for files in the current directory and sub- + directories of it. For other files, use an absolute path." + :group 'org-link + :type '(choice + (const relative) + (const absolute) + (const noabbrev) + (const adaptive))) + (defcustom org-activate-links '(bracket angle plain radio tag date) "Types of links that should be activated in Org-mode files. This is a list of symbols, each leading to the activation of a certain link @@ -898,15 +984,32 @@ :group 'org-link-follow :type 'boolean) -(defcustom org-confirm-shell-links 'yes-or-no-p +(defcustom org-confirm-shell-link-function 'yes-or-no-p "Non-nil means, ask for confirmation before executing shell links. Shell links can be dangerous, just thing about a link [[shell:rm -rf ~/*][Google Search]] This link would show up in your Org-mode document as \"Google Search\" -but really it would remove your entire home directory. Dangerous indeed. -Therefore I *definitely* advise agains setting this varaiable to nil. +but really it would remove your entire home directory. +Therefore I *definitely* advise against setting this variable to nil. +Just change it to `y-or-n-p' of you want to confirm with a single key press +rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil))) + +(defcustom org-confirm-elisp-link-function 'yes-or-no-p + "Non-nil means, ask for confirmation before executing elisp links. +Elisp links can be dangerous, just thing about a link + + [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] + +This link would show up in your Org-mode document as \"Google Search\" +but really it would remove your entire home directory. +Therefore I *definitely* advise against setting this variable to nil. Just change it to `y-or-n-p' of you want to confirm with a single key press rather than having to type \"yes\"." :group 'org-link-follow @@ -934,7 +1037,11 @@ See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - '((t . (w32-shell-execute "open" file))) + (list (cons t + (list (if (featurep 'xemacs) + 'mswindows-shell-execute + 'w32-shell-execute) + "open" 'file))) "Default file applications on a Windows NT system. The system \"open\" is used for most files. See `org-file-apps'.") @@ -946,18 +1053,25 @@ ("ltx" . emacs) ("org" . emacs) ("el" . emacs) + ("bib" . emacs) ) "External applications for opening `file:path' items in a document. Org-mode uses system defaults for different file types, but you can use this variable to set the application for a given file -extension. The entries in this list are cons cells with a file extension -and the corresponding command. Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. +extension. The entries in this list are cons cells where the car identifies +files and the cdr the corresponding command. Possible values for the +file identifier are + \"ext\" A string identifying an extension + `directory' Matches a directory + t Default for all remaining files + +Possible values for the command are: + `emacs' The file will be visited by the current Emacs process. + `default' Use the default application for this file type. + string A command to be executed by a shell; %s will be replaced + by the path to the file. + sexp A Lisp form which will be evaluated. The file path will + be available in the Lisp variable `file'. For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -1085,7 +1199,12 @@ (defcustom org-log-done nil "When set, insert a (non-active) time stamp when TODO entry is marked DONE. When the state of an entry is changed from nothing to TODO, remove a previous -closing date." +closing date. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: logging + #+STARTUP: nologging" :group 'org-todo :type 'boolean) @@ -1110,6 +1229,14 @@ :tag "Org Time" :group 'org) +(defcustom org-insert-labeled-timestamps-at-point nil + "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. +When nil, these labeled time stamps are forces into the second line of an +entry, just after the headline. When scheduling from the global TODO list, +the time stamp will always be forced into the second line." + :group 'org-time + :type 'boolean) + (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") "Formats for `format-time-string' which are used for time stamps. It is not recommended to change this constant.") @@ -1149,6 +1276,32 @@ :tag "Org Tags" :group 'org) +(defcustom org-tag-alist nil + "List of tags allowed in Org-mode files. +When this list is nil, Org-mode will base TAG input on what is already in the +buffer. +The value of this variable is an alist, the car may be (and should) be a +character that is used to select that tag through the fast-tag-selection +interface. See the manual for details." + :group 'org-tags + :type '(repeat + (cons (character) (string :tag "Tag")))) + +(defcustom org-use-fast-tag-selection 'auto + "Non-nil means, use fast tag selection scheme. +This is a special interface to select and deselect tags with single keys. +When nil, fast selection is never used. +When the symbol `auto', fast selection is used if and only if selection +characters for tags have been configured, either through the variable +`org-tag-alist' or through a #+TAGS line in the buffer. +When t, fast selection is always used and selection keys are assigned +automatically if necessary." + :group 'org-tags + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When selection characters are configured" 'auto))) + (defcustom org-tags-column 48 "The column to which tags should be indented in a headline. If this number is positive, it specifies the column. If it is negative, @@ -1234,6 +1387,7 @@ type The command type, any of the following symbols: todo Entries with a specific TODO keyword, in all agenda files. tags Tags match in all agenda files. + tags-todo Tags match in all agenda files, TODO entries only. todo-tree Sparse tree of specific TODO keyword in *current* file. tags-tree Sparse tree with all tags matches in *current* file. occur-tree Occur sparse tree for current file. @@ -1246,13 +1400,31 @@ (list (string :tag "Key") (choice :tag "Type" (const :tag "Tags search in all agenda files" tags) + (const :tag "Tags search of TODO entries, all agenda files" tags-todo) (const :tag "TODO keyword search in all agenda files" todo) (const :tag "Tags sparse tree in current buffer" tags-tree) (const :tag "TODO keyword tree in current buffer" todo-tree) (const :tag "Occur tree in current buffer" occur-tree)) (string :tag "Match")))) -(defcustom org-agenda-include-all-todo t +;; FIXME: Need a toggle for this variable, maybe a mode in the agenda buffer? +(defcustom org-agenda-todo-list-sublevels t + "Non-nil means, check also the sublevels of a TODO entry for TODO entries. +When nil, the sublevels of a TODO entry are not checked, resulting in +potentially much shorter TODO lists." + :group 'org-agenda + :group 'org-todo + :type 'boolean) + +(defcustom org-agenda-todo-ignore-scheduled nil + "Non-nil means, don't show scheduled entries in the global todo list. +The idea behind this is that by scheduling it, you have already taken care +of this item." + :group 'org-agenda + :group 'org-todo + :type 'boolean) + +(defcustom org-agenda-include-all-todo nil "Non-nil means, the agenda will always contain all TODO entries. When nil, date-less entries will only be shown if `org-agenda' is called with a prefix argument. @@ -1274,7 +1446,7 @@ :group 'org-agenda :type 'sexp) -(defgroup org-agenda-window-setup nil +(defgroup org-agenda-setup nil "Options concerning setting up the Agenda window in Org Mode." :tag "Org Agenda Window Setup" :group 'org-agenda) @@ -1286,6 +1458,11 @@ :group 'org-agenda-setup :type 'boolean) +(defcustom org-agenda-start-with-follow-mode nil + "The initial value of follwo-mode in a newly created agenda window." + :group 'org-agenda-setup + :type 'boolean) + (defcustom org-select-timeline-window t "Non-nil means, after creating a timeline, move cursor into Timeline window. When nil, cursor will remain in the current window." @@ -1482,7 +1659,7 @@ Depending on which command was used last, this may be the compiled version of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") -;; FIXME: There seem to be situations where this does no work. +;; FIXME: There seem to be situations where this does not work. (defcustom org-agenda-remove-times-when-in-prefix t "Non-nil means, remove duplicate time specifications in agenda items. When the format `org-agenda-prefix-format' contains a `%t' specifier, a @@ -1520,6 +1697,23 @@ :tag "Org Export General" :group 'org-export) +(defcustom org-export-publishing-directory "." + "Path to the location where exported files should be located. +This path may be relative to the directory where the Org-mode file lives. +The default is to put them into the same directory as the Org-mode file. +The variable may also be an alist with export types `:html', `:ascii', +`:ical', or `:xoxo' and the corresponding directories. If a direcoty path +is relative, it is interpreted relative to the directory where the exported +Org-mode files lives." + :group 'org-export-general + :type '(choice + (directory) + (repeat + (cons + (choice :tag "Type" + (const :html) (const :ascii) (const :ical) (const :xoxo)) + (directory))))) + (defcustom org-export-language-setup '(("en" "Author" "Date" "Table of Contents") ("da" "Ophavsmand" "Dato" "Indhold") @@ -1591,6 +1785,21 @@ :group 'org-export-general :type 'boolean) +(defcustom org-export-with-timestamps t + "Nil means, do not export time stamps and associated keywords." + :group 'org-export + :type 'boolean) + +(defcustom org-export-with-tags t + "Nil means, do not export tags, just remove them from headlines." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-timestamps t + "Nil means, do not export timestamps and associated keywords." + :group 'org-export-general + :type 'boolean) + (defgroup org-export-translation nil "Options for translating special ascii sequences for the export backends." :tag "Org Export Translation" @@ -1725,7 +1934,8 @@ :tag "Org Export XML" :group 'org-export) -(defcustom org-export-xml-type 'xoxo ;kw, if we have only one. +;; FIXME: I am told XOXO is not XML, it is semantic-only HTML. +(defcustom org-export-xml-type 'xoxo "The kind of XML to be produced by the XML exporter. Allowed values are: xoxo The XOXO exporter." @@ -1745,8 +1955,11 @@ font-size: 12pt; } .title { text-align: center; } - .todo, .deadline { color: red; } + .todo { color: red; } .done { color: green; } + .timestamp { color: grey } + .timestamp-kwd { color: CadetBlue } + .tag { background-color:lightblue; font-weight:normal } .target { background-color: lavender; } pre { border: 1pt solid #AEBDCC; @@ -1796,13 +2009,16 @@ :group 'org-export-html :type 'boolean) -(defcustom org-export-html-inline-images t +(defcustom org-export-html-inline-images 'maybe "Non-nil means, inline images into exported HTML pages. -The link will still be to the original location of the image file. -So if you are moving the page, lets say to your public HTML site, -you will have to move the image and maybe change the link." +This is done using an <img> tag. When nil, an anchor with href is used to +link to the image. If this option is `maybe', then images in links with +an empty description will be inlined, while images with a description will +be linked only." :group 'org-export-html - :type 'boolean) + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When there is no description" maybe))) (defcustom org-export-html-expand t "Non-nil means, for HTML export, treat @<...> as HTML tag. @@ -1847,7 +2063,8 @@ (defcustom org-combined-agenda-icalendar-file "~/org.ics" "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]." +This file is created with the command \\[org-export-icalendar-all-agenda-files]. +The file name should be absolute." :group 'org-export-icalendar :type 'file) @@ -2003,7 +2220,7 @@ (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg? + (((class color) (min-colors 8)) (:foreground "blue")))) "Face used for level 7 headlines." :group 'org-faces) @@ -2124,7 +2341,7 @@ (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off??? + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) "Face used for time grids." :group 'org-faces) @@ -2193,21 +2410,46 @@ (defvar org-scheduled-time-regexp nil "Matches the SCHEDULED keyword together with a time stamp.") (make-variable-buffer-local 'org-scheduled-time-regexp) +(defvar org-closed-time-regexp nil + "Matches the CLOSED keyword together with a time stamp.") +(make-variable-buffer-local 'org-closed-time-regexp) + +(defvar org-keyword-time-regexp nil + "Matches any of the 3 keywords, together with the time stamp.") +(make-variable-buffer-local 'org-keyword-time-regexp) +(defvar org-maybe-keyword-time-regexp nil + "Matches a timestamp, possibly preceeded by a keyword.") +(make-variable-buffer-local 'org-keyword-time-regexp) + +(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t + mouse-map t) + "Properties to remove when a string without properties is wanted.") + +(defsubst org-match-string-no-properties (num &optional string) + (if (featurep 'xemacs) + (let ((s (match-string num string))) + (remove-text-properties 0 (length s) org-rm-props s) + s) + (match-string-no-properties num string))) + +(defsubst org-no-properties (s) + (remove-text-properties 0 (length s) org-rm-props s) + s) (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." (when (eq major-mode 'org-mode) (let ((re (org-make-options-regexp '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" - "STARTUP" "ARCHIVE"))) + "STARTUP" "ARCHIVE" "TAGS"))) (splitre "[ \t]+") - kwds int key value cat arch) + kwds int key value cat arch tags) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward re nil t) - (setq key (match-string 1) value (match-string 2)) + (setq key (match-string 1) value (org-match-string-no-properties 2)) (cond ((equal key "CATEGORY") (if (string-match "[ \t]+$" value) @@ -2222,6 +2464,8 @@ ((equal key "TYP_TODO") (setq int 'type kwds (append kwds (org-split-string value splitre)))) + ((equal key "TAGS") + (setq tags (append tags (org-split-string value splitre)))) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) (set '(("fold" org-startup-folded t) @@ -2235,6 +2479,8 @@ ("oddeven" org-odd-levels-only nil) ("align" org-startup-align-all-tables t) ("noalign" org-startup-align-all-tables nil) + ("logging" org-log-done t) + ("nologging" org-log-done nil) ("dlcheck" org-startup-with-deadline-check t) ("nodlcheck" org-startup-with-deadline-check nil))) l var val) @@ -2250,7 +2496,20 @@ (and cat (set (make-local-variable 'org-category) cat)) (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) (and arch (set (make-local-variable 'org-archive-location) arch)) - (and int (set (make-local-variable 'org-todo-interpretation) int))) + (and int (set (make-local-variable 'org-todo-interpretation) int)) + (when tags + (let (e tg c tgs) + (while (setq e (pop tags)) + (if (string-match "^\\([0-9a-zA-Z_@]+\\)(\\(.\\))$" e) + (push (cons (match-string 1 e) + (string-to-char (match-string 2 e))) + tgs) + (push (list e) tgs))) + (set (make-local-variable 'org-tag-alist) nil) + (while (setq e (pop tgs)) + (or (assoc (car e) org-tag-alist) + (push e org-tag-alist)))))) + ;; Compute the regular expressions and other local variables (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) org-todo-kwd-max-priority (1- (length org-todo-keywords)) @@ -2282,7 +2541,20 @@ org-scheduled-regexp (concat "\\<" org-scheduled-string) org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) + (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + org-closed-time-regexp + (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") + org-keyword-time-regexp + (concat "\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string "\\)" + " *[[<]\\([^]>]+\\)[]>]") ;; FIXME: is this correct? + org-maybe-keyword-time-regexp + (concat "\\(\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string "\\)\\)?" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)")) ;; FIXME: is this correct? + (org-set-font-lock-defaults))) ;; Tell the compiler about dynamically scoped variables, @@ -2298,14 +2570,9 @@ (defvar mark-active) ; Emacs only, not available in XEmacs. (defvar timecnt) ; dynamically scoped parameter (defvar levels-open) ; dynamically scoped parameter -(defvar title) ; dynamically scoped parameter -(defvar author) ; dynamically scoped parameter -(defvar email) ; dynamically scoped parameter -(defvar text) ; dynamically scoped parameter (defvar entry) ; dynamically scoped parameter (defvar date) ; dynamically scoped parameter -(defvar language) ; dynamically scoped parameter -(defvar options) ; dynamically scoped parameter +(defvar description) ; dynamically scoped parameter (defvar ans1) ; dynamically scoped parameter (defvar ans2) ; dynamically scoped parameter (defvar starting-day) ; local variable @@ -2330,6 +2597,9 @@ (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' (defvar orgtbl-mode) ; defined later in this file +(defvar Info-current-file) ; from info.el +(defvar Info-current-node) ; from info.el + ;;; Define the mode (defvar org-mode-map @@ -2372,11 +2642,31 @@ The following commands are available: \\{org-mode-map}" + + ;; Get rid of Outline menus, they are not needed + ;; Need to do this here because define-derived-mode sets up + ;; the keymap so late. + (if (featurep 'xemacs) + (if org-noutline-p + (progn + (easy-menu-remove outline-mode-menu-heading) + (easy-menu-remove outline-mode-menu-show) + (easy-menu-remove outline-mode-menu-hide)) + (delete-menu-item '("Headings")) + (delete-menu-item '("Show")) + (delete-menu-item '("Hide")) + (set-menubar-dirty-flag)) + (define-key org-mode-map [menu-bar headings] 'undefined) + (define-key org-mode-map [menu-bar hide] 'undefined) + (define-key org-mode-map [menu-bar show] 'undefined)) + (easy-menu-add org-org-menu) (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) (org-add-to-invisibility-spec '(org-cwidth)) + (when (featurep 'xemacs) + (set (make-local-variable 'line-move-ignore-invisible) t)) (setq outline-regexp "\\*+") ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") (setq outline-level 'org-outline-level) @@ -2405,19 +2695,6 @@ (= (point-min) (point-max))) (insert " -*- mode: org -*-\n\n")) - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. - (if (featurep 'xemacs) - (progn - (delete-menu-item '("Headings")) - (delete-menu-item '("Show")) - (delete-menu-item '("Hide")) - (set-menubar-dirty-flag)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - (unless org-inhibit-startup (if org-startup-align-all-tables (org-table-map-tables 'org-table-align)) @@ -2430,24 +2707,13 @@ (let ((this-command 'org-cycle) (last-command 'org-cycle)) (org-cycle '(4)) (org-cycle '(4)))))))) +(defsubst org-call-with-arg (command arg) + "Call COMMAND interactively, but pretend prefix are was ARG." + (let ((current-prefix-arg arg)) (call-interactively command))) + (defsubst org-current-line (&optional pos) (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - mouse-map t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> org-time-stamp-rounding-minutes 0) @@ -2488,7 +2754,7 @@ (defconst org-non-link-chars "]\t\n\r<>") (defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell")) + "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (defconst org-link-re-with-space (concat "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" @@ -2719,11 +2985,13 @@ (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords + ;; Headlines (list '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table)) + ;; Links (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) @@ -2733,27 +3001,34 @@ (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if org-table-limit-column-width '(org-hide-wide-columns (0 nil append))) + ;; TODO lines (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-todo t)) + ;; Priorities (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) + ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) -; (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) -; (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend)) -; (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend)) + ;; Emphasis (if em (list org-bold-re 2 ''bold 'prepend)) (if em (list org-italic-re 2 ''italic 'prepend)) (if em (list org-underline-re 2 ''underline 'prepend)) + ;; Checkboxes, similar to Frank Ruell's org-checklet.el + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + 2 'bold prepend) + ;; COMMENT (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) + ;; DONE (if org-fontify-done-headline (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") '(1 'org-done t) '(2 'org-headline-done t)) (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") '(1 'org-done t))) + ;; Table stuff '("^[ \t]*\\(:.*\\)" (1 'org-table t)) '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) @@ -2795,7 +3070,11 @@ ;;; Visibility cycling (defvar org-cycle-global-status nil) +(make-variable-buffer-local 'org-cycle-global-status) (defvar org-cycle-subtree-status nil) +(make-variable-buffer-local 'org-cycle-subtree-status) + +;;;###autoload (defun org-cycle (&optional arg) "Visibility cycling for Org-mode. @@ -2825,15 +3104,17 @@ no headline in line 1, this function will act as if called with prefix arg." (interactive "P") - (if (or (and (bobp) (not (looking-at outline-regexp))) - (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - - (let ((outline-regexp - (if org-cycle-include-plain-lists - "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " - outline-regexp))) + (let* ((outline-regexp + (if org-cycle-include-plain-lists + "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " + outline-regexp)) + (bob-special (and org-cycle-global-at-bob (bobp) + (not (looking-at outline-regexp)))) + (org-cycle-hook (if bob-special nil org-cycle-hook))) + + (if (or bob-special (equal arg '(4))) + ;; special case: use global cycling + (setq arg t)) (cond @@ -2843,7 +3124,7 @@ (progn (if arg (org-table-edit-field t) (org-table-justify-field-maybe) - (org-table-next-field))))) + (call-interactively 'org-table-next-field))))) ((eq arg t) ;; Global cycling @@ -2853,18 +3134,8 @@ ;; We just created the overview - now do table of contents ;; This can be slow in very large buffers, so indicate action (message "CONTENTS...") - (save-excursion - ;; Visit all headings and show their offspring - (goto-char (point-max)) - (catch 'exit - (while (and (progn (condition-case nil - (outline-previous-visible-heading 1) - (error (goto-char (point-min)))) - t) - (looking-at outline-regexp)) - (show-branches) - (if (bobp) (throw 'exit nil)))) - (message "CONTENTS...done")) + (org-content) + (message "CONTENTS...done") (setq org-cycle-global-status 'contents) (run-hook-with-args 'org-cycle-hook 'contents)) @@ -2878,7 +3149,7 @@ (t ;; Default action: go to overview - (hide-sublevels 1) + (org-overview) (message "OVERVIEW") (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview)))) @@ -2908,10 +3179,10 @@ (outline-next-heading)) ;; Find out what to do next and set `this-command' (cond - ((= eos eoh) + ((and (= eos eoh) ;; Nothing is hidden behind this heading (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil)) + (setq org-cycle-subtree-status nil))) ((>= eol eos) ;; Entire subtree is hidden in one line: open it (org-show-entry) @@ -2951,6 +3222,44 @@ (org-back-to-heading) (org-cycle)))))) +;;;###autoload +(defun org-global-cycle () + "Cycle the global visibility. For details see `org-cycle'." + (interactive) + (org-cycle '(4))) + +(defun org-overview () + "Switch to overview mode, shoing only top-level headlines. +Really, this shows all headlines with level equal or greater than the level +of the first headline in the buffer. This is important, because if the +first headline is not level one, then (hide-sublevels 1) gives confusing +results." + (interactive) + (hide-sublevels (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" outline-regexp) nil t) + (progn + (goto-char (match-beginning 0)) + (funcall outline-level)) + 1)))) + +;; FIXME: allow an argument to give a limiting level for this. +(defun org-content () + "Show all headlines in the buffer, like a table of contents" + (interactive) + (save-excursion + ;; Visit all headings and show their offspring + (goto-char (point-max)) + (catch 'exit + (while (and (progn (condition-case nil + (outline-previous-visible-heading 1) + (error (goto-char (point-min)))) + t) + (looking-at outline-regexp)) + (show-branches) + (if (bobp) (throw 'exit nil)))))) + + (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. This function is the default value of the hook `org-cycle-hook'." @@ -3071,7 +3380,6 @@ (kill-buffer "*org-goto*") org-selected-point)) -;; FIXME: It may not be a good idea to temper with the prefix argument... (defun org-goto-ret (&optional arg) "Finish `org-goto' by going to the new location." (interactive "P") @@ -3114,26 +3422,36 @@ "To temporarily disable the active region.") (defun org-insert-heading (&optional force-heading) - "Insert a new heading or item with same depth at point." + "Insert a new heading or item with same depth at point. +If point is in a plain list and FORCE-HEADING is nil, create a new list item. +If point is at the beginning of a headline, insert a sibling before the +current headline. If point is in the middle of a headline, split the headline +at that position and make the rest of the headline part of the sibling below +the current headline." (interactive "P") - (when (or force-heading (not (org-insert-item))) - (let* ((head (save-excursion - (condition-case nil - (org-back-to-heading) - (error (outline-next-heading))) - (prog1 (match-string 0) - (funcall outline-level))))) - (cond - ((and (org-on-heading-p) (bolp) - (save-excursion (backward-char 1) (not (org-invisible-p)))) - (open-line 1)) - ((bolp) nil) - (t (newline))) - (insert head) - (just-one-space) - (run-hooks 'org-insert-heading-hook)))) - -(defun org-insert-item () + (if (= (buffer-size) 0) + (insert "\n* ") + (when (or force-heading (not (org-insert-item))) + (let* ((head (save-excursion + (condition-case nil + (progn + (org-back-to-heading) + (match-string 0)) + (error "*")))) + pos) + (cond + ((and (org-on-heading-p) (bolp) + (save-excursion (backward-char 1) (not (org-invisible-p)))) + (open-line 1)) + ((bolp) nil) + (t (newline))) + (insert head) (just-one-space) + (setq pos (point)) + (end-of-line 1) + (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) + (run-hooks 'org-insert-heading-hook))))) + +(defun org-insert-item (&optional checkbox) "Insert a new item at the current level. Return t when things worked, nil when we are not in an item." (when (save-excursion @@ -3144,9 +3462,11 @@ t) (error nil))) (let* ((bul (match-string 0)) + (end (match-end 0)) (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") (match-end 0))) - (eowcol (save-excursion (goto-char eow) (current-column)))) + (eowcol (save-excursion (goto-char eow) (current-column))) + pos) (cond ((and (org-at-item-p) (<= (point) eow)) ;; before the bullet @@ -3155,8 +3475,11 @@ ((<= (point) eow) (beginning-of-line 1)) (t (newline))) - (insert bul) - (just-one-space)) + (insert bul (if checkbox "[ ]" "")) + (just-one-space) + (setq pos (point)) + (end-of-line 1) + (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) (org-maybe-renumber-ordered-list) t)) @@ -3165,16 +3488,19 @@ If the heading has no TODO state, or if the state is DONE, use the first state (TODO by default). Also with prefix arg, force first state." (interactive "P") - (org-insert-heading) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (equal (match-string 2) org-done-string)) - (insert (car org-todo-keywords) " ") - (insert (match-string 2) " "))) + (when (not (org-insert-item 'checkbox)) + (org-insert-heading) + (save-excursion + (org-back-to-heading) + (if org-noutline-p + (outline-previous-heading) + (outline-previous-visible-heading t)) + (looking-at org-todo-line-regexp)) + (if (or arg + (not (match-beginning 2)) + (equal (match-string 2) org-done-string)) + (insert (car org-todo-keywords) " ") + (insert (match-string 2) " ")))) (defun org-promote-subtree () "Promote the entire subtree. @@ -3510,6 +3836,21 @@ ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) +(defun org-at-item-checkbox-p () + "Is point at a line starting a plain-list item with a checklet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (looking-at "\\[[ X]\\]")))) + +(defun org-toggle-checkbox () + "Toggle the checkbox in the current line." + (interactive) + (save-excursion + (if (org-at-item-checkbox-p) + (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t)))) + (defun org-get-indentation () "Get the indentation of the current line, interpreting tabs." (save-excursion @@ -3520,6 +3861,7 @@ (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. If the cursor is not in an item, throw an error." + (interactive) (let ((pos (point)) (limit (save-excursion (org-back-to-heading) (beginning-of-line 2) (point))) @@ -3545,6 +3887,7 @@ (defun org-end-of-item () "Go to the end of the current hand-formatted item. If the cursor is not in an item, throw an error." + (interactive) (let ((pos (point)) (limit (save-excursion (outline-next-heading) (point))) (ind (save-excursion @@ -3564,11 +3907,47 @@ (goto-char pos) (error "Not in an item")))) -(defun org-move-item-down (arg) +(defun org-next-item () + "Move to the beginning of the next item in the current plain list. +Error if not at a plain list, or if this is the last item in the list." + (interactive) + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (org-end-of-item) + (setq end (point)) + (setq ind1 (org-get-indentation)) + (unless (and (org-at-item-p) (= ind ind1)) + (goto-char pos) + (error "This is already the last item in the list")))) + +(defun org-previous-item () + "Move to the beginning of the previous item in the current plain list. +Error if not at a plain list, or if this is the last item in the list." + (interactive) + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (goto-char beg) + (catch 'exit + (while t + (beginning-of-line 0) + (if (looking-at "[ \t]*$") + nil + (if (<= (setq ind1 (org-get-indentation)) ind) + (throw 'exit t))))) + (condition-case nil + (org-beginning-of-item) + (error (goto-char pos) + (error "This is already the first item in the list"))))) + +(defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." - (interactive "p") + (interactive) (let (beg end ind ind1 (pos (point)) txt) (org-beginning-of-item) (setq beg (point)) @@ -3647,7 +4026,7 @@ (defun org-renumber-ordered-list (arg) "Renumber an ordered plain list. -Cursor next to be in the first line of an item, the line that starts +Cursor needs to be in the first line of an item, the line that starts with something like \"1.\" or \"2)\"." (interactive "p") (unless (and (org-at-item-p) @@ -3702,24 +4081,24 @@ (interactive "p") (unless (org-at-item-p) (error "Not on an item")) - (let (beg end ind ind1) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (save-excursion + (let (beg end ind ind1) + (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) (setq beg org-last-indent-begin-marker end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (point)))) - (goto-char beg) - (skip-chars-forward " \t") (setq ind (current-column)) - (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (indent-to-column (+ ind1 arg)) - (beginning-of-line 2)) - (goto-char beg))) + (org-beginning-of-item) + (setq beg (move-marker org-last-indent-begin-marker (point))) + (org-end-of-item) + (setq end (move-marker org-last-indent-end-marker (point)))) + (goto-char beg) + (skip-chars-forward " \t") (setq ind (current-column)) + (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) + (while (< (point) end) + (beginning-of-line 1) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (delete-region (point-at-bol) (point)) + (indent-to-column (+ ind1 arg)) + (beginning-of-line 2))))) ;;; Archiving @@ -3816,7 +4195,7 @@ ;; Here we are back in the original buffer. Everything seems to have ;; worked. So now cut the tree and finish up. (let (this-command) (org-cut-subtree)) - (if (looking-at "[ \t]*$") (kill-line)) + (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) @@ -3880,7 +4259,7 @@ tbl))) tbl) (tag (setq type :tag beg beg1) - (org-get-buffer-tags)) + (or org-tag-alist (org-get-buffer-tags))) (t (progn (ispell-complete-word arg) (throw 'exit nil))))) (pattern (buffer-substring-no-properties beg end)) (completion (try-completion pattern table))) @@ -3960,44 +4339,44 @@ (member (member this org-todo-keywords)) (tail (cdr member)) (state (cond - ((equal arg '(4)) - ;; Read a state with completion - (completing-read "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords))) - ((eq arg 'left) - (if (equal member org-todo-keywords) - nil - (if this - (nth (- (length org-todo-keywords) (length tail) 2) - org-todo-keywords) - org-done-string))) - (arg - ;; user requests a specific state - (nth (1- (prefix-numeric-value arg)) - org-todo-keywords)) - ((null member) (car org-todo-keywords)) - ((null tail) nil) ;; -> first entry - ((eq org-todo-interpretation 'sequence) - (car tail)) - ((memq org-todo-interpretation '(type priority)) - (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) org-done-string nil))) - (t nil))) + ((equal arg '(4)) + ;; Read a state with completion + (completing-read "State: " (mapcar (lambda(x) (list x)) + org-todo-keywords) + nil t)) + ((eq arg 'right) + (if this + (if tail (car tail) nil) + (car org-todo-keywords))) + ((eq arg 'left) + (if (equal member org-todo-keywords) + nil + (if this + (nth (- (length org-todo-keywords) (length tail) 2) + org-todo-keywords) + org-done-string))) + (arg + ;; user requests a specific state + (nth (1- (prefix-numeric-value arg)) + org-todo-keywords)) + ((null member) (car org-todo-keywords)) + ((null tail) nil) ;; -> first entry + ((eq org-todo-interpretation 'sequence) + (car tail)) + ((memq org-todo-interpretation '(type priority)) + (if (eq this-command last-command) + (car tail) + (if (> (length tail) 0) org-done-string nil))) + (t nil))) (next (if state (concat " " state " ") " "))) (replace-match next t t) (setq org-last-todo-state-is-todo (not (equal state org-done-string))) (when org-log-done (if (equal state org-done-string) - (org-log-done) + (org-add-planning-info 'closed (current-time) 'scheduled) (if (not this) - (org-log-done t)))) + (org-add-planning-info nil nil 'closed)))) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) (run-hooks 'org-after-todo-state-change-hook))) @@ -4067,25 +4446,79 @@ A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] to modify it to the correct date." (interactive) - (insert - org-deadline-string " " - (format-time-string (car org-time-stamp-formats) - (org-read-date nil 'to-time))) - (message "%s" (substitute-command-keys - "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) + (org-add-planning-info 'deadline nil 'closed)) (defun org-schedule () "Insert the SCHEDULED: string to schedule a TODO item. A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] to modify it to the correct date." (interactive) - (insert - org-scheduled-string " " - (format-time-string (car org-time-stamp-formats) - (org-read-date nil 'to-time))) - (message "%s" (substitute-command-keys - "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) - + (org-add-planning-info 'scheduled nil 'closed)) + +(defun org-add-planning-info (what &optional time &rest remove) + "Insert new timestamp with keyword in the line directly after the headline. +WHAT indicates what kind of time stamp to add. TIME indicated the time to use. +If non is given, the user is prompted for a date. +REMOVE indicates what kind of entries to remove. An old WHAT entry will also +be removed." + (interactive) + (when what (setq time (or time (org-read-date nil 'to-time)))) + (when (and org-insert-labeled-timestamps-at-point + (member what '(scheduled deadline))) + (insert + (if (eq what 'scheduled) org-scheduled-string org-deadline-string) + " " + (format-time-string (car org-time-stamp-formats) time)) + (setq what nil)) + (save-excursion + (let (beg end col list elt (buffer-invisibility-spec nil) ts) + (org-back-to-heading t) + (setq beg (point)) + (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) + (goto-char (match-end 1)) + (setq col (current-column)) + (goto-char (1+ (match-end 0))) + (if (and (not (looking-at outline-regexp)) + (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp + "[^\r\n]*"))) + (narrow-to-region (match-beginning 0) (match-end 0)) + (insert "\n") + (backward-char 1) + (narrow-to-region (point) (point)) + (indent-to-column col)) + ;; Check if we have to remove something. + (setq list (cons what remove)) + (while list + (setq elt (pop list)) + (goto-char (point-min)) + (when (or (and (eq elt 'scheduled) + (re-search-forward org-scheduled-time-regexp nil t)) + (and (eq elt 'deadline) + (re-search-forward org-deadline-time-regexp nil t)) + (and (eq elt 'closed) + (re-search-forward org-closed-time-regexp nil t))) + (replace-match "") + (if (looking-at " +") (replace-match "")))) + (goto-char (point-max)) + (when what + (insert + (if (not (equal (char-before) ?\ )) " " "") + (cond ((eq what 'scheduled) org-scheduled-string) + ((eq what 'deadline) org-deadline-string) + ((eq what 'closed) org-closed-string)) + " ") + (insert + (setq ts + (format-time-string + (if (eq what 'closed) + (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") + (car org-time-stamp-formats)) + time)))) + (goto-char (point-min)) + (widen) + (if (looking-at "[ \t]+\r?\n") + (replace-match "")) + ts))) (defun org-occur (regexp &optional callback) "Make a compact tree which shows all matches of REGEXP. @@ -4100,7 +4533,7 @@ (let ((cnt 0)) (save-excursion (goto-char (point-min)) - (hide-sublevels 1) + (org-overview) (while (re-search-forward regexp nil t) (when (or (not callback) (save-match-data (funcall callback))) @@ -4348,8 +4781,8 @@ (parse-time-string (match-string 1)))) ct)) (calendar-move-hook nil) + (view-diary-entries-initially nil) (view-calendar-holidays-initially nil) - (view-diary-entries-initially nil) (timestr (format-time-string (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) (prompt (format "YYYY-MM-DD [%s]: " timestr)) @@ -4761,7 +5194,6 @@ (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) -;;;###autoload (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -4778,7 +5210,7 @@ (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) (unless org-agenda-keep-modes - (setq org-agenda-follow-mode nil + (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-show-log nil)) (easy-menu-change '("Agenda") "Agenda Files" @@ -4815,6 +5247,8 @@ (define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) +(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) +(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) (let ((l '(1 2 3 4 5 6 7 8 9 0))) (while l (define-key org-agenda-mode-map (int-to-string (pop l)) 'digit-argument))) @@ -4878,10 +5312,12 @@ ("Tags" ["Show all Tags" org-agenda-show-tags t] ["Set Tags" org-agenda-set-tags t]) - ("Reschedule" + ("Schedule" + ["Schedule" org-agenda-schedule t] + ["Set Deadline" org-agenda-deadline t] + "--" ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] - "--" ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) ("Priority" ["Set Priority" org-agenda-priority t] @@ -4991,18 +5427,16 @@ ((equal c ?C) (customize-variable 'org-agenda-custom-commands)) ((equal c ?a) (call-interactively 'org-agenda-list)) ((equal c ?t) (call-interactively 'org-todo-list)) - ((equal c ?T) - (setq current-prefix-arg (or arg '(4))) - (call-interactively 'org-todo-list)) + ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4)))) ((equal c ?m) (call-interactively 'org-tags-view)) - ((equal c ?M) - (setq current-prefix-arg (or arg '(4))) - (call-interactively 'org-tags-view)) + ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4)))) ((setq entry (assoc (char-to-string c) org-agenda-custom-commands)) (setq type (nth 1 entry) string (nth 2 entry)) (cond ((eq type 'tags) (org-tags-view current-prefix-arg string)) + ((eq type 'tags-todo) + (org-tags-view '(4) string)) ((eq type 'todo) (org-todo-list string)) ((eq type 'tags-tree) @@ -5432,7 +5866,7 @@ (if (memq org-agenda-type types) t (if error - (error "Now allowed in %s-type agenda buffers" org-agenda-type) + (error "Not allowed in %s-type agenda buffers" org-agenda-type) nil))) (defun org-agenda-quit () @@ -5977,10 +6411,13 @@ "\\)\\>") org-not-done-regexp) "[^\n\r]*\\)")) + (sched-re (concat ".*\n.*?" org-scheduled-time-regexp)) marker priority category tags ee txt) (goto-char (point-min)) (while (re-search-forward regexp nil t) + (when (not (and org-agenda-todo-ignore-scheduled + (save-match-data (looking-at sched-re)))) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) category (org-get-category) @@ -5997,7 +6434,9 @@ 'org-marker marker 'org-hd-marker marker 'priority priority 'category category) (push txt ee) - (goto-char (match-end 1))) + (if org-agenda-todo-list-sublevels ; FIXME???? Change needed? + (goto-char (match-end 1)) + (org-end-of-subtree 'invisible)))) (nreverse ee))) (defconst org-agenda-no-heading-message @@ -6354,11 +6793,23 @@ (if s1 (setq s1 (org-get-time-of-day s1 'string))) (if s2 (setq s2 (org-get-time-of-day s2 'string)))) - (when (and (or (eq org-agenda-remove-tags-when-in-prefix t) - (and org-agenda-remove-tags-when-in-prefix - org-prefix-has-tag)) - (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt)) - (setq txt (replace-match "" t t txt))) +; (when (and (or (eq org-agenda-remove-tags-when-in-prefix t) +; (and org-agenda-remove-tags-when-in-prefix +; org-prefix-has-tag)) +; (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt)) +; (setq txt (replace-match "" t t txt))) + + ;; FIXME!!! + (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags-when-in-prefix t) + (and org-agenda-remove-tags-when-in-prefix + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) ;; Create the final string (if noprefix @@ -6537,7 +6988,8 @@ (interactive) (let* ((tags (get-text-property (point-at-bol) 'tags))) (if tags - (message "Tags are :%s:" (mapconcat 'identity tags ":")) + (message "Tags are :%s:" + (org-no-properties (mapconcat 'identity tags ":"))) (message "No tags associated with this line")))) (defun org-agenda-goto (&optional highlight) @@ -6723,7 +7175,7 @@ (beginning-of-line 1))) (defun org-get-tags-at (&optional pos) - "Get a list of all headline targs applicable at POS. + "Get a list of all headline tags applicable at POS. POS defaults to point. If tags are inherited, the list contains the targets in the same sequence as the headlines appear, i.e. the tags of the current headline come last." @@ -6736,7 +7188,9 @@ (condition-case nil (while t (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") - (setq tags (append (org-split-string (match-string 1) ":") tags))) + (setq tags (append (org-split-string + (org-match-string-no-properties 1) ":") + tags))) (or org-use-tag-inheritance (error "")) (org-up-heading-all 1)) (error nil)))) @@ -6808,6 +7262,40 @@ (org-time-stamp arg) (message "Time stamp changed to %s" org-last-changed-timestamp)))) +(defun org-agenda-schedule (arg) + "Schedule the item at point." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) + (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)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-schedule)) + (message "Item scheduled for %s" ts)))) + +(defun org-agenda-deadline (arg) + "Schedule the item at point." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) + (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)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-deadline)) + (message "Deadline for this item set to %s" ts)))) + (defun org-get-heading () "Return the heading of the current entry, without the stars." (save-excursion @@ -6980,7 +7468,7 @@ (save-excursion (goto-char (point-min)) - (when (eq action 'sparse-tree) (hide-sublevels 1)) + (when (eq action 'sparse-tree) (org-overview)) (while (re-search-forward re nil t) (setq todo (if (match-end 1) (match-string 2)) tags (if (match-end 4) (match-string 4))) @@ -7139,11 +7627,11 @@ (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." - (interactive) - (let* (;(inherit (org-get-inherited-tags)) - (re (concat "^" outline-regexp)) + (interactive "P") + (let* ((re (concat "^" outline-regexp)) (col (current-column)) (current (org-get-tags)) + table current-tags inherited-tags ; computed below when needed tags hd empty invis) (if arg (save-excursion @@ -7153,15 +7641,22 @@ (message "All tags realigned to column %d" org-tags-column)) (if just-align (setq tags current) - (setq org-last-tags-completion-table - (or (org-get-buffer-tags) - org-last-tags-completion-table)) - (setq tags - (let ((org-add-colon-after-tag-completion t)) - (completing-read "Tags: " 'org-tags-completion-function - nil nil current 'org-tags-history))) + (setq table (or org-tag-alist (org-get-buffer-tags)) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection (cdar table))) + (org-fast-tag-selection current-tags inherited-tags table) + (let ((org-add-colon-after-tag-completion t)) + (completing-read "Tags: " 'org-tags-completion-function + nil nil current 'org-tags-history)))) (while (string-match "[-+&]+" tags) (setq tags (replace-match ":" t t tags)))) + ;; FIXME: still optimize this by not checking when JUST-ALIGN? (unless (setq empty (string-match "\\`[\t ]*\\'" tags)) (unless (string-match ":$" tags) (setq tags (concat tags ":"))) @@ -7212,6 +7707,79 @@ (assoc s2 ctable))) )) +(defun org-fast-tag-insert (kwd tags face &optional end) + "Insert KDW, and the TAGS, the latter with face FACE. Also inser END." + (insert (format "%-12s" (concat kwd ":")) + (org-add-props (mapconcat 'identity tags " ") nil 'face face) + (or end ""))) + +(defun org-fast-tag-selection (current inherited table) + "Fast tag selection with single keys. +CURRENT is the current list of tags in the headline, INHERITED is the +list of inherited tags, and TABLE is an alist of tags and corresponding keys. +If the keys are nil, a-z are automatically assigned. +Returns the new tags string, or nil to not change the current settings." + (let* ((maxlen (apply 'max (mapcar (lambda (x) + (string-width (car x))) table))) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (window-width) fwidth)) + (i-face 'org-done) + (c-face 'org-tag) + tg cnt e c char ntable tbl rtn) + (save-window-excursion + (delete-other-windows) + (split-window-vertically) + (switch-to-buffer-other-window (get-buffer-create " *Org tags*")) + (erase-buffer) + (org-fast-tag-insert "Inherited" inherited i-face "\n") + (org-fast-tag-insert "Current" current c-face "\n\n") + (setq tbl table char (1- ?a) cnt 0) + (while (setq e (pop tbl)) + (setq tg (car e) c (or (cdr e) (setq char (1+ char)))) + (setq tg (org-add-props tg nil 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t nil)))) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (push (cons tg c) ntable) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (setq cnt 0))) + (insert "\n") + (goto-char (point-min)) + (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer)) + (setq rtn + (catch 'exit + (while t + (message "[key]:Toggle SPC: clear current RET accept") + (setq c (read-char-exclusive)) + (cond + ((= c ?\r) (throw 'exit t)) + ((= c ?\C-g) (throw 'exit nil)) + ((= c ?\ ) (setq current nil)) + (t (setq e (rassoc c ntable) tg (car e)) + (if (member tg current) + (setq current (delete tg current)) + (setq current (append current (list tg)))))) + (goto-char (point-min)) + (beginning-of-line 2) + (delete-region (point) (point-at-eol)) + (org-fast-tag-insert "Current" current c-face) + (while (re-search-forward "\\[.\\] \\([a-zA-Z0-9_@]+\\)" nil t) + (setq tg (match-string 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t nil))))) + (goto-char (point-min))))) + (if rtn + (mapconcat 'identity current ":") + nil)))) + (defun org-get-tags () "Get the TAGS string in the current headline." (unless (org-on-heading-p) @@ -7234,6 +7802,50 @@ ;;; Link Stuff +(defvar org-create-file-search-functions nil + "List of functions to construct the right search string for a file link. +These functions are called in turn with point at the location to +which the link should point. + +A function in the hook should first test if it would like to +handle this file type, for example by checking the major-mode or +the file extension. If it decides not to handle this file, it +should just return nil to give other functions a chance. If it +does handle the file, it must return the search string to be used +when following the link. The search string will be part of the +file link, given after a double colon, and `org-open-at-point' +will automatically search for it. If special measures must be +taken to make the search successful, another function should be +added to the companion hook `org-execute-file-search-functions', +which see. + +A function in this hook may also use `setq' to set the variable +`description' to provide a suggestion for the descriptive text to +be used for this link when it gets inserted into an Org-mode +buffer with \\[org-insert-link].") + +(defvar org-execute-file-search-functions nil + "List of functions to execute a file search triggered by a link. + +Functions added to this hook must accept a single argument, the +search string that was part of the file link, the part after the +double colon. The function must first check if it would like to +handle this search, for example by checking the major-mode or the +file extension. If it decides not to handle this search, it +should just return nil to give other functions a chance. If it +does handle the search, it must return a non-nil value to keep +other functions from trying. + +Each function can access the current prefix argument through the +variable `current-prefix-argument'. Note that a single prefix is +used to force opening a link in Emacs, so it may be good to only +use a numeric or double prefix to guide the search function. + +In case this is needed, a function in this hook can also restore +the window configuration before `org-open-at-point' was called using: + + (set-window-configuration org-window-config-before-follow-link)") + (defun org-find-file-at-mouse (ev) "Open file link or URL at mouse." (interactive "e") @@ -7246,6 +7858,10 @@ (mouse-set-point ev) (org-open-at-point)) +(defvar org-window-config-before-follow-link nil + "The window configuration before following a link. +This is saved in case the need arises to restore it.") + (defun org-open-at-point (&optional in-emacs) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -7253,6 +7869,7 @@ Normally, files will be opened by an appropriate application. If the optional argument IN-EMACS is non-nil, Emacs will visit the file." (interactive "P") + (setq org-window-config-before-follow-link (current-window-configuration)) (org-remove-occur-highlights nil nil t) (if (org-at-timestamp-p) (org-agenda-list nil (time-to-days (org-time-string-to-time @@ -7337,6 +7954,7 @@ ((string= type "file") (if (string-match "::?\\([0-9]+\\)\\'" path) ;; second : optional + ;; FIXME: It is unsafe to allow a single colon. (setq line (string-to-number (match-string 1 path)) path (substring path 0 (match-beginning 0))) (if (string-match "::\\(.+\\)\\'" path) @@ -7350,6 +7968,9 @@ ((string= type "bbdb") (org-follow-bbdb-link path)) + ((string= type "info") + (org-follow-info-link path)) + ((string= type "gnus") (let (group article) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) @@ -7397,8 +8018,8 @@ (setq cmd (replace-match "<" t t cmd))) (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) - (if (or (not org-confirm-shell-links) - (funcall org-confirm-shell-links + (if (or (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function (format "Execute \"%s\" in shell? " (org-add-props cmd nil 'face 'org-warning)))) @@ -7407,6 +8028,16 @@ (shell-command cmd)) (error "Abort")))) + ((string= type "elisp") + (let ((cmd path)) + (if (or (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd (eval (read cmd))) + (error "Abort")))) + (t (browse-url-at-point)))))) @@ -7423,73 +8054,77 @@ (pos (point)) (pre "") (post "") words re0 re1 re2 re3 re4 re5 re2a reall camel) - (cond ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "<<" (regexp-quote s0) ">>") nil t) - (setq pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos)) - ((string-match "^/\\(.*\\)/$" s) - ;; A regular expression - (cond - ((eq major-mode 'org-mode) - (org-occur (match-string 1 s))) - ;;((eq major-mode 'dired-mode) - ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) - (t (org-do-occur (match-string 1 s))))) - ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) - t) - ;; A camel or a normal search string - (when (equal (string-to-char s) ?*) - ;; Anchor on headlines, post may include tags. - (setq pre "^\\*+[ \t]*\\(\\sw+\\)?[ \t]*" - post "[ \t]*\\([ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" - s (substring s 1))) - (remove-text-properties - 0 (length s) - '(face nil mouse-face nil keymap nil fontified nil) s) - ;; Make a series of regular expressions to find a match - (setq words - (if camel - (org-camel-to-words s) - (org-split-string s "[ \n\r\t]+")) - re0 (concat "<<" (regexp-quote s0) ">>") - re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>") - re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>") - re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>") - re1 (concat pre re2 post) - re3 (concat pre re4 post) - re5 (concat pre ".*" re4) - re2 (concat pre re2) - re2a (concat pre re2a) - re4 (concat pre re4) - reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 - "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)" - )) - (cond - ((eq type 'org-occur) (org-occur reall)) - ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) - (t (goto-char (point-min)) - (if (or (org-search-not-link re0 nil t) - (org-search-not-link re1 nil t) - (org-search-not-link re2 nil t) - (org-search-not-link re2a nil t) - (org-search-not-link re3 nil t) - (org-search-not-link re4 nil t) - (org-search-not-link re5 nil t) - ) - (goto-char (match-beginning 0)) - (goto-char pos) - (error "No match"))))) - (t - ;; Normal string-search - (goto-char (point-min)) - (if (search-forward s nil t) - (goto-char (match-beginning 0)) - (error "No match")))) + (cond + ;; First check if there are any special + ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) + ;; Now try the builtin stuff + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "<<" (regexp-quote s0) ">>") nil t) + (setq pos (match-beginning 0)))) + ;; There is an exact target for this + (goto-char pos)) + ((string-match "^/\\(.*\\)/$" s) + ;; A regular expression + (cond + ((eq major-mode 'org-mode) + (org-occur (match-string 1 s))) + ;;((eq major-mode 'dired-mode) + ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) + (t (org-do-occur (match-string 1 s))))) + ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) + t) + ;; A camel or a normal search string + (when (equal (string-to-char s) ?*) + ;; Anchor on headlines, post may include tags. + (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" + post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" + s (substring s 1))) + (remove-text-properties + 0 (length s) + '(face nil mouse-face nil keymap nil fontified nil) s) + ;; Make a series of regular expressions to find a match + (setq words + (if camel + (org-camel-to-words s) + (org-split-string s "[ \n\r\t]+")) + re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") + re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]") + re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") + re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re1 (concat pre re2 post) + re3 (concat pre re4 post) + re5 (concat pre ".*" re4) + re2 (concat pre re2) + re2a (concat pre re2a) + re4 (concat pre re4) + reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 + "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" + re5 "\\)" + )) + (cond + ((eq type 'org-occur) (org-occur reall)) + ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) + (t (goto-char (point-min)) + (if (or (org-search-not-link re0 nil t) + (org-search-not-link re1 nil t) + (org-search-not-link re2 nil t) + (org-search-not-link re2a nil t) + (org-search-not-link re3 nil t) + (org-search-not-link re4 nil t) + (org-search-not-link re5 nil t) + ) + (goto-char (match-beginning 1)) ;; Fixme: does every re have group 1? + (goto-char pos) + (error "No match"))))) + (t + ;; Normal string-search + (goto-char (point-min)) + (if (search-forward s nil t) + (goto-char (match-beginning 0)) + (error "No match")))) (and (eq major-mode 'org-mode) (org-show-hierarchy-above)))) (defun org-search-not-link (&rest args) @@ -7609,6 +8244,18 @@ (delete-window (get-buffer-window "*BBDB*")) (error "No matching BBDB record"))))) + +(defun org-follow-info-link (name) + "Follow an info file & node link to NAME." + (if (or (string-match "\\(.*\\)::?\\(.*\\)" name) + (string-match "\\(.*\\)" name)) + (progn + (require 'info) + (if (match-string 2 name) ; If there isn't a node, choose "Top" + (Info-find-node (match-string 1 name) (match-string 2 name)) + (Info-find-node (match-string 1 name) "Top"))) + (message (concat "Could not open: " name)))) + (defun org-follow-gnus-link (&optional group article) "Follow a Gnus link to GROUP and ARTICLE." (require 'gnus) @@ -7792,6 +8439,61 @@ (kill-this-buffer) (error "Message not found")))) +;; BibTeX links + +;; Use the custom search meachnism to construct and use search strings for +;; file links to BibTeX database entries. + +(defun org-create-file-search-in-bibtex () + "Create the search string and description for a BibTeX database entry." + (when (eq major-mode 'bibtex-mode) + ;; yes, we want to construct this search string. + ;; Make a good description for this entry, using names, year and the title + ;; Put it into the `description' variable which is dynamically scoped. + (let ((bibtex-autokey-names 1) + (bibtex-autokey-names-stretch 1) + (bibtex-autokey-name-case-convert-function 'identity) + (bibtex-autokey-name-separator " & ") + (bibtex-autokey-additional-names " et al.") + (bibtex-autokey-year-length 4) + (bibtex-autokey-name-year-separator " ") + (bibtex-autokey-titlewords 3) + (bibtex-autokey-titleword-separator " ") + (bibtex-autokey-titleword-case-convert-function 'identity) + (bibtex-autokey-titleword-length 'infty) + (bibtex-autokey-year-title-separator ": ")) + (setq description (bibtex-generate-autokey))) + ;; Now parse the entry, get the key and return it. + (save-excursion + (bibtex-beginning-of-entry) + (cdr (assoc "=key=" (bibtex-parse-entry)))))) + +(defun org-execute-file-search-in-bibtex (s) + "Find the link search string S as a key for a database entry." + (when (eq major-mode 'bibtex-mode) + ;; Yes, we want to do the search in this file. + ;; We construct a regexp that searches for "@entrytype{" followed by the key + (goto-char (point-min)) + (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" + (regexp-quote s) "[ \t\n]*,") nil t) + (goto-char (match-beginning 0))) + (if (and (match-beginning 0) (equal current-prefix-arg '(16))) + ;; Use double prefix to indicate that any web link should be browsed + (let ((b (current-buffer)) (p (point))) + ;; Restore the window configuration because we just use the web link + (set-window-configuration org-window-config-before-follow-link) + (save-excursion (set-buffer b) (goto-char p) + (bibtex-url))) + (recenter 0)) ; Move entry start to beginning of window + ;; return t to indicate that the search is done. + t)) + +;; Finally add the functions to the right hooks. +(add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex) +(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) + +;; end of Bibtex link setup + (defun org-upgrade-old-links (&optional query-description) "Transfer old <...> style links to new [[...]] style links. With arg query-description, ask at each match for a description text to use @@ -7907,7 +8609,7 @@ For links to usenet articles, arg negates `org-usenet-links-prefer-google'. For file links, arg negates `org-context-in-file-links'." (interactive "P") - (let (link cpltxt desc txt (pos (point))) + (let (link cpltxt desc description search txt (pos (point))) (cond ((eq major-mode 'bbdb-mode) @@ -7917,6 +8619,13 @@ (bbdb-record-company (bbdb-current-record)))) link (org-make-link cpltxt))) + ((eq major-mode 'Info-mode) + (setq link (org-make-link "info:" + (file-name-nondirectory Info-current-file) + ":" Info-current-node)) + (setq cpltxt (concat (file-name-nondirectory Info-current-file) + ":" Info-current-node))) + ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) (setq link @@ -8020,6 +8729,12 @@ (setq cpltxt w3m-current-url link (org-make-link cpltxt))) + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) ;; FIXME: is this the best way? + ((eq major-mode 'org-mode) ;; Just link to current headline (setq cpltxt (concat "file:" @@ -8039,12 +8754,13 @@ ((org-region-active-p) (buffer-substring (region-beginning) (region-end))) (t (buffer-substring (point-at-bol) (point-at-eol))))) - (setq cpltxt - (concat cpltxt "::" - (if org-file-link-context-use-camel-case - (org-make-org-heading-camel txt) - (org-make-org-heading-search-string txt))) - desc "NONE"))) + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" + (if org-file-link-context-use-camel-case + (org-make-org-heading-camel txt) + (org-make-org-heading-search-string txt))) + desc "NONE")))) (if (string-match "::\\'" cpltxt) (setq cpltxt (substring cpltxt 0 -2))) (setq link (org-make-link cpltxt))) @@ -8058,12 +8774,14 @@ (setq txt (if (org-region-active-p) (buffer-substring (region-beginning) (region-end)) (buffer-substring (point-at-bol) (point-at-eol)))) - (setq cpltxt - (concat cpltxt "::" - (if org-file-link-context-use-camel-case - (org-make-org-heading-camel txt) - (org-make-org-heading-search-string txt))) - desc "NONE")) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" + (if org-file-link-context-use-camel-case + (org-make-org-heading-camel txt) + (org-make-org-heading-search-string txt))) + desc "NONE"))) (setq link (org-make-link cpltxt))) ((interactive-p) @@ -8287,16 +9005,39 @@ ;; URL-like link, normalize the use of angular brackets. (setq link (org-make-link (org-remove-angle-brackets link)))) - ;; Check if we are linking to the current file. If yes, simplify the link. + ;; Check if we are linking to the current file with a search option + ;; If yes, simplify the link by using only the search option. (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link) (let* ((path (match-string 1 link)) (case-fold-search nil) (search (match-string 2 link))) - (when (save-match-data - (equal (file-truename buffer-file-name) - (file-truename path))) - ;; We are linking to this same file, with a search option - (setq link search)))) + (save-match-data + (if (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) + + ;; Check if we can/should use a relative path. If yes, simplify the link + (when (string-match "\\<file:\\(.*\\)" link) + (let* ((path (match-string 1 link)) + (case-fold-search nil)) + (cond + ((eq org-link-file-path-type 'absolute) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (file-name-as-directory + (expand-file-name ".")))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))))))) + (setq link (concat "file:" path)))) + (setq desc (read-string "Description: " desc)) (unless (string-match "\\S-" desc) (setq desc nil)) (if remove (apply 'delete-region remove)) @@ -8329,48 +9070,52 @@ ;;;###autoload (defun org-remember-apply-template () - "Initialize *remember* buffer with template, invode `org-mode'. + "Initialize *remember* buffer with template, invoke `org-mode'. This function should be placed into `remember-mode-hook' and in fact requires to be run from that hook to fucntion properly." - (when org-remember-templates - (let* ((entry (if (= (length org-remember-templates) 1) - (cdar org-remember-templates) - (message "Select template: %s" - (mapconcat - (lambda (x) (char-to-string (car x))) - org-remember-templates " ")) - (cdr (assoc (read-char-exclusive) org-remember-templates)))) - (tpl (if (consp (cdr entry)) (cadr entry) (cdr entry))) - (file (if (consp (cdr entry)) (nth 2 entry))) - (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) - (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - (v-a annotation) ; defined in `remember-mode' - (v-i initial) ; defined in `remember-mode' - (v-n user-full-name) - ) - (unless tpl (setq tpl "") (message "No template") (ding)) - (insert tpl) (goto-char (point-min)) - (while (re-search-forward "%\\([tTuTai]\\)" nil t) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity + (if org-remember-templates + + (let* ((entry (if (= (length org-remember-templates) 1) + (cdar org-remember-templates) + (message "Select template: %s" + (mapconcat + (lambda (x) (char-to-string (car x))) + org-remember-templates " ")) + (cdr (assoc (read-char-exclusive) org-remember-templates)))) + (tpl (car entry)) + (file (if (consp (cdr entry)) (nth 1 entry))) + (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) + (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) + (v-u (concat "[" (substring v-t 1 -1) "]")) + (v-U (concat "[" (substring v-T 1 -1) "]")) + (v-a annotation) ; defined in `remember-mode' + (v-i initial) ; defined in `remember-mode' + (v-n user-full-name) + ) + (unless tpl (setq tpl "") (message "No template") (ding)) + (insert tpl) (goto-char (point-min)) + (while (re-search-forward "%\\([tTuTai]\\)" nil t) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity (org-split-string initial "\n") (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)) - (let ((org-startup-folded nil) - (org-startup-with-deadline-check nil)) - (org-mode)) - (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (set (make-local-variable 'org-default-notes-file) file)) - (goto-char (point-min)) - (if (re-search-forward "%\\?" nil t) (replace-match "")) - (set (make-local-variable 'org-finish-function) 'remember-buffer)))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t)) + (let ((org-startup-folded nil) + (org-startup-with-deadline-check nil)) + (org-mode)) + (if (and file (string-match "\\S-" file) (not (file-directory-p file))) + (set (make-local-variable 'org-default-notes-file) file)) + (goto-char (point-min)) + (if (re-search-forward "%\\?" nil t) (replace-match ""))) + (let ((org-startup-folded nil) + (org-startup-with-deadline-check nil)) + (org-mode))) + (set (make-local-variable 'org-finish-function) 'remember-buffer)) ;;;###autoload (defun org-remember-handler () @@ -8439,6 +9184,9 @@ (if (not visiting) (find-file-noselect file)) (with-current-buffer (get-file-buffer file) + (save-excursion (and (goto-char (point-min)) + (not (re-search-forward "^\\* " nil t)) + (insert "\n* Notes\n"))) (setq reversed (org-notes-order-reversed-p)) (save-excursion (save-restriction @@ -8866,7 +9614,7 @@ (if table-type org-table-any-border-regexp org-table-border-regexp) nil t)) - (error "Can't find beginning of table") + (progn (goto-char (point-min)) (point)) (goto-char (match-beginning 0)) (beginning-of-line 2) (point)))) @@ -9213,7 +9961,7 @@ "Please position cursor in a data line for column operations"))))) (defun org-table-delete-column () - "Delete a column into the table." + "Delete a column from the table." (interactive) (if (not (org-at-table-p)) (error "Not at a table")) @@ -9352,7 +10100,7 @@ In particular, this does handle wide and invisible characters." (if (string-match "^[ \t]*|-" s) ;; It's a hline, just map the characters - (setq s (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) s)) + (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) (setq s (replace-match (concat "|" (make-string (org-string-width (match-string 1 s)) @@ -9401,7 +10149,7 @@ (lambda (a b) (< (car a) (car b))) (lambda (a b) (string< (car a) (car b))))) (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) - (split-string (buffer-substring beg end) "\n"))) + (org-split-string (buffer-substring beg end) "\n"))) (if numericp (setq lns (mapcar (lambda(x) (cons (string-to-number (car x)) (cdr x))) @@ -9937,7 +10685,7 @@ "\n"))) (defun org-table-get-stored-formulas () - "Return an alist with the t=stored formulas directly after current table." + "Return an alist with the stored formulas directly after current table." (interactive) (let (scol eq eq-alist strings string seen) (save-excursion @@ -10217,7 +10965,7 @@ (org-table-get-formula equation (equal arg '(4))))) (n0 (org-table-current-column)) (modes (copy-sequence org-calc-default-modes)) - n form fmt x ev orig c) + n form fmt x ev orig c lispp) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. (if (string-match ";" formula) @@ -10252,7 +11000,8 @@ (lambda (x) (number-to-string (string-to-number x))) fields))) (setq ndown (1- ndown)) - (setq form (copy-sequence formula)) + (setq form (copy-sequence formula) + lispp (equal (substring form 0 2) "'(")) ;; Insert the references to fields in same row (while (string-match "\\$\\([0-9]+\\)?" form) (setq n (if (match-beginning 1) @@ -10262,7 +11011,9 @@ (unless x (error "Invalid field specifier \"%s\"" (match-string 0 form))) (if (equal x "") (setq x "0")) - (setq form (replace-match (concat "(" x ")") t t form))) + (setq form (replace-match + (if lispp x (concat "(" x ")")) + t t form))) ;; Insert ranges in current column (while (string-match "\\&[-I0-9]+" form) (setq form (replace-match @@ -10270,8 +11021,14 @@ (org-table-get-vertical-vector (match-string 0 form) nil n0)) t t form))) - (setq ev (calc-eval (cons form modes) - (if org-table-formula-numbers-only 'num))) +;; (setq ev (calc-eval (cons form modes) +;; FIXME (if org-table-formula-numbers-only 'num))) + + (if lispp + (setq ev (eval (eval (read form))) + ev (if (numberp ev) (number-to-string ev) ev)) + (setq ev (calc-eval (cons form modes) + (if org-table-formula-numbers-only 'num)))) (when org-table-formula-debug (with-output-to-temp-buffer "*Help*" @@ -10827,6 +11584,109 @@ (defconst org-level-max 20) +(defvar org-export-html-preamble nil + "Preamble, to be inserted just after <body>. Set by publishing functions.") +(defvar org-export-html-postamble nil + "Preamble, to be inserted just before </body>. Set by publishing functions.") +(defvar org-export-html-auto-preamble t + "Should default preamble be inserted? Set by publishing functions.") +(defvar org-export-html-auto-postamble t + "Should default postamble be inserted? Set by publishing functions.") + +(defconst org-export-plist-vars + '((:language . org-export-default-language) + (:headline-levels . org-export-headline-levels) + (:section-numbers . org-export-with-section-numbers) + (:table-of-contents . org-export-with-toc) + (:emphasize . org-export-with-emphasize) + (:sub-superscript . org-export-with-sub-superscripts) + (:TeX-macros . org-export-with-TeX-macros) + (:fixed-width . org-export-with-fixed-width) + (:timestamps . org-export-with-timestamps) + (:tables . org-export-with-tables) + (:table-auto-headline . org-export-highlight-first-table-line) + (:style . org-export-html-style) + (:convert-org-links . org-export-html-link-org-files-as-html) + (:inline-images . org-export-html-inline-images) + (:expand-quoted-html . org-export-html-expand) + (:timestamp . org-export-html-with-timestamp) + (:publishing-directory . org-export-publishing-directory) + (:preamble . org-export-html-preamble) + (:postamble . org-export-html-postamble) + (:auto-preamble . org-export-html-auto-preamble) + (:auto-postamble . org-export-html-auto-postamble) + (:author . user-full-name) + (:email . user-mail-address))) + +(defun org-default-export-plist () + "Return the property list with default settings for the export variables." + (let ((l org-export-plist-vars) rtn e) + (while (setq e (pop l)) + (setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn)))) + rtn)) + +(defun org-infile-export-plist () + "Return the property list with file-local settings for export." + (save-excursion + (goto-char 0) + (let ((re (org-make-options-regexp + '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) + (text nil) + p key val text options) + (while (re-search-forward re nil t) + (setq key (org-match-string-no-properties 1) + val (org-match-string-no-properties 2)) + (cond + ((string-equal key "TITLE") (setq p (plist-put p :title val))) + ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) + ((string-equal key "EMAIL") (setq p (plist-put p :email val))) + ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) + ((string-equal key "TEXT") + (setq text (if text (concat text "\n" val) val))) + ((string-equal key "OPTIONS") (setq options val)))) + (setq p (plist-put p :text text)) + (when options + (let ((op '(("H" . :headline-levels) + ("num" . :section-numbers) + ("toc" . :table-of-contents) + ("\\n" . :preserve-breaks) + ("@" . :expand-quoted-html) + (":" . :fixed-width) + ("|" . :tables) + ("^" . :sub-superscript) + ("*" . :emphasize) + ("TeX" . :TeX-macros))) + o) + (while (setq o (pop op)) + (if (string-match (concat (regexp-quote (car o)) + ":\\([^ \t\n\r;,.]*\\)") + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options))))))))) + p))) + +(defun org-combine-plists (&rest plists) + "Create a single property list from all plists in PLISTS. +The process starts by copying the last list, and then setting properties +from the other lists. Settings in the first list are the most significant +ones and overrule settings in the other lists." + (let ((rtn (copy-sequence (pop plists))) + p v ls) + (while plists + (setq ls (pop plists)) + (while ls + (setq p (pop ls) v (pop ls)) + (setq rtn (plist-put rtn p v)))) + rtn)) + +(defun org-export-directory (type plist) + (let* ((val (plist-get plist :publishing-directory)) + (dir (if (listp val) + (or (cdr (assoc type val)) ".") + val))) + dir)) + (defun org-export-find-first-heading-line (list) "Remove all lines from LIST which are before the first headline." (let ((orig-list list) @@ -11274,7 +12134,9 @@ underlined headlines. The default is 3." (interactive "P") (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((region + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (region (buffer-substring (if (org-region-active-p) (region-beginning) (point-min)) (if (org-region-active-p) (region-end) (point-max)))) @@ -11287,17 +12149,23 @@ (level 0) line txt (umax nil) (case-fold-search nil) - (filename (concat (file-name-sans-extension buffer-file-name) + (filename (concat (file-name-as-directory + (org-export-directory :ascii opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) ".txt")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) + (odd org-odd-levels-only) (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) - (author user-full-name) - (title (buffer-name)) + (author (plist-get opt-plist :author)) + (title (or (plist-get opt-plist :title) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) (options nil) - (email user-mail-address) - (language org-export-default-language) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) (text nil) (todo nil) (lang-words nil)) @@ -11307,9 +12175,6 @@ (find-file-noselect filename) - ;; Search for the export key lines - (org-parse-key-lines) - (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) (if org-export-ascii-show-new-buffer @@ -11317,7 +12182,13 @@ (set-buffer buffer)) (erase-buffer) (fundamental-mode) - (if options (org-parse-export-options options)) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapcar (lambda (x) + (set (make-local-variable (cdr x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (set (make-local-variable 'org-odd-levels-only) odd) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) @@ -11347,7 +12218,8 @@ level (org-tr-level level) txt (match-string 3 line) todo - (or (and (match-beginning 2) + (or (and org-export-mark-todo-in-toc + (match-beginning 2) (not (equal (match-string 2 line) org-done-string))) ; TODO, not DONE @@ -11390,6 +12262,19 @@ (t (insert line "\n")))) (normal-mode) (save-buffer) + ;; remove display and invisible chars + (let (beg end s) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'display)) + (setq end (next-single-property-change beg 'display)) + (delete-region beg end) + (goto-char beg) + (insert "=>")) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'org-cwidth)) + (setq end (next-single-property-change beg 'org-cwidth)) + (delete-region beg end) + (goto-char beg))) (goto-char (point-min)))) (defun org-search-todo-below (line lines level) @@ -11441,38 +12326,54 @@ (setq title (concat (org-section-number level) " " title))) (insert title "\n" (make-string (string-width title) char) "\n")))) -(defun org-export-copy-visible () - "Copy the visible part of the buffer to another buffer, for printing. -Also removes the first line of the buffer if it specifies a mode, -and all options lines." - (interactive) - (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" "ARCHIVE" - "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) - (if org-noutline-p "\\(\n\\|$\\)" ""))) +(defun org-export-visible (type arg) + "Create a copy of the visible part of the current buffer, and export it. +The copy is created in a temporary buffer and removed after use. +TYPE is the final key (as a string) of the `C-c C-x' key sequence that will +run the export command - in interactive use, the command prompts for this +key. As a special case, if the you type SPC at the prompt, the temporary +org-mode file will not be removed but presented to you so that you can +continue to use it. The prefix arg ARG is passed through to the exporting +command." + (interactive + (list (progn + (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer") + (char-to-string (read-char-exclusive))) + current-prefix-arg)) + (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " "))) + (error "Invalid export key")) + (let* ((binding (key-binding (concat "\C-c\C-x" type))) + (keepp (equal type " ")) + (file buffer-file-name) + (buffer (get-buffer-create "*Org Export Visible*")) s e) - (with-current-buffer buffer - (erase-buffer) - (text-mode)) + (with-current-buffer buffer (erase-buffer)) (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)))) + (setq s (goto-char (org-find-visible)))) + (goto-char (point-min)) + (unless keepp + ;; Copy all comment lines to the end, to make sure #+ settings are + ;; still available for the second export step. Kind of a hack, but + ;; does do the trick. + (if (looking-at "#[^\r\n]*") + (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) + (while (re-search-forward "[\n\r]#[^\n\r]*" nil t) + (append-to-buffer buffer (1+ (match-beginning 0)) + (min (point-max) (1+ (match-end 0)))))) + (set-buffer buffer) + (let ((buffer-file-name file) + (org-inhibit-startup t)) + (org-mode) + (show-all) + (unless keepp (funcall binding arg)))) + (if (not keepp) + (kill-buffer buffer) + (switch-to-buffer-other-window buffer) + (goto-char (point-min))))) (defun org-find-visible () (if (featurep 'noutline) @@ -11506,7 +12407,8 @@ #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s -#+STARTUP: %s %s %s %s %s +#+STARTUP: %s %s %s %s %s %s +#+TAGS: %s #+ARCHIVE: %s " (buffer-name) (user-full-name) user-mail-address org-export-default-language @@ -11533,6 +12435,8 @@ (if org-odd-levels-only "odd" "oddeven") (if org-hide-leading-stars "hidestars" "showstars") (if org-startup-align-all-tables "align" "noalign") + (if org-log-done "logging" "nologging") + (if org-tag-alist (mapconcat 'car org-tag-alist " ") "") org-archive-location )) @@ -11606,16 +12510,23 @@ --visit=MyFile --funcall org-export-as-html-batch" (org-export-as-html org-export-headline-levels 'hidden)) -(defun org-export-as-html (arg &optional hidden) +(defun org-export-as-html (arg &optional hidden ext-plist) "Export the outline as a pretty HTML file. If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." +headlines. The default is 3. Lower levels will become bulleted lists. +When HIDDEN is non-nil, don't display the HTML buffer. +EXT-PLIST is a property list with external parameters overriding +org-mode's default settings, but still inferior to file-local settings." (interactive "P") (setq-default org-todo-line-regexp org-todo-line-regexp) (setq-default org-deadline-line-regexp org-deadline-line-regexp) (setq-default org-done-string org-done-string) - (let* ((style org-export-html-style) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist))) + + (style (plist-get opt-plist :style)) (odd org-odd-levels-only) (region-p (org-region-active-p)) (region @@ -11629,26 +12540,31 @@ (lines (org-export-find-first-heading-line all_lines)) (level 0) (line "") (origline "") txt todo (umax nil) - (filename (concat (file-name-sans-extension buffer-file-name) - ".html")) + (filename (concat (file-name-as-directory + (org-export-directory :html opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".html")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) - (author user-full-name) - (title (buffer-name)) - (options nil) - (quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>")) + (author (plist-get opt-plist :author)) + (title (or (plist-get opt-plist :title) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) + (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) (inquote nil) (infixed nil) (in-local-list nil) (local-list-num nil) (local-list-indent nil) (llt org-plain-list-ordered-item-terminator) - (email user-mail-address) - (language org-export-default-language) - (text nil) - (lang-words nil) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (text (plist-get opt-plist :text)) + (lang-words nil) (target-alist nil) tg (head-count 0) cnt (start 0) @@ -11663,15 +12579,14 @@ table-open type table-buffer table-orig-buffer ind start-is-num starter - rpl path desc desc1 desc2 link + rpl path desc descp desc1 desc2 link ) (message "Exporting...") (setq org-last-level 1) (org-init-section-numbers) - ;; Search for the export key lines - (org-parse-key-lines) + ;; Get the language-dependent settings (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) @@ -11683,7 +12598,12 @@ (fundamental-mode) (let ((case-fold-search nil) (org-odd-levels-only odd)) - (if options (org-parse-export-options options)) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapcar (lambda (x) + (set (make-local-variable (cdr x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) @@ -11702,15 +12622,21 @@ " language (org-html-expand title) (or charset "iso-8859-1") date time author style)) - (if title (insert (concat "<H1 class=\"title\">" - (org-html-expand title) "</H1>\n"))) - (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) - (if email (insert (concat "<a href=\"mailto:" email "\"><" - email "></a>\n"))) - (if (or author email) (insert "<br>\n")) - (if (and date time) (insert (concat (nth 2 lang-words) ": " - date " " time "<br>\n"))) - (if text (insert (concat "<p>\n" (org-html-expand text)))) + + + (insert (or (plist-get opt-plist :preamble) "")) + + (when (plist-get opt-plist :auto-preamble) + (if title (insert (concat "<H1 class=\"title\">" + (org-html-expand title) "</H1>\n"))) +; (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) +; (if email (insert (concat "<a href=\"mailto:" email "\"><" +; email "></a>\n"))) +; (if (or author email) (insert "<br>\n")) +; (if (and date time) (insert (concat (nth 2 lang-words) ": " +; date " " time "<br>\n"))) + (if text (insert (concat "<p>\n" (org-html-expand text))))) + (if org-export-with-toc (progn (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) @@ -11724,9 +12650,11 @@ level (org-tr-level level) txt (save-match-data (org-html-expand - (match-string 3 line))) + (org-html-cleanup-toc-line + (match-string 3 line)))) todo - (or (and (match-beginning 2) + (or (and org-export-mark-todo-in-toc + (match-beginning 2) (not (equal (match-string 2 line) org-done-string))) ; TODO, not DONE @@ -11785,7 +12713,7 @@ (catch 'nextline ;; end of quote section? - (when (and inquote (string-match "^\\*+" line)) + (when (and inquote (string-match "^\\*+" line)) (insert "</pre>\n") (setq inquote nil)) ;; inside a quote section? @@ -11829,8 +12757,11 @@ "\" class=\"target\">" (match-string 1 line) "@</a> ") t t line))))) + (setq line (org-html-handle-time-stamps line)) + ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") + ;; Also handle sub_superscripts and checkboxes FIXME (setq line (org-html-expand line)) ;; Format the links @@ -11841,7 +12772,9 @@ (setq path (match-string 3 line)) (setq desc1 (if (match-end 5) (match-string 5 line)) desc2 (if (match-end 2) (concat type ":" path) path) + descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) + ;; FIXME: do we need to unescape here somewhere? (cond ((equal type "internal") (setq rpl @@ -11877,12 +12810,18 @@ (not (string-match "^/.*/$" search))) (setq thefile (concat thefile "#" (org-solidify-link-text - (org-link-unescape search))))))) - (setq rpl (if (and org-export-html-inline-images - file-is-image-p) + (org-link-unescape search))))) + (when (string-match "^file:" desc) + (setq desc (replace-match "" t t desc)) + (if (string-match "\\.org$" desc) + (setq desc (replace-match "" t t desc)))))) + (setq rpl (if (and file-is-image-p + (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images + (not descp)))) (concat "<img src=\"" thefile "\"/>") (concat "<a href=\"" thefile "\">" desc "</a>"))))) - ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) + ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) "></i>")))) @@ -11898,20 +12837,13 @@ (setq line (replace-match "<span class=\"todo\">\\2</span>" nil nil line 2)))) - ;; DEADLINES - (if (string-match org-deadline-line-regexp line) - (progn - (if (save-match-data - (string-match "<a href" - (substring line 0 (match-beginning 0)))) - nil ; Don't do the replacement - it is inside a link - (setq line (replace-match "<span class=\"deadline\">\\&</span>" - nil nil line 1))))) (cond ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) txt (match-string 2 line)) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) (if (<= level umax) (setq head-count (+ head-count 1))) (when in-local-list ;; Close any local lists before inserting a new header line @@ -11945,16 +12877,17 @@ (insert (org-format-table-html table-buffer table-orig-buffer)))) (t ;; Normal lines - (when (and (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line)) + (when (string-match + (cond + ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) + line) (setq ind (org-get-string-indentation line) start-is-num (match-beginning 4) - starter (if (match-beginning 2) (match-string 2 line)) + starter (if (match-beginning 2) + (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5))) (unless (string-match "[^ \t]" line) ;; empty line. Pretend indentation is large. @@ -11977,15 +12910,46 @@ (setq in-local-list t)) (starter ;; continue current list - (insert "<li>\n")))) + (insert "<li>\n"))) + (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) + (setq line + (replace-match + (if (equal (match-string 1 line) "X") + "<b>[X]</b>" + "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") + t t line)))) + ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" ;; also start a new paragraph. (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>")) (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) )) + + ;; Properly close all local lists and other lists + (when inquote (insert "</pre>\n")) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-num + (insert (if (car local-list-num) "</ol>\n" "</ul>")) + (pop local-list-num)) + (setq local-list-indent nil + in-local-list nil)) + (org-html-level-start 1 nil umax + (and org-export-with-toc (<= level umax)) + head-count) + + (when (plist-get opt-plist :auto-postamble) + (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) + (if email (insert (concat "<a href=\"mailto:" email "\"><" + email "></a>\n"))) + (if (or author email) (insert "<br>\n")) + (if (and date time) (insert (concat (nth 2 lang-words) ": " + date " " time "<br>\n")))) + (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) + (insert (or (plist-get opt-plist :postamble) "")) (insert "</body>\n</html>\n") (normal-mode) (save-buffer) @@ -12140,6 +13104,30 @@ (set-buffer " org-tmp2 ") (buffer-substring (point-min) (point-max)))) +(defun org-html-handle-time-stamps (s) + "Format time stamps in string S, or remove them." + (let (r b) + (while (string-match org-maybe-keyword-time-regexp s) + (or b (setq b (substring s 0 (match-beginning 0)))) + (if (not org-export-with-timestamps) + (setq r (concat r (substring s 0 (match-beginning 0))) + s (substring s (match-end 0))) + (setq r (concat + r (substring s 0 (match-beginning 0)) + (if (match-end 1) + (format "@<span class=\"timestamp-kwd\">%s @</span>" + (match-string 1 s))) + (format " @<span class=\"timestamp\">%s@</span>" + (substring (match-string 3 s) 1 -1))) + s (substring s (match-end 0))))) + ;; Line break of line started and ended with time stamp stuff + (if (not r) + s + (setq r (concat r s)) + (unless (string-match "\\S-" (concat b s)) + (setq r (concat r "@<br>"))) + r))) + (defun org-html-protect (s) ;; convert & to &, < to < and > to > (let ((start 0)) @@ -12152,6 +13140,14 @@ (setq s (replace-match ">" t t s)))) s) +(defun org-html-cleanup-toc-line (s) + "Remove tags and time staps from lines going into the toc." + (if (string-match " +:[a-zA-Z0-9_@:]+: *$" s) + (setq s (replace-match "" t t s))) + (while (string-match org-maybe-keyword-time-regexp s) + (setq s (replace-match "" t t s))) + s) + (defun org-html-expand (string) "Prepare STRING for HTML export. Applies all active conversions. If there are links in the string, don't modify these." @@ -12212,6 +13208,7 @@ "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" "\\|" "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") +;;;;;;;;;;;;;;;;;;;;;;;;;^ FIXME "The regular expression matching a sub- or superscript.") (defun org-export-html-convert-sub-super (string) @@ -12239,49 +13236,9 @@ (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string))) string) -(defun org-parse-key-lines () - "Find the special key lines with the information for exporters." - (save-excursion - (goto-char 0) - (let ((re (org-make-options-regexp - '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) - key) - (while (re-search-forward re nil t) - (setq key (match-string 1)) - (cond ((string-equal key "TITLE") - (setq title (match-string 2))) - ((string-equal key "AUTHOR") - (setq author (match-string 2))) - ((string-equal key "EMAIL") - (setq email (match-string 2))) - ((string-equal key "LANGUAGE") - (setq language (match-string 2))) - ((string-equal key "TEXT") - (setq text (concat text "\n" (match-string 2)))) - ((string-equal key "OPTIONS") - (setq options (match-string 2)))))))) - -(defun org-parse-export-options (s) - "Parse the export options line." - (let ((op '(("H" . org-export-headline-levels) - ("num" . org-export-with-section-numbers) - ("toc" . org-export-with-toc) - ("\\n" . org-export-preserve-breaks) - ("@" . org-export-html-expand) - (":" . org-export-with-fixed-width) - ("|" . org-export-with-tables) - ("^" . org-export-with-sub-superscripts) - ("*" . org-export-with-emphasize) - ("TeX" . org-export-with-TeX-macros))) - o) - (while (setq o (pop op)) - (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") - s) - (set (make-local-variable (cdr o)) - (car (read-from-string (match-string 1 s)))))))) - (defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export." + "Insert a new level in HTML export. +When TITLE is nil, just close all open levels." (let ((l (1+ (max level umax)))) (while (<= l org-level-max) (if (aref levels-open (1- l)) @@ -12289,19 +13246,35 @@ (org-html-level-close l) (aset levels-open (1- l) nil))) (setq l (1+ l))) - (if (> level umax) - (progn - (if (aref levels-open (1- level)) - (insert "<li>" title "<p>\n") - (aset levels-open (1- level) t) - (insert "<ul><li>" title "<p>\n"))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (setq level (+ level 1)) - (if with-toc - (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" - level head-count title level)) - (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) + (when title + ;; If title is nil, this means this function is called to close + ;; all levels, so the rest is done only if title is given + (if (> level umax) + (progn + (if (aref levels-open (1- level)) + (insert "<li>" title "<p>\n") + (aset levels-open (1- level) t) + (insert "<ul><li>" title "<p>\n"))) + (if org-export-with-section-numbers + (setq title (concat (org-section-number level) " " title))) + (setq level (+ level 1)) + ;; FIXME: here we need to handle the tags, somehow. + (when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title) + (setq title (replace-match + (if org-export-with-tags + (save-match-data + (concat + " <span class=\"tag\">" + (mapconcat 'identity (org-split-string + (match-string 1 title) ":") + " ") + "</span>")) + "") + t t title))) + (if with-toc + (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" + level head-count title level)) + (insert (format "\n<H%d>%s</H%d>\n" level title level))))))) (defun org-html-level-close (&rest args) "Terminate one level in HTML export." @@ -12361,9 +13334,9 @@ (interactive) (org-export-icalendar nil buffer-file-name)) -(defun org-export-as-xml () +(defun org-export-as-xml (arg) "Export current buffer as XOXO XML buffer." - (interactive) + (interactive "P") (cond ((eq org-export-xml-type 'xoxo) (org-export-as-xoxo (current-buffer))))) @@ -12380,8 +13353,13 @@ ;; Output everything as XOXO (with-current-buffer (get-buffer buffer) (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - (let* ((filename (concat (file-name-sans-extension buffer-file-name) - ".xml")) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (filename (concat (file-name-as-directory + (org-export-directory :xoxo opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".html")) (out (find-file-noselect filename)) (last-level 1) (hanging-li nil)) @@ -12464,19 +13442,29 @@ If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-icalendar-file'." (save-excursion - (let* (file ical-file ical-buffer category started org-agenda-new-buffers) + (let* ((dir (org-export-directory + :ical (list :publishing-directory + org-export-publishing-directory))) + file ical-file ical-buffer category started org-agenda-new-buffers) + (when combine - (setq ical-file org-combined-agenda-icalendar-file + (setq ical-file + (if (file-name-absolute-p org-combined-agenda-icalendar-file) + org-combined-agenda-icalendar-file + (expand-file-name org-combined-agenda-icalendar-file dir)) ical-buffer (org-get-agenda-file-buffer ical-file)) (set-buffer ical-buffer) (erase-buffer)) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) (unless combine - (setq ical-file (concat (file-name-sans-extension file) ".ics")) + (setq ical-file (concat (file-name-as-directory dir) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".ics")) (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (set-buffer (org-get-agenda-file-buffer file)) + (with-current-buffer ical-buffer (erase-buffer))) (setq category (or org-category (file-name-sans-extension (file-name-nondirectory buffer-file-name)))) @@ -12611,6 +13599,7 @@ ;; Make `C-c C-x' a prefix key (define-key org-mode-map "\C-c\C-x" (make-sparse-keymap)) +(define-key org-mode-map "\C-c\C-e" (make-sparse-keymap)) ;; TAB key with modifiers (define-key org-mode-map "\C-i" 'org-cycle) @@ -12708,8 +13697,8 @@ (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-xv" 'org-export-visible) +(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible) ;; OPML support is only an option for the future ;(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) @@ -12730,6 +13719,18 @@ (define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special) (define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special) +(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file) +(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project) +(define-key org-mode-map "\C-c\C-ec" 'org-publish) +(define-key org-mode-map "\C-c\C-ea" 'org-publish-all) +(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file) +(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project) +(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish) +(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all) + +(when (featurep 'xemacs) + (define-key org-mode-map 'button3 'popup-mode-menu)) + (defsubst org-table-p () (org-at-table-p)) (defun org-self-insert-command (N) @@ -12803,7 +13804,8 @@ (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c)))) + (if noalign (setq org-table-may-need-update c))) + (delete-char N)) (delete-char N))) ;; How to do this: Measure non-white length of current string @@ -12834,12 +13836,13 @@ (defun org-shifttab () "Global visibility cycling or move to previous table field. -Calls `(org-cycle t)' or `org-table-previous-field', depending on context. +Calls `org-cycle' with argument t, or `org-table-previous-field', depending +on context. See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-previous-field)) - (t (org-cycle '(4))))) + ((org-at-table-p) (call-interactively 'org-table-previous-field)) + (t (call-interactively 'org-global-cycle)))) (defun org-shiftmetaleft () "Promote subtree or delete table column. @@ -12847,8 +13850,8 @@ See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-delete-column)) - ((org-on-heading-p) (org-promote-subtree)) + ((org-at-table-p) (call-interactively 'org-table-delete-column)) + ((org-on-heading-p) (call-interactively 'org-promote-subtree)) ((org-at-item-p) (call-interactively 'org-outdent-item)) (t (org-shiftcursor-error)))) @@ -12858,8 +13861,8 @@ See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-insert-column)) - ((org-on-heading-p) (org-demote-subtree)) + ((org-at-table-p) (call-interactively 'org-table-insert-column)) + ((org-on-heading-p) (call-interactively 'org-demote-subtree)) ((org-at-item-p) (call-interactively 'org-indent-item)) (t (org-shiftcursor-error)))) @@ -12870,9 +13873,9 @@ for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-kill-row)) - ((org-on-heading-p) (org-move-subtree-up arg)) - ((org-at-item-p) (org-move-item-up arg)) + ((org-at-table-p) (call-interactively 'org-table-kill-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-shiftcursor-error)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. @@ -12881,9 +13884,9 @@ commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-insert-row arg)) - ((org-on-heading-p) (org-move-subtree-down arg)) - ((org-at-item-p) (org-move-item-down arg)) + ((org-at-table-p) (call-interactively 'org-table-insert-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-shiftcursor-error)))) (defun org-metaleft (&optional arg) @@ -12893,9 +13896,10 @@ See the individual commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote)) - (t (backward-word (prefix-numeric-value arg))))) + ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) + ((or (org-on-heading-p) (org-region-active-p)) + (call-interactively 'org-do-promote)) + (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) "Demote subtree or move table column to right. @@ -12904,9 +13908,10 @@ See the individual commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-column nil)) - ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote)) - (t (forward-word (prefix-numeric-value arg))))) + ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((or (org-on-heading-p) (org-region-active-p)) + (call-interactively 'org-do-demote)) + (t (call-interactively 'forward-word)))) (defun org-metaup (&optional arg) "Move subtree up or move table row up. @@ -12915,9 +13920,9 @@ for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-row 'up)) - ((org-on-heading-p) (org-move-subtree-up arg)) - ((org-at-item-p) (org-move-item-up arg)) + ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-shiftcursor-error)))) (defun org-metadown (&optional arg) @@ -12927,43 +13932,46 @@ commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-row nil)) - ((org-on-heading-p) (org-move-subtree-down arg)) - ((org-at-item-p) (org-move-item-down arg)) + ((org-at-table-p) (call-interactively 'org-table-move-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-shiftcursor-error)))) (defun org-shiftup (&optional arg) - "Increase item in timestamp or increase priority of current item. + "Increase item in timestamp or increase priority of current headline. Calls `org-timestamp-up' or `org-priority-up', depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p) (org-timestamp-up arg)) - (t (org-priority-up)))) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-up)) + ((org-on-heading-p) (call-interactively 'org-priority-up)) + ((org-at-item-p) (call-interactively 'org-previous-item)) + (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) (defun org-shiftdown (&optional arg) - "Decrease item in timestamp or decrease priority of current item. + "Decrease item in timestamp or decrease priority of current headline. Calls `org-timestamp-down' or `org-priority-down', depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p) (org-timestamp-down arg)) - (t (org-priority-down)))) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-down)) + ((org-on-heading-p) (call-interactively 'org-priority-down)) + (t (call-interactively 'org-next-item)))) (defun org-shiftright () "Next TODO keyword or timestamp one day later, depending on context." (interactive) (cond - ((org-at-timestamp-p) (org-timestamp-up-day)) - ((org-on-heading-p) (org-todo 'right)) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-up-day)) + ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) (t (org-shiftcursor-error)))) (defun org-shiftleft () "Previous TODO keyword or timestamp one day earlier, depending on context." (interactive) (cond - ((org-at-timestamp-p) (org-timestamp-down-day)) - ((org-on-heading-p) (org-todo 'left)) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-down-day)) + ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) (t (org-shiftcursor-error)))) (defun org-copy-special () @@ -13028,21 +14036,23 @@ ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) - ((org-on-target-p) (org-update-radio-target-regexp)) - ((org-on-heading-p) (org-set-tags arg)) + ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) + ((org-on-heading-p) (call-interactively 'org-set-tags)) ((org-at-table.el-p) (require 'table) (beginning-of-line 1) (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (table-recognize-table)) + (call-interactively 'table-recognize-table)) ((org-at-table-p) (org-table-maybe-eval-formula) (if arg - (org-table-recalculate t) + (call-interactively 'org-table-recalculate) (org-table-maybe-recalculate-line)) - (org-table-align)) + (call-interactively 'org-table-align)) + ((org-at-item-checkbox-p) + (call-interactively 'org-toggle-checkbox)) ((org-at-item-p) - (org-renumber-ordered-list (prefix-numeric-value arg))) + (call-interactively 'org-renumber-ordered-list)) ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) (cond ((equal (match-string 1) "TBLFM") @@ -13050,9 +14060,10 @@ (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") - (if (org-at-table-p) (org-table-recalculate t)))) + (if (org-at-table-p) + (org-call-with-arg 'org-table-recalculate t)))) (t - (org-mode-restart)))) + (call-interactively 'org-mode-restart)))) (t (error "C-c C-c can do nothing useful at this location."))))) (defun org-mode-restart () @@ -13070,7 +14081,7 @@ (cond ((org-at-table-p) (org-table-justify-field-maybe) - (org-table-next-row)) + (call-interactively 'org-table-next-row)) (t (newline)))) (defun org-meta-return (&optional arg) @@ -13080,8 +14091,8 @@ (interactive "P") (cond ((org-at-table-p) - (org-table-wrap-region arg)) - (t (org-insert-heading arg)))) + (call-interactively 'org-table-wrap-region)) + (t (call-interactively 'org-insert-heading)))) ;;; Menu entries @@ -13226,10 +14237,10 @@ "--" ("Export" ["ASCII" org-export-as-ascii t] - ["Extract Visible Text" org-export-copy-visible t] + ["Export visible part..." org-export-visible t] ["HTML" org-export-as-html t] ["HTML and Open" org-export-as-html-and-open t] - ["XML (XOXO)" org-export-as-xml t] + ["XOXO" org-export-as-xml t] "--" ["iCalendar this file" org-export-icalendar-this-file t] ["iCalendar all agenda files" org-export-icalendar-all-agenda-files @@ -13238,6 +14249,11 @@ "--" ["Option Template" org-insert-export-options-template t] ["Toggle Fixed Width" org-toggle-fixed-width-section t]) + ("Publish" + ["Current File" org-publish-current-file t] + ["Current Project" org-publish-current-project t] + ["Project..." org-publish t] + ["All Projects" org-publish-all t]) "--" ("Documentation" ["Show Version" org-version t] @@ -13451,7 +14467,7 @@ ;; The following functions capture almost the entire compatibility code ;; between the different versions of outline-mode. The only other ;; places where this is important are the font-lock-keywords, and in -;; `org-export-copy-visible'. Search for `org-noutline-p' to find them. +;; `org-export-visible'. Search for `org-noutline-p' to find them. ;; C-a should go to the beginning of a *visible* line, also in the ;; new outline.el. I guess this should be patched into Emacs? @@ -13503,15 +14519,15 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (if org-noutline-p (outline-back-to-heading invisible-ok) - (if (and (memq (char-before) '(?\n ?\r)) + (if (and (or (bobp) (memq (char-before) '(?\n ?\r))) (looking-at outline-regexp)) t (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") outline-regexp) nil t) (if invisible-ok - (progn (goto-char (match-end 1)) - (looking-at outline-regexp))) + (progn (goto-char (or (match-end 1) (match-beginning 0))) + (looking-at outline-regexp))) (error "Before first heading"))))) (defun org-on-heading-p (&optional invisible-ok) @@ -13585,10 +14601,9 @@ (if entry (progn (org-show-entry) - (save-excursion ;; FIXME: Is this the fix for points in the -| - ;; middle of text? | - (and (outline-next-heading) ;; | - (org-flag-heading nil)))) ; show the next heading _| + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))) (outline-flag-region (max 1 (1- (point))) (save-excursion (outline-end-of-heading) (point)) (if org-noutline-p @@ -13630,7 +14645,7 @@ (save-excursion (org-back-to-heading t) (outline-flag-region - (1- (point)) + (max 1 (1- (point))) (save-excursion (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) (or (match-beginning 1) (point-max))) @@ -13669,6 +14684,6 @@ (run-hooks 'org-load-hook) + ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here -