Mercurial > emacs
changeset 68294:f915fc860323
(org-open-at-point): Fixed bug with matching a link.
Fixed buggy argument sequence in call to `org-view-tags'.
(org-compile-prefix-format): Set `org-prefix-has-tag'.
(org-prefix-has-tag): New variable.
(org-format-agenda-item): Remove tags from headline if
appropriate.
(org-agenda-remove-tags-when-in-prefix): New option.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Fri, 20 Jan 2006 13:53:32 +0000 |
| parents | 5d930699173f |
| children | 773cce879560 |
| files | lisp/textmodes/org.el |
| diffstat | 1 files changed, 156 insertions(+), 127 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/textmodes/org.el Fri Jan 20 13:53:08 2006 +0000 +++ b/lisp/textmodes/org.el Fri Jan 20 13:53:32 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.03 +;; Version: 4.04 ;; ;; This file is part of GNU Emacs. ;; @@ -81,6 +81,10 @@ ;; ;; Changes since version 4.00: ;; --------------------------- +;; Version 4.04 +;; - Cleanup tags display in agenda. +;; - Bug fixes. +;; ;; Version 4.03 ;; - Table alignment fixed for use with wide characters. ;; - `C-c -' leaves cursor in current table line. @@ -111,7 +115,7 @@ ;;; Customization variables -(defvar org-version "4.03" +(defvar org-version "4.04" "The version number of the file org.el.") (defun org-version () (interactive) @@ -608,7 +612,8 @@ (setq org-agenda-prefix-format \" %-11:c% s\") -See also the variable `org-agenda-remove-times-when-in-prefix'." +See also the variables `org-agenda-remove-times-when-in-prefix' and +`org-agenda-remove-tags-when-in-prefix'." :type 'string :group 'org-agenda) @@ -691,6 +696,16 @@ :group 'org-agenda :type 'boolean) +(defcustom org-agenda-remove-tags-when-in-prefix nil + "Non-nil means, the tags from copy of headline in agenda. +When this is the symbol `prefix', only remove tags when +`org-agenda-prefix-format' contains a `%T' specifier." + :group 'org-agenda + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When prefix format contains %T" prefix))) + (defgroup org-structure nil "Options concerning structure editing in Org-mode." :tag "Org Structure" @@ -1875,42 +1890,43 @@ ;; Tell the compiler about dynamically scoped variables, ;; and variables from other packages -(defvar zmacs-regions) -(defvar original-date) -(defvar org-transient-mark-mode) -(defvar org-old-auto-fill-inhibit-regexp) -(defvar orgtbl-mode-menu) -(defvar org-html-entities) -(defvar org-goto-start-pos) -(defvar org-cursor-color) -(defvar org-time-was-given) -(defvar org-ts-what) -(defvar mark-active) -(defvar timecnt) -(defvar levels-open) -(defvar title) -(defvar author) -(defvar email) -(defvar text) -(defvar entry) -(defvar date) -(defvar language) -(defvar options) -(defvar ans1) -(defvar ans2) -(defvar starting-day) -(defvar include-all-loc) -(defvar vm-message-pointer) -(defvar vm-folder-directory) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(defvar gnus-group-name) -(defvar gnus-article-current) -(defvar w3m-current-url) -(defvar org-selected-point) -(defvar calendar-mode-map) -(defvar remember-save-after-remembering) -(defvar remember-data-file) +(eval-when-compile + (defvar zmacs-regions) + (defvar original-date) + (defvar org-transient-mark-mode) + (defvar org-old-auto-fill-inhibit-regexp) + (defvar orgtbl-mode-menu) + (defvar org-html-entities) + (defvar org-goto-start-pos) + (defvar org-cursor-color) + (defvar org-time-was-given) + (defvar org-ts-what) + (defvar mark-active) + (defvar timecnt) + (defvar levels-open) + (defvar title) + (defvar author) + (defvar email) + (defvar text) + (defvar entry) + (defvar date) + (defvar language) + (defvar options) + (defvar ans1) + (defvar ans2) + (defvar starting-day) + (defvar include-all-loc) + (defvar vm-message-pointer) + (defvar vm-folder-directory) + (defvar wl-summary-buffer-elmo-folder) + (defvar wl-summary-buffer-folder-name) + (defvar gnus-group-name) + (defvar gnus-article-current) + (defvar w3m-current-url) + (defvar org-selected-point) + (defvar calendar-mode-map) + (defvar remember-save-after-remembering) + (defvar remember-data-file)) ;;; Define the mode @@ -3100,7 +3116,7 @@ (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) (progn (setq file (format (match-string 1 org-archive-location) - (file-name-nondirectory buffer-file-name)) + (file-name-nondirectory (buffer-file-name))) heading (match-string 2 org-archive-location))) (error "Invalid `org-archive-location'")) (if (> (length file) 0) @@ -4031,8 +4047,9 @@ (nthcdr 6 time0)))) (if (eq what 'calendar) (let ((cal-date - (save-match-data - (with-current-buffer "*Calendar*" + (save-excursion + (save-match-data + (set-buffer "*Calendar*") (calendar-cursor-to-date))))) (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day @@ -4285,7 +4302,7 @@ next use of \\[org-agenda]) restricted to the current file." (interactive "P") (catch 'exit - (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode))) + (let ((restrict-ok (and (buffer-file-name) (eq major-mode 'org-mode))) (custom org-agenda-custom-commands) c entry key type string) (put 'org-agenda-files 'org-restrict nil) @@ -4320,7 +4337,7 @@ (message "") (when (equal c ?1) (if restrict-ok - (put 'org-agenda-files 'org-restrict (list buffer-file-name)) + (put 'org-agenda-files 'org-restrict (list (buffer-file-name))) (error "Cannot restrict agenda to current buffer")) (message "Press key for agenda command%s" (if restrict-ok " (restricted to current file)" "")) @@ -4444,8 +4461,8 @@ (dotodo include-all) (doclosed org-agenda-show-log) (org-agenda-keep-modes keep-modes) - (entry buffer-file-name) - (org-agenda-files (list buffer-file-name)) + (entry (buffer-file-name)) + (org-agenda-files (list (buffer-file-name))) (date (calendar-current-date)) (win (selected-window)) (pos1 (point)) @@ -4672,9 +4689,10 @@ (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) (set (make-local-variable 'org-agenda-type) 'todo) + (set (make-local-variable 'last-arg) arg) (set (make-local-variable 'org-todo-keywords) kwds) (set (make-local-variable 'org-agenda-redo-command) - `(org-todo-list (or current-prefix-arg ',arg) t)) + '(org-todo-list (or current-prefix-arg last-arg) t)) (setq files (org-agenda-files) rtnall nil) (while (setq file (pop files)) @@ -4971,7 +4989,7 @@ "Make the position visible." (if (and org-disable-agenda-to-diary ;; called from org-agenda (stringp string) - buffer-file-name) + (buffer-file-name)) (setq string (org-modify-diary-entry-string string)))))) (defun org-modify-diary-entry-string (string) @@ -4983,7 +5001,7 @@ 'help-echo (format "mouse-2 or RET jump to diary file %s" - (abbreviate-file-name buffer-file-name)) + (abbreviate-file-name (buffer-file-name))) 'org-agenda-diary-link t 'org-marker (org-agenda-new-marker (point-at-bol))) string) @@ -5005,7 +5023,7 @@ If the current buffer does not, find the first agenda file." (interactive) (let ((files (append org-agenda-files (list (car org-agenda-files)))) - (tcf (if buffer-file-name (file-truename buffer-file-name))) + (tcf (if (buffer-file-name) (file-truename (buffer-file-name)))) file) (unless files (error "No agenda files")) (catch 'exit @@ -5016,28 +5034,30 @@ (throw 'exit t)))) (find-file (car org-agenda-files))))) -(defun org-agenda-file-to-end () +(defun org-agenda-file-to-end (&optional file) "Move/add the current file to the end of the agenda fiole list. -If the file is not present in the list, append it to the list. If it is -present, move it there." - (interactive) - (org-agenda-file-to-front 'to-end)) - -(defun org-agenda-file-to-front (&optional to-end) +I the file is not present in the list, it is appended ot the list. If it is +present, it is moved there." + (interactive) + (org-agenda-file-to-front 'to-end file)) + +(defun org-agenda-file-to-front (&optional to-end file) "Move/add the current file to the top of the agenda file list. -If the file is not present in the list, add it to the front. If it is -present, it move it there. With optional argument TO-END, add/move to the +If the file is not present in the list, it is added to the front. If it is +present, it is moved there. With optional argument TO-END, add/move to the end of the list." (interactive "P") - (let* ((file-alist (mapcar (lambda (x) - (cons (file-truename x) x)) - org-agenda-files)) - (ctf (file-truename buffer-file-name)) - (had (assoc ctf file-alist)) - (x (or had (cons ctf (abbreviate-file-name buffer-file-name))))) - (setq file-alist (if to-end - (append (delq x file-alist) (list x)) - (cons x (delq x file-alist)))) + (let ((file-alist (mapcar (lambda (x) + (cons (file-truename x) x)) + org-agenda-files)) + (ctf (file-truename (buffer-file-name))) + x had) + (setq x (assoc ctf file-alist) had x) + + (if (not x) (setq x (cons ctf (abbreviate-file-name (buffer-file-name))))) + (if to-end + (setq file-alist (append (delq x file-alist) (list x))) + (setq file-alist (cons x (delq x file-alist)))) (setq org-agenda-files (mapcar 'cdr file-alist)) (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) (customize-save-variable 'org-agenda-files org-agenda-files)) @@ -5050,7 +5070,7 @@ These are the files which are being checked for agenda entries. Optional argument FILE means, use this file instead of the current." (interactive) - (let* ((file (or file buffer-file-name)) + (let* ((file (or file (buffer-file-name))) (true-file (file-truename file)) (afile (abbreviate-file-name file)) (files (delq nil (mapcar @@ -5174,9 +5194,9 @@ (cond ((null org-category) (setq org-category - (if buffer-file-name + (if (buffer-file-name) (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) + (file-name-nondirectory (buffer-file-name))) "???"))) ((symbolp org-category) (symbol-name org-category)) (t org-category)) @@ -5265,6 +5285,27 @@ (throw 'exit t))) nil))) +(defun org-get-tags-at (&optional pos) + "Get a list of all headline targs 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." + (interactive) + (let (tags) + (save-excursion + (goto-char (or pos (point))) + (save-match-data + (org-back-to-heading t) + (condition-case nil + (while t + (if (looking-at "[^\r\n]+?:\\([a-zA-Z_:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") + (setq tags (append (org-split-string (match-string 1) ":") tags))) + (or org-use-tag-inheritance (error "")) + (org-up-heading-all 1)) + (error nil)))) + (message "%s" tags) + tags)) + (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil @@ -5273,7 +5314,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp (concat "[\n\r]\\*+ *\\(" (if org-select-this-todo-keyword (concat "\\<\\(" org-select-this-todo-keyword @@ -5315,7 +5356,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp (regexp-quote (substring (format-time-string @@ -5392,7 +5433,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp (concat "\\<" org-closed-string " *\\[" (regexp-quote @@ -5448,7 +5489,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp org-deadline-time-regexp) (todayp (equal date (calendar-current-date))) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar @@ -5510,7 +5551,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp org-scheduled-time-regexp) (todayp (equal date (calendar-current-date))) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar @@ -5559,7 +5600,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) marker hdmarker ee txt d1 d2 s1 s2 timestr category tags) @@ -5631,9 +5672,10 @@ (defvar org-prefix-has-time nil "A flag, set by `org-compile-prefix-format'. The flag is set if the currently compiled format contains a `%t'.") - -(defvar time) ;Needed for the eval of the prefix format. -(defvar tag) ;Presumably, same thing as above. +(defvar org-prefix-has-tag nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%T'.") + (defun org-format-agenda-item (extra txt &optional category tags dotime noprefix) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA @@ -5651,9 +5693,9 @@ (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) (let* ((category (or category org-category - (if buffer-file-name + (if (buffer-file-name) (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) + (file-name-nondirectory (buffer-file-name))) ""))) (tag (or (nth (1- (length tags)) tags) "")) time ;; needed for the eval of the prefix format @@ -5681,6 +5723,12 @@ (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_:]+:[ \t]*$" txt)) + (setq txt (replace-match "" t t txt))) + ;; Create the final string (if noprefix (setq rtn txt) @@ -5738,7 +5786,7 @@ "Compile the prefix format into a Lisp form that can be evaluated. The resulting form is returned and stored in the variable `org-prefix-format-compiled'." - (setq org-prefix-has-time nil) + (setq org-prefix-has-time nil org-prefix-has-tag nil) (let ((start 0) varform vars var (s format)e c f opt) (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" s start) @@ -5749,6 +5797,7 @@ opt (match-beginning 1) start (1+ (match-beginning 0))) (if (equal var 'time) (setq org-prefix-has-time t)) + (if (equal var 'tag) (setq org-prefix-has-tag t)) (setq f (concat "%" (match-string 2 s) "s")) (if opt (setq varform @@ -5783,7 +5832,7 @@ (string-to-number (match-string 3 s)) 0))) (t1 (concat " " - (if (< t0 100) "0" "") (if (< t0 10) "0" "") + (if (< t0 100) "0" "") (if (< t0 10) "0" "") (int-to-string t0)))) (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) @@ -5816,9 +5865,6 @@ ((< tb ta) +1) (t nil)))) -(defvar time-up) (defvar time-down) -(defvar priority-up) (defvar priority-down) -(defvar category-up) (defvar category-down) (defvar category-keep) (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." ;; The following variables will be used when the form is evaluated. @@ -6260,7 +6306,7 @@ 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + (abbreviate-file-name (buffer-file-name))))) lspos tags tags-list tags-alist (llast 0) rtn level category i txt todo marker) @@ -6551,7 +6597,10 @@ (skip-chars-backward (concat (if org-allow-space-in-links "^" "^ ") org-non-link-chars)) - (when (looking-at org-link-regexp) + (when (or (looking-at org-link-regexp) + (and (re-search-forward org-link-regexp (point-at-eol) t) + (<= (match-beginning 0) pos) + (>= (match-end 0) pos))) (setq type (match-string 1) path (match-string 2)) (throw 'match t))) @@ -6589,7 +6638,7 @@ (cond ((string= type "tags") - (org-tags-view path in-emacs)) + (org-tags-view in-emacs path)) ((string= type "camel") (org-link-search path @@ -6862,7 +6911,7 @@ If the file does not exist, an error is thrown." (setq in-emacs (or in-emacs line search)) (let* ((file (if (equal path "") - buffer-file-name + (buffer-file-name) (convert-standard-filename (org-expand-file-name path)))) (dfile (downcase file)) ext cmd apps) @@ -6893,7 +6942,7 @@ (shell-command (concat cmd " &")))) ((or (stringp cmd) (eq cmd 'emacs)) - (unless (equal (file-truename file) (file-truename buffer-file-name)) + (unless (equal (file-truename file) (file-truename (buffer-file-name))) (funcall (cdr (assq 'file org-link-frame-setup)) file)) (if line (goto-line line) (if search (org-link-search search)))) @@ -6956,7 +7005,7 @@ (save-excursion (vm-select-folder-buffer) (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) + (folder (buffer-file-name)) (subject (vm-su-subject message)) (author (vm-su-full-name message)) (message-id (vm-su-message-id message))) @@ -6987,7 +7036,7 @@ (save-excursion (save-restriction (rmail-narrow-to-non-pruned-header) - (let ((folder buffer-file-name) + (let ((folder (buffer-file-name)) (message-id (mail-fetch-field "message-id")) (author (mail-fetch-field "from")) (subject (mail-fetch-field "subject"))) @@ -7041,7 +7090,7 @@ ((eq major-mode 'org-mode) ;; Just link to current headline (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name (buffer-file-name)))) ;; Add a context search string (when (org-xor org-context-in-file-links arg) (if (save-excursion @@ -7059,10 +7108,10 @@ ))))) (setq link (org-make-link cpltxt))) - (buffer-file-name + ((buffer-file-name) ;; Just link to this file here. (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name (buffer-file-name)))) ;; Add a context string (when (org-xor org-context-in-file-links arg) (setq cpltxt @@ -7197,7 +7246,7 @@ (case-fold-search nil) (search (match-string 2 link))) (when (save-match-data - (equal (file-truename buffer-file-name) + (equal (file-truename (buffer-file-name)) (file-truename path))) (if (save-match-data (string-match (concat "^" org-camel-regexp "$") search)) @@ -7356,7 +7405,7 @@ (let ((all org-reverse-note-order) entry) (while (setq entry (pop all)) - (if (string-match (car entry) buffer-file-name) + (if (string-match (car entry) (buffer-file-name)) (throw 'exit (cdr entry)))) nil))))) @@ -10010,7 +10059,7 @@ (level 0) line txt (umax nil) (case-fold-search nil) - (filename (concat (file-name-sans-extension buffer-file-name) + (filename (concat (file-name-sans-extension (buffer-file-name)) ".txt")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) @@ -10159,7 +10208,7 @@ 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) + (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) ".txt")) (buffer (find-file-noselect filename)) (ore (concat @@ -10233,7 +10282,7 @@ org-export-with-sub-superscripts org-export-with-emphasize org-export-with-TeX-macros - (file-name-nondirectory buffer-file-name) + (file-name-nondirectory (buffer-file-name)) (if (equal org-todo-interpretation 'sequence) (mapconcat 'identity org-todo-keywords " ") "TODO FEEDBACK VERIFY DONE") @@ -10306,7 +10355,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (interactive "P") (org-export-as-html arg 'hidden) - (org-open-file buffer-file-name)) + (org-open-file (buffer-file-name))) (defun org-export-as-html-batch () "Call `org-export-as-html', may be used in batch processing as @@ -10336,7 +10385,7 @@ (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) + (filename (concat (file-name-sans-extension (buffer-file-name)) ".html")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) @@ -10999,7 +11048,7 @@ The iCalendar file will be located in the same directory as the Org-mode file, but with extension `.ics'." (interactive) - (org-export-icalendar nil buffer-file-name)) + (org-export-icalendar nil (buffer-file-name))) ;;;###autoload (defun org-export-icalendar-all-agenda-files () @@ -11036,7 +11085,7 @@ (set-buffer (org-get-agenda-file-buffer file)) (setq category (or org-category (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) + (file-name-nondirectory (buffer-file-name))))) (if (symbolp category) (setq category (symbol-name category))) (let ((standard-output ical-buffer)) (if combine @@ -12137,27 +12186,6 @@ (org-invisible-p))) (org-show-hierarchy-above))) -(defun org-get-tags-at (&optional pos) - "Get a list of all headline targs 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." - (interactive) - (let (tags) - (save-excursion - (goto-char (or pos (point))) - (save-match-data - (org-back-to-heading t) - (condition-case nil - (while t - (if (looking-at "[^\r\n]+?:\\([a-zA-Z_:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") - (setq tags (append (org-split-string (match-string 1) ":") tags))) - (or org-use-tag-inheritance (error "")) - (org-up-heading-all 1)) - (error nil)))) - (message "%s" tags) - tags)) - ;;; Finish up (provide 'org) @@ -12166,4 +12194,5 @@ ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here +