Mercurial > emacs

changeset 68171:0164d7cc3832

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(org-open-file): Use mailcap for selecting an application. (org-file-apps-defaults-gnu): Use mailcap as the default for selecting an application on a UNIX system. (org-agenda-show-tags): New command. (org-table-insert-hline): Keep cursor in current table line. (org-table-convert): Offset effect of modifying `org-table-insert-hline'. (org-format-agenda-item): New optional argument TAG. (org-compile-prefix-format): Handle %T format for the tag. (org-expand-wide-chars): New function. (org-table-insert-row, org-table-insert-hline): Use `org-expand-wide-chars'. (org-open-file): Fixed bug in program launch. (org-get-time-of-day): Fixed bug with times before 1am. (org-agenda-menu): Addes tags commands.
author Carsten Dominik <dominik@science.uva.nl>
date Fri, 13 Jan 2006 11:29:17 +0000
parents c49519c91e45
children 5a58ed2a8e92
files lisp/textmodes/org.el
diffstat 1 files changed, 113 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/textmodes/org.el	Fri Jan 13 10:46:09 2006 +0000
+++ b/lisp/textmodes/org.el	Fri Jan 13 11:29:17 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.02
+;; Version: 4.03
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -81,6 +81,12 @@
 ;;
 ;; Changes since version 4.00:
 ;; ---------------------------
+;; Version 4.03
+;;    - Table alignment fixed for use with wide characters.
+;;    - `C-c -' leaves cursor in current table line.
+;;    - The current TAG can be incorporated into the agenda prefix.
+;;      See option `org-agenda-prefix-format' for details.
+;;
 ;; Version 4.02
 ;;    - Minor bug fixes and improvements around tag searches.
 ;;    - XEmacs compatibility fixes.
@@ -105,7 +111,7 @@
 
 ;;; Customization variables
 
-(defvar org-version "4.01"
+(defvar org-version "4.03"
   "The version number of the file org.el.")
 (defun org-version ()
   (interactive)
@@ -565,6 +571,7 @@
 
   %c   the category of the item, \"Diary\" for entries from the diary, or
        as given by the CATEGORY keyword or derived from the file name.
+  %T   the first tag of the item.
   %t   the time-of-day specification if one applies to the entry, in the
        format HH:MM
   %s   Scheduling/Deadline information, a short string
@@ -1012,29 +1019,7 @@
   :type 'boolean)
 
 (defconst org-file-apps-defaults-gnu
-  '((t        . emacs)
-    ("jpg"    . "xv %s")
-    ("gif"    . "xv %s")
-    ("ppm"    . "xv %s")
-    ("pgm"    . "xv %s")
-    ("pbm"    . "xv %s")
-    ("tif"    . "xv %s")
-    ("png"    . "xv %s")
-    ("ps"     . "gv %s")
-    ("ps.gz"  . "gv %s")
-    ("eps"    . "gv %s")
-    ("eps.gz" . "gv %s")
-    ("dvi"    . "xdvi %s")
-    ("mpeg"   . "plaympeg %s")
-    ("mp3"    . "plaympeg %s")
-    ("fig"    . "xfig %s")
-    ("pdf"    . "acroread %s")
-    ("doc"    . "soffice %s")
-    ("ppt"    . "soffice %s")
-    ("pps"    . "soffice %s")
-    ("html"   . "netscape -remote openURL(%s,new-window)")
-    ("htm"    . "netscape -remote openURL(%s,new-window)")
-    ("xs"     . "soffice %s"))
+  '((t . mailcap))
   "Default file applications on a UNIX/LINUX system.
 See `org-file-apps'.")
 
@@ -4186,6 +4171,7 @@
 (define-key org-agenda-mode-map "q" 'org-agenda-quit)
 (define-key org-agenda-mode-map "x" 'org-agenda-exit)
 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
+(define-key org-agenda-mode-map "T" 'org-agenda-show-tags)
 (define-key org-agenda-mode-map "n" 'next-line)
 (define-key org-agenda-mode-map "p" 'previous-line)
 (define-key org-agenda-mode-map "\C-n" 'org-agenda-next-date-line)
@@ -4232,7 +4218,9 @@
      :style toggle :selected org-agenda-follow-mode :active t]
     "--"
     ["Cycle TODO" org-agenda-todo t]
-    ["Set Tags" org-agenda-set-tags t]
+    ("Tags"
+     ["Show all Tags" org-agenda-show-tags t]
+     ["Set Tags" org-agenda-set-tags t])
     ("Reschedule"
      ["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)]
@@ -4946,7 +4934,7 @@
       (setq entries
 	    (mapcar
 	     (lambda (x)
-	       (setq x (org-format-agenda-item "" x "Diary" 'time))
+	       (setq x (org-format-agenda-item "" x "Diary" nil 'time))
 	       ;; Extend the text properties to the beginning of the line
 	       (add-text-properties
 		0 (length x)
@@ -5297,14 +5285,15 @@
 				     "\\)\\>")
 			   org-not-done-regexp)
 			 "[^\n\r]*\\)"))
-	 marker priority category
+	 marker priority category tags
 	 ee txt)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (goto-char (match-beginning 1))
       (setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
 	    category (org-get-category)
-	    txt (org-format-agenda-item "" (match-string 1) category)
+	    tags (org-get-tags-at (point))
+	    txt (org-format-agenda-item "" (match-string 1) category tags)
 	    priority
 	    (+ (org-get-priority txt)
 	       (if org-todo-kwd-priority-p
@@ -5340,7 +5329,7 @@
 			   (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
 		   0 11)))
 	 marker hdmarker deadlinep scheduledp donep tmp priority category
-	 ee txt timestr)
+	 ee txt timestr tags)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (if (not (save-match-data (org-at-date-range-p)))
@@ -5362,13 +5351,14 @@
 	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
 		  (progn
 		    (goto-char (match-end 1))
-		    (setq hdmarker (org-agenda-new-marker))
+		    (setq hdmarker (org-agenda-new-marker)
+			  tags (org-get-tags-at))
 		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
 		    (setq txt (org-format-agenda-item
 			       (format "%s%s"
 				       (if deadlinep  "Deadline:  " "")
 				       (if scheduledp "Scheduled: " ""))
-			       (match-string 1) category timestr)))
+			       (match-string 1) category tags timestr)))
 		(setq txt org-agenda-no-heading-message))
 	      (setq priority (org-get-priority txt))
 	      (add-text-properties
@@ -5417,7 +5407,7 @@
 		     (apply 'encode-time  ; DATE bound by calendar
 			    (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
 		    1 11))))
-	 marker hdmarker priority category
+	 marker hdmarker priority category tags
 	 ee txt timestr)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -5435,11 +5425,12 @@
 	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
 		  (progn
 		    (goto-char (match-end 1))
-		    (setq hdmarker (org-agenda-new-marker))
+		    (setq hdmarker (org-agenda-new-marker)
+			  tags (org-get-tags-at))
 		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
 		    (setq txt (org-format-agenda-item
 			       "Closed:    "
-			       (match-string 1) category timestr)))
+			       (match-string 1) category tags timestr)))
 		(setq txt org-agenda-no-heading-message))
 	      (setq priority 100000)
 	      (add-text-properties
@@ -5466,7 +5457,7 @@
 	 (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
-	 d2 diff pos pos1 category
+	 d2 diff pos pos1 category tags
 	 ee txt head)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -5484,6 +5475,7 @@
 		(progn
 		  (goto-char (match-end 0))
 		  (setq pos1 (match-end 1))
+		  (setq tags (org-get-tags-at pos1))
 		  (setq head (buffer-substring-no-properties
 			      (point)
 			      (progn (skip-chars-forward "^\r\n")
@@ -5491,7 +5483,7 @@
 		  (if (string-match org-looking-at-done-regexp head)
 		      (setq txt nil)
 		    (setq txt (org-format-agenda-item
-			       (format "In %3d d.: " diff) head category))))
+			       (format "In %3d d.: " diff) head category tags))))
 	      (setq txt org-agenda-no-heading-message))
 	    (when txt
 	      (add-text-properties
@@ -5527,7 +5519,7 @@
 	 (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
-	 d2 diff pos pos1 category
+	 d2 diff pos pos1 category tags
 	 ee txt head)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -5544,6 +5536,7 @@
 		(progn
 		  (goto-char (match-end 0))
 		  (setq pos1 (match-end 1))
+		  (setq tags (org-get-tags-at))
 		  (setq head (buffer-substring-no-properties
 			      (point)
 			      (progn (skip-chars-forward "^\r\n") (point))))
@@ -5551,7 +5544,7 @@
 		      (setq txt nil)
 		    (setq txt (org-format-agenda-item
 			       (format "Sched.%2dx: " (- 1 diff)) head 
-			       category))))
+			       category tags))))
 	      (setq txt org-agenda-no-heading-message))
 	    (when txt
 	      (add-text-properties
@@ -5574,7 +5567,7 @@
 			      (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)
+	 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (setq timestr (match-string 0)
@@ -5592,11 +5585,12 @@
 		(progn
 		  (setq hdmarker (org-agenda-new-marker (match-end 1)))
 		  (goto-char (match-end 1))
+		  (setq tags (org-get-tags-at))
 		  (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
 		  (setq txt (org-format-agenda-item
 			     (format (if (= d1 d2) "" "(%d/%d): ")
 				     (1+ (- d0 d1)) (1+ (- d2 d1)))
-			     (match-string 1) category
+			     (match-string 1) category tags
 			     (if (= d0 d1) timestr))))
 	      (setq txt org-agenda-no-heading-message))
 	    (add-text-properties
@@ -5643,7 +5637,7 @@
   "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 dotime noprefix)
+(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
 must be a string and replaces the `%s' specifier in the prefix format.
@@ -5654,7 +5648,7 @@
 the `%t' specifier in the format.  When DOTIME is a string, this string is
 searched for a time before TXT is.  NOPREFIX is a flag and indicates that
 only the correctly processes TXT should be returned - this is used by
-`org-agenda-change-all-lines'."
+`org-agenda-change-all-lines'. TAG can be the tag of the headline."
   (save-match-data
     ;; Diary entries sometimes have extra whitespace at the beginning
     (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
@@ -5664,6 +5658,7 @@
 			     (file-name-sans-extension
 			      (file-name-nondirectory (buffer-file-name)))
 			   "")))
+	   (tag (or (nth (1- (length tags)) tags) ""))
 	   time              ;; needed for the eval of the prefix format
 	   (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
 	   (time-of-day (and dotime (org-get-time-of-day ts)))
@@ -5704,6 +5699,7 @@
       ;; And finally add the text properties
       (add-text-properties
        0 (length rtn) (list 'category (downcase category)
+			    'tags tags
 			    'prefix-length (- (length rtn) (length txt))
 			    'time-of-day time-of-day
 			    'dotime dotime)
@@ -5732,7 +5728,7 @@
 	(unless (and remove (member time have))
 	  (setq time (int-to-string time))
 	  (push (org-format-agenda-item
-		 nil string "" ;; FIXME: put a category for the grid?
+		 nil string "" nil ;; FIXME: put a category for the grid?
 		 (concat (substring time 0 -2) ":" (substring time -2)))
 		new)
 	  (put-text-property
@@ -5746,11 +5742,12 @@
 The resulting form is returned and stored in the variable
 `org-prefix-format-compiled'."
   (setq org-prefix-has-time nil)
-  (let ((start 0) varform vars var (s format) c f opt)
+  (let ((start 0) varform vars var (s format)e c f opt)
     (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
 			 s start)
       (setq var (cdr (assoc (match-string 4 s)
-			    '(("c" . category) ("t" . time) ("s" . extra))))
+			    '(("c" . category) ("t" . time) ("s" . extra)
+			      ("T" . tag))))
 	    c (or (match-string 3 s) "")
 	    opt (match-beginning 1)
 	    start (1+ (match-beginning 0)))
@@ -5788,7 +5785,9 @@
 		   (if (match-beginning 3)
 		       (string-to-number (match-string 3 s))
 		     0)))
-	    (t1 (concat " " (int-to-string t0))))
+	    (t1 (concat " "
+			(if (< t0 100) "0" "")
+			(int-to-string t0))))
        (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
 
 (defun org-finalize-agenda-entries (list)
@@ -5842,6 +5841,14 @@
   (let* ((pri (get-text-property (point-at-bol) 'priority)))
     (message "Priority is %d" (if pri pri -1000))))
 
+(defun org-agenda-show-tags ()
+  "Show the tags applicable to the current item."
+  (interactive)
+  (let* ((tags (get-text-property (point-at-bol) 'tags)))
+    (if tags
+	(message "Tags are :%s:" (mapconcat 'identity tags ":"))
+      (message "No tags associated with this line"))))
+
 (defun org-agenda-goto (&optional highlight)
   "Go to the Org-mode file which contains the item at point."
   (interactive)
@@ -5954,7 +5961,7 @@
 `equal' against all `org-hd-marker' text properties in the file.
 If FIXFACE is non-nil, the face of each item is modified acording to
 the new TODO state."
-  (let* (props m pl undone-face done-face finish new dotime cat)
+  (let* (props m pl undone-face done-face finish new dotime cat tags)
 ;    (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
     (save-excursion
       (goto-char (point-max))
@@ -5966,7 +5973,8 @@
 	  (setq props (text-properties-at (point))
 		dotime (get-text-property (point) 'dotime)
 		cat (get-text-property (point) 'category)
-		new (org-format-agenda-item "x" newhead cat dotime 'noprefix)
+		tags (get-text-property (point) 'tags)
+		new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix)
 		pl (get-text-property (point) 'prefix-length)
 		undone-face (get-text-property (point) 'undone-face)
 		done-face (get-text-property (point) 'done-face))
@@ -6294,7 +6302,7 @@
 			(if org-tags-match-list-sublevels
 			    (make-string (1- level) ?.) "")
 			(org-get-heading))
-		       category))
+		       category tags-list))
             (goto-char lspos)
 	    (setq marker (org-agenda-new-marker))
 	    (add-text-properties
@@ -6870,11 +6878,19 @@
 	(setq cmd 'emacs)
       (setq cmd (or (cdr (assoc ext apps))
 		    (cdr (assoc t apps)))))
+    (when (eq cmd 'mailcap)
+      (require 'mailcap)
+      (mailcap-parse-mailcaps)
+      (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
+	     (command (mailcap-mime-info mime-type)))
+	(if (stringp command)
+	    (setq cmd command)
+	  (setq cmd 'emacs))))
     (cond
      ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
       (setq cmd (format cmd (concat "\"" file "\"")))
       (save-window-excursion
-	(shell-command (concat cmd " & &"))))
+	(shell-command (concat cmd " &"))))
      ((or (stringp cmd)
 	  (eq cmd 'emacs))
       (unless (equal (file-truename file) (file-truename (buffer-file-name)))
@@ -7587,7 +7603,7 @@
     (while (< (setq i (1+ i)) maxfields)   ;; Loop over all columns
       (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
       ;; maximum length
-      (push (apply 'max 1 (mapcar 'length column)) lengths)
+      (push (apply 'max 1 (mapcar 'string-width column)) lengths)
       ;; compute the fraction stepwise, ignoring empty fields
       (setq cnt 0 frac 0.0)
       (mapcar
@@ -7843,7 +7859,7 @@
     (if (looking-at "|[^|\n]+")
 	(let* ((pos (match-beginning 0))
 	       (match (match-string 0))
-	       (len (length match)))
+	       (len (string-width match)))
 	  (replace-match (concat "|" (make-string (1- len) ?\ )))
 	  (goto-char (+ 2 pos))
 	  (substring match 1)))))
@@ -8101,7 +8117,9 @@
   (interactive "P")
   (if (not (org-at-table-p))
       (error "Not at a table"))
-  (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+  (let* ((line
+	  (org-expand-wide-chars
+	   (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 	 new)
     (if (string-match "^[ \t]*|-" line)
 	(setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
@@ -8124,7 +8142,9 @@
   (interactive "P")
   (if (not (org-at-table-p))
       (error "Not at a table"))
-  (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+  (let ((line
+	 (org-expand-wide-chars
+	  (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 	(col (current-column))
 	start)
     (if (string-match "^[ \t]*|-" line)
@@ -8143,9 +8163,19 @@
     (if (equal (char-before (point)) ?+)
 	(progn (backward-delete-char 1) (insert "|")))
     (insert "\n")
-    (beginning-of-line 0)
+    (beginning-of-line (if arg 1 -1))
     (move-to-column col)))
 
+(defun org-expand-wide-chars (s)
+  "Expand wide characters to spaces."
+  (let (w a)
+    (mapconcat
+     (lambda (x)
+       (if (> (setq w (string-width (setq a (char-to-string x)))) 1)
+	   (make-string w ?\ )
+	 a))
+     s "")))
+
 (defun org-table-kill-row ()
   "Delete the current row or horizontal line from the table."
   (interactive)
@@ -8300,8 +8330,9 @@
 	  ;; insert a hline before first
 	  (goto-char beg)
 	  (org-table-insert-hline 'above)
+	  (beginning-of-line -1)
 	  ;; insert a hline after each line
-	  (while (progn (beginning-of-line 2) (< (point) end))
+	  (while (progn (beginning-of-line 3) (< (point) end))
 	    (org-table-insert-hline))
 	  (goto-char beg)
 	  (setq end (move-marker end (org-table-end)))
@@ -8390,7 +8421,7 @@
 many lines, whatever width that takes.
 The return value is a list of lines, without newlines at the end."
   (let* ((words (org-split-string string "[ \t\n]+"))
-	 (maxword (apply 'max (mapcar 'length words)))
+	 (maxword (apply 'max (mapcar 'string-width words)))
 	 w ll)
     (cond (width
 	   (org-do-wrap words (max maxword width)))
@@ -11130,10 +11161,10 @@
 
 ;; - Bindings in Org-mode map are currently
 ;;   0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t  the alphabet
-;;             abcd fgh j lmnopqrstuvwxyz ? #$   -+*/=     [] ; |,.<>~  \t  necessary bindings
+;;             abcd fgh j lmnopqrstuvwxyz!? #$   -+*/=     [] ; |,.<>~  \t  necessary bindings
 ;;                 e                                                        (?) useful from outline-mode
 ;;                     i k                 @                                expendable from outline-mode
-;;   0123456789                          !    %^&     ()_{}    "      `'    free
+;;   0123456789                               %^&     ()_{}    "      `'    free
 
 ;; Make `C-c C-x' a prefix key
 (define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))
@@ -12116,3 +12147,25 @@
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here
 
+
+(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))
+