Mercurial > emacs
diff lisp/org/org.el @ 96975:60149c696033
2008-07-24 Carsten Dominik <dominik@science.uva.nl>
* org-exp.el (org-export-region-as-html, org-export-as-html): Make
sure that calls from `org-export-region-as-html' do not do the
special check for a subtree.
* org-agenda.el (org-batch-store-agenda-views): Fix parsing bug.
* org.el (org-open-file): Use
`org-open-directory-means-index-dot-org'.
(org-open-directory-means-index-dot-org): New option.
* org.el (org-make-link-string): Remove link attributes from
description.
(org-open-at-point): Remove link attributes bevore using the path.
* org-exp.el (org-export-as-html): Handle link attributes.
* org.el (org-extract-attributes, org-attributes-to-string): New functions.
* org-table.el (org-table-to-lisp): New function.
* org.el (org-narrow-to-subtree): Do not include the final newline
into the narrowed region.
* org-agenda.el (org-agenda-custom-commands-local-options): Fixed
bug with user-define skipping condition.
* org-agenda.el (org-agenda-get-restriction-and-command): Fixed typo.
* org-exp.el (org-export-html-style-default): Automatic overflow
handling for pre fields.
(org-export-as-ascii, org-export-as-html): Change default format
for time stamp.
* org-table.el (org-table-export): Offer completion for translator
functions, and do not require a heading above the table.
* org.el (org-renumber-ordered-list, org-beginning-of-item-list):
Cater for the case of a list starting in the first line of the
buffer.
* org-publish.el (org-publish-find-title): Bug fix.
(org-publish-org-index): Implement new :index-style option.
* org-publish.el (org-publish-timestamp-filename): Use
SHA1-encoded file names in the timestamp directory.
* org-publish.el (org-publish-needed-p): Be verbose about files
published and files skipped.
* org-exp.el (org-export-preprocess-string): Swap link
normalization and inernal link targeting.
* org-publish.el (org-publish-needed-p): Create timestamp
directory when it does not exist.
* org-clock.el (org-clock-out-when-done): Doc fix.
* org.el (org-agenda-skip-unavailable-files): Doc fix.
* org-exp.el (org-export-remove-comment-blocks-and-subtrees):
Ignore case when searching for the COMMENT cookie at export time.
* org-exp.el (org-get-file-contents)
(org-get-and-remove-property): New functions.
(org-export-handle-include-files): Handle the new prefix options.
(org-export-as-html): Fix the verse environment.
* org.el (org-time=, org-time<, org-time<=, org-time>)
(org-time>=, org-time<>, org-2ft): New functions.
(org-op-to-function): Also provide for the time testing fucntions.
* org-exp.el (org-export-html-style-default): New constant.
* org-exp.el (org-export-html-style-extra): New variable.
(org-export-splice-style): New function.
* org-exp.el (org-export-plist-vars, org-export-as-html):
Implement `org-export-creator-info'.
(org-export-creator-info): New option.
* org.el (org-clock-drawer-start-re, org-clock-drawer-end-re)
(org-property-drawer-re, org-clock-drawer-re): New constants.
* org-exp.el (org-icalendar-use-deadline)
(org-icalendar-use-scheduled): New options.
(org-icalendar-include-todo): Default changed to t.
(org-print-icalendar-entries): Implement better utilization of
scheduling and deadline time stamps.
(org-export-target-internal-links, org-export-as-html): Allow file
lines without the "file:" prefix if the file path is an absolute
path or starts with ".".
* org-clock.el (org-clocktable-shift): Also undertand yesterday,
lastweek etc.
(org-clock-special-range): Also undertand yesterday, lastweek etc.
* org.el (org-agenda-skip-archived-trees): Docstring now
discourages using this.
(org-scan-tags): Check for org-agenda-archives-mode.
(org-map-entries): Make sure org-agenda-archives-mode is nil.
(org-agenda-files): Functionality of second arg changed.
* org-agenda.el (org-agenda-archives-mode): New variable
(org-write-agenda, org-prepare-agenda, org-agenda-list)
(org-search-view, org-todo-list, org-tags-view)
(org-agenda-list-stuck-projects): Call `org-agenda-files' with
`ifmode' argument.
(org-agenda-quit): Reset the archives mode.
(org-agenda-archives-mode): New command.
(org-agenda-set-mode-name): Include archives info.
* org.el (org-paste-subtree): Make sure the yanked headline is
visible if it was yanked at a visible point.
(org-move-item-up): Fix the bug with moving white space at the end
of the item.
(org-show-empty-lines-in-parent): New function.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Thu, 24 Jul 2008 13:59:56 +0000 |
| parents | 1e197e79733b |
| children | adc2dffbdfc3 |
line wrap: on
line diff
--- a/lisp/org/org.el Thu Jul 24 13:00:20 2008 +0000 +++ b/lisp/org/org.el Thu Jul 24 13:59:56 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.05a +;; Version: 6.06a ;; ;; This file is part of GNU Emacs. ;; @@ -91,7 +91,7 @@ ;;; Version -(defconst org-version "6.05a" +(defconst org-version "6.06a" "The version number of the file org.el.") (defun org-version (&optional here) @@ -1062,6 +1062,13 @@ :group 'org-link-follow :type 'boolean) +(defcustom org-open-directory-means-index-dot-org nil + "Non-nil means, a link to a directory really means to index.org. +When nil, following a directory link will run dired or open a finder/explorer +window on that directory." + :group 'org-link-follow + :type 'boolean) + (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") "Function and arguments to call for following mailto links. This is a list with the first element being a lisp function, and the @@ -2573,7 +2580,9 @@ (defcustom org-agenda-skip-archived-trees t "Non-nil means, the agenda will skip any items located in archived trees. -An archived tree is a tree marked with the tag ARCHIVE." +An archived tree is a tree marked with the tag ARCHIVE. The use of this +variable is no longer recommended, you should leave it at the value t. +Instead, use the key `v' to cycle the archives-mode in the agenda." :group 'org-archive :group 'org-agenda-skip :type 'boolean) @@ -4206,6 +4215,12 @@ (= (match-end 0) (point-max))) (outline-flag-region (point) (match-end 0) nil)))) +(defun org-show-empty-lines-in-parent () + "Move to the parent and re-show empty lines before visible headlines." + (save-excursion + (let ((context (if (org-up-heading-safe) 'children 'overview))) + (org-cycle-show-empty-lines context)))) + (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." (when (and (org-mode-p) @@ -4895,6 +4910,7 @@ (insert (make-string (- ne-ins ne-beg) ?\n))) (move-marker ins-point nil) (org-compact-display-after-subtree-move) + (org-show-empty-lines-in-parent) (unless folded (org-show-entry) (show-children) @@ -4974,7 +4990,8 @@ (error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((txt (or tree (and kill-ring (current-kill 0)))) + (let* ((visp (not (org-invisible-p))) + (txt (or tree (and kill-ring (current-kill 0)))) (^re (concat "^\\(" outline-regexp "\\)")) (re (concat "\\(" outline-regexp "\\)")) (^re_ (concat "\\(\\*+\\)[ \t]*")) @@ -5028,6 +5045,8 @@ (goto-char beg) (skip-chars-forward " \t\n\r") (setq beg (point)) + (if (and (org-invisible-p) visp) + (save-excursion (outline-show-heading))) ;; Shift if necessary (unless (= shift 0) (save-restriction @@ -5109,7 +5128,7 @@ (save-match-data (narrow-to-region (progn (org-back-to-heading) (point)) - (progn (org-end-of-subtree t t) (point)))))) + (progn (org-end-of-subtree t) (point)))))) ;;; Outline Sorting @@ -5908,6 +5927,7 @@ (setq beg (point))) (goto-char beg0) (org-end-of-item) + (org-back-over-empty-lines) (setq end (point)) (goto-char beg0) (catch 'exit @@ -5923,7 +5943,7 @@ (throw 'exit t))))) (condition-case nil (org-beginning-of-item) - (error (goto-char beg) + (error (goto-char beg0) (error "Cannot move this item further up"))) (setq ind1 (org-get-indentation)) (if (and (org-at-item-p) (= ind ind1)) @@ -6021,9 +6041,10 @@ (buffer-substring (point-at-bol) (match-beginning 3)))) ;; (term (substring (match-string 3) -1)) ind1 (n (1- arg)) - fmt) + fmt bob) ;; find where this list begins (org-beginning-of-item-list) + (setq bobp (bobp)) (looking-at "[ \t]*[0-9]+\\([.)]\\)") (setq fmt (concat "%d" (match-string 1))) (beginning-of-line 0) @@ -6031,7 +6052,7 @@ (catch 'exit (while t (catch 'next - (beginning-of-line 2) + (if bobp (setq bobp nil) (beginning-of-line 2)) (if (eobp) (throw 'exit nil)) (if (looking-at "[ \t]*$") (throw 'next nil)) (skip-chars-forward " \t") (setq ind1 (current-column)) @@ -6097,7 +6118,8 @@ (if (or (< ind1 ind) (and (= ind1 ind) (not (org-at-item-p))) - (bobp)) + (and (= (point-at-bol) (point-min)) + (setq pos (point-min)))) (throw 'exit t) (when (org-at-item-p) (setq pos (point-at-bol))))))) (goto-char pos))) @@ -6733,7 +6755,7 @@ (setq description nil)) (when (and (not description) (not (equal link (org-link-escape link)))) - (setq description link)) + (setq description (org-extract-attributes link))) (concat "[[" (org-link-escape link) "]" (if description (concat "[" description "]") "") "]")) @@ -7006,6 +7028,27 @@ (org-defkey minibuffer-local-completion-map " " 'self-insert-command) (apply 'completing-read args))) +(defun org-extract-attributes (s) + "Extract the attributes cookie from a string and set as text property." + (let (a attr (start 0)) + (save-match-data + (when (string-match "{{\\([^}]+\\)}}$" s) + (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) + (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) + (setq key (match-string 1 a) value (match-string 2 a) + start (match-end 0) + attr (plist-put attr (intern key) value)))) + (org-add-props s nil 'org-attributes attr)) + s)) + +(defun org-attributes-to-string (plist) + "Format a property list into an HTML attribute list." + (let ((s "") key value) + (while plist + (setq key (pop plist) value (pop plist)) + (setq s (concat s " "(symbol-name key) "=\"" value "\""))) + s)) + ;;; Opening/following a link (defvar org-link-search-failed nil) @@ -7106,13 +7149,18 @@ (save-excursion (skip-chars-forward "^]\n\r") (when (org-in-regexp org-bracket-link-regexp) - (setq link (org-link-unescape (org-match-string-no-properties 1))) + (setq link (org-extract-attributes + (org-link-unescape (org-match-string-no-properties 1)))) (while (string-match " *\n *" link) (setq link (replace-match " " t t link))) (setq link (org-link-expand-abbrev link)) - (if (string-match org-link-re-with-space2 link) - (setq type (match-string 1 link) path (match-string 2 link)) - (setq type "thisfile" path link)) + (cond + ((or (file-name-absolute-p link) + (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ((string-match org-link-re-with-space2 link) + (setq type (match-string 1 link) path (match-string 2 link))) + (t (setq type "thisfile" path link))) (throw 'match t))) (when (get-text-property (point) 'org-linked-text) @@ -7530,6 +7578,9 @@ (apps (append org-file-apps (org-default-apps))) (remp (and (assq 'remote apps) (org-file-remote-p file))) (dirp (if remp nil (file-directory-p file))) + (file (if (and dirp org-open-directory-means-index-dot-org) + (concat (file-name-as-directory file) "index.org") + file)) (dfile (downcase file)) (old-buffer (current-buffer)) (old-pos (point)) @@ -8586,7 +8637,7 @@ nil))) (defun org-get-repeat () - "Check if tere is a deadline/schedule with repeater in this entry." + "Check if there is a deadline/schedule with repeater in this entry." (save-match-data (save-excursion (org-back-to-heading t) @@ -9196,6 +9247,7 @@ ;;;; Tags +(defvar org-agenda-archives-mode) (defun org-scan-tags (action matcher &optional todo-only) "Scan headline tags with inheritance and produce output ACTION. @@ -9211,9 +9263,9 @@ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) - (props (list 'face nil + (props (list 'face 'default 'done-face 'org-done - 'undone-face nil + 'undone-face 'default 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -9265,8 +9317,11 @@ (org-remove-uniherited-tags (cdar tags-alist)))) (when (and (or (not todo-only) (member todo org-not-done-keywords)) (eval matcher) - (or (not org-agenda-skip-archived-trees) - (not (member org-archive-tag tags-list)))) + (or + (not (member org-archive-tag tags-list)) + ;; we have an archive tag, should we use this anyway? + (or (not org-agenda-skip-archived-trees) + (and (eq action 'agenda) org-agenda-archives-mode)))) (unless (eq action 'sparse-tree) (org-agenda-skip)) ;; select this headline @@ -9420,8 +9475,10 @@ cat-p (equal pn "CATEGORY") re-p (equal (string-to-char pv) ?{) str-p (equal (string-to-char pv) ?\") + time-p (save-match-data (string-match "^\"<.*>\"$" pv)) pv (if (or re-p str-p) (substring pv 1 -1) pv)) - (setq po (org-op-to-function po str-p)) + (if time-p (setq pv (org-matcher-time pv))) + (setq po (org-op-to-function po (if time-p 'time str-p))) (if (equal pn "CATEGORY") (setq gv '(get-text-property (point) 'org-category)) (setq gv `(org-cached-entry-get nil ,pn))) @@ -9476,21 +9533,46 @@ (cons match0 matcher))) (defun org-op-to-function (op &optional stringp) + "Turn an operator into the appropriate function." (setq op (cond - ((equal op "<" ) '(< string< )) - ((equal op ">" ) '(> org-string> )) - ((member op '("<=" "=<")) '(<= org-string<= )) - ((member op '(">=" "=>")) '(>= org-string>= )) - ((member op '("=" "==")) '(= string= )) - ((member op '("<>" "!=")) '(org<> org-string<> )))) - (nth (if stringp 1 0) op)) + ((equal op "<" ) '(< string< org-time<)) + ((equal op ">" ) '(> org-string> org-time>)) + ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) + ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) + ((member op '("=" "==")) '(= string= org-time=)) + ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) + (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) (defun org<> (a b) (not (= a b))) (defun org-string<= (a b) (or (string= a b) (string< a b))) (defun org-string>= (a b) (not (string< a b))) (defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) (defun org-string<> (a b) (not (string= a b))) +(defun org-time= (a b) (= (org-2ft a) (org-2ft b))) +(defun org-time< (a b) (< (org-2ft a) (org-2ft b))) +(defun org-time<= (a b) (<= (org-2ft a) (org-2ft b))) +(defun org-time> (a b) (> (org-2ft a) (org-2ft b))) +(defun org-time>= (a b) (>= (org-2ft a) (org-2ft b))) +(defun org-time<> (a b) (org<> (org-2ft a) (org-2ft b))) +(defun org-2ft (s) + "Convert S to a floating point time. +If S is already a number, just return it. If it is a string, parse +it as a time string and apply `float-time' to it. f S is nil, just return 0." + (cond + ((numberp s) s) + ((stringp s) + (condition-case nil + (float-time (apply 'encode-time (org-parse-time-string s))) + (error 0.))) + (t 0.))) + +(defun org-matcher-time (s) + (cond + ((equal s "<now>") (float-time)) + ((equal s "<today>") + (float-time (append '(0 0 0) (nthcdr 3 (decode-time))))) + (t (org-2ft s)))) (defun org-match-any-p (re list) "Does re match any element of list?" @@ -9998,7 +10080,8 @@ the the function returns t, FUNC will not be called for that entry and search will continue from the point where the function leaves it." - (let* ((org-agenda-skip-archived-trees (memq 'archive skip)) + (let* ((org-agenda-archives-mode nil) ; just to make sure + (org-agenda-skip-archived-trees (memq 'archive skip)) (org-agenda-skip-comment-trees (memq 'comment skip)) (org-agenda-skip-function (car (org-delete-all '(comment archive) skip))) @@ -10009,12 +10092,12 @@ ((eq match t) (setq matcher t)) ((eq match nil) (setq matcher t)) (t (setq matcher (if match (org-make-tags-matcher match) t)))) - + (when (eq scope 'tree) (org-back-to-heading t) (org-narrow-to-subtree) (setq scope nil)) - + (if (not scope) (progn (org-prepare-agenda-buffers @@ -10069,6 +10152,22 @@ (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" "Regular expression matching the first line of a property drawer.") +(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-drawer-re + (concat "\\(" org-property-start-re "\\)[^\000]*\\(" + org-property-end-re "\\)\n?") + "Matches an entire property drawer.") + +(defconst org-clock-drawer-re + (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" + org-property-end-re "\\)\n?") + "Matches an entire clock drawer.") + (defun org-property-action () "Do an action on properties." (interactive) @@ -11475,7 +11574,7 @@ date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) n2 (calendar-absolute-from-gregorian date2))) ((eq dw 'month) - ;; approx number of month between the tow dates + ;; approx number of month between the two dates (setq nmonths (floor (/ (- cday sday) 30.436875))) ;; How often does dn fit in there? (setq d (nth 1 start) m (car start) y (nth 2 start) @@ -11489,12 +11588,11 @@ (setq m2 (+ m dn) y2 y) (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) - (while (< n2 cday) + (while (<= n2 cday) (setq n1 n2 m m2 y y2) (setq m2 (+ m dn) y2 y) (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) - (if show-all (cond ((eq prefer 'past) n1) @@ -11828,14 +11926,13 @@ (buffer-list))) (delete nil blist))) -(defun org-agenda-files (&optional unrestricted ext) +(defun org-agenda-files (&optional unrestricted archives) "Get the list of agenda files. Optional UNRESTRICTED means return the full list even if a restriction is currently in place. -When EXT is non-nil, try to add all files that are created by adding EXT -to the file nemes. Basically, this is a way to add the archive files -to the list, by setting EXT to \"_archive\" If EXT is non-nil, but not -a string, \"_archive\" will be used." +When ARCHIVES is t, include all archive files hat are really being +used by the agenda files. If ARCHIVE is `ifmode', do this only if +`org-agenda-archives-mode' is t." (let ((files (cond ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) @@ -11855,16 +11952,9 @@ (lambda (file) (and (file-readable-p file) file))) files)))) - (when ext - (setq ext (if (and (stringp ext) (string-match "\\S-" ext)) - ext "_archive")) - (setq files (apply 'append - (mapcar - (lambda (f) - (if (file-exists-p (concat f ext)) - (list f (concat f ext)) - (list f))) - files)))) + (when (or (eq archives t) + (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) + (setq files (org-add-archive-files files))) files)) (defun org-edit-agenda-file-list () @@ -12327,13 +12417,15 @@ (cd dir)) (if (not (file-exists-p dvifile)) (progn (message "Failed to create dvi file from %s" texfile) nil) - (call-process "dvipng" nil nil nil - "-E" "-fg" fg "-bg" bg - "-D" dpi - ;;"-x" scale "-y" scale - "-T" "tight" - "-o" pngfile - dvifile) + (condition-case nil + (call-process "dvipng" nil nil nil + "-E" "-fg" fg "-bg" bg + "-D" dpi + ;;"-x" scale "-y" scale + "-T" "tight" + "-o" pngfile + dvifile) + (error nil)) (if (not (file-exists-p pngfile)) (progn (message "Failed to create png file from %s" texfile) nil) ;; Use the requested file name and clean up @@ -12427,7 +12519,9 @@ (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) -(org-defkey narrow-map "s" 'org-narrow-to-subtree) +(if (boundp 'narrow-map) + (org-defkey narrow-map "s" 'org-narrow-to-subtree) + (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) @@ -13220,9 +13314,6 @@ ["Cycling opens ARCHIVE trees" (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) :style toggle :selected org-cycle-open-archived-trees] - ["Agenda includes ARCHIVE trees" - (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) - :style toggle :selected (not org-agenda-skip-archived-trees)] "--" ["Move Subtree to Archive" org-advertized-archive-subtree t] ; ["Check and Move Children" (org-archive-subtree '(4)) @@ -14390,7 +14481,9 @@ (eval-after-load "imenu" '(progn (add-hook 'imenu-after-jump-hook - (lambda () (org-show-context 'org-goto))))) + (lambda () + (if (eq major-mode 'org-mode) + (org-show-context 'org-goto)))))) ;; Speedbar support @@ -14513,4 +14606,3 @@ ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here -