changeset 81837:0c50098b8fe2

Bug fixes.
author Carsten Dominik <dominik@science.uva.nl>
date Fri, 13 Jul 2007 13:14:11 +0000
parents 70f0f3b68d12
children 09c82a1bcb6f
files lisp/textmodes/org.el
diffstat 1 files changed, 130 insertions(+), 57 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/textmodes/org.el	Fri Jul 13 13:13:55 2007 +0000
+++ b/lisp/textmodes/org.el	Fri Jul 13 13:14:11 2007 +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: 5.02
+;; Version: 5.03
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -83,7 +83,7 @@
 
 ;;; Version
 
-(defconst org-version "5.02"
+(defconst org-version "5.03"
   "The version number of the file org.el.")
 (defun org-version ()
   (interactive)
@@ -489,15 +489,22 @@
   :tag "Org Edit Structure"
   :group 'org-structure)
 
-(defcustom org-special-ctrl-a nil
-  "Non-nil means `C-a' behaves specially in headlines.
+
+(defcustom org-special-ctrl-a/e nil
+  "Non-nil means `C-a' and `C-e' behave specially in headlines.
 When set, `C-a' will bring back the cursor to the beginning of the
 headline text, i.e. after the stars and after a possible TODO keyword.
 When the cursor is already at that position, another `C-a' will bring
-it to the beginning of the line."
+it to the beginning of the line.
+`C-e' will jump to the end of the headline, ignoring the presence of tags
+in the headline.  A second `C-e' will then jump to the true end of the
+line, after any tags."
   :group 'org-edit-structure
   :type 'boolean)
 
+(if (fboundp 'defvaralias)
+    (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
+
 (defcustom org-odd-levels-only nil
   "Non-nil means, skip even levels and only use odd levels for the outline.
 This has the effect that two stars are being added/taken away in
@@ -3408,8 +3415,13 @@
   '(org-level-1 org-level-2 org-level-3 org-level-4
     org-level-5 org-level-6 org-level-7 org-level-8
     ))
-(defconst org-n-levels (length org-level-faces))
-
+
+(defcustom org-n-level-faces (length org-level-faces)
+  "The number different faces to be used for headlines.
+Org-mode defines 8 different headline faces, so this can be at most 8.
+If it is less than 8, the level-1 face gets re-used for level N+1 etc."
+  :type 'number
+  :group 'org-faces)
 
 ;;; Variables for pre-computed regular expressions, all buffer local
 
@@ -3686,7 +3698,7 @@
 	  org-todo-line-regexp
 	  (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
 		  (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
-		  "\\)\\>\\)? *\\(.*\\)")
+		  "\\)\\>\\)?[ \t]*\\(.*\\)")
 	  org-nl-done-regexp
 	  (concat "\n\\*+[ \t]+"
 		  "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
@@ -4461,7 +4473,7 @@
                    '(org-do-emphasis-faces (0 nil append))
                  '(org-do-emphasis-faces)))
 	   ;; Checkboxes, similar to Frank Ruell's org-checklet.el
-	   '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
+	   '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
 	     2 'bold prepend)
 	   (if org-provide-checkbox-statistics
 	       '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
@@ -4514,7 +4526,7 @@
   "Get the right face for match N in font-lock matching of healdines."
   (setq org-l (- (match-end 2) (match-beginning 1) 1))
   (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
-  (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces))
+  (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
   (cond
    ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
    ((eq n 2) org-f)
@@ -5412,7 +5424,7 @@
 	 (^re_ (concat "\\(" outline-regexp "\\)[  \t]*"))
 
 	 (old-level (if (string-match ^re txt)
-			(- (match-end 0) (match-beginning 0))
+			(- (match-end 0) (match-beginning 0) 1)
 		      -1))
 	 (force-level (cond (level (prefix-numeric-value level))
 			    ((string-match
@@ -5706,7 +5718,7 @@
        (save-excursion
 	 (goto-char (match-end 0))
 	 (skip-chars-forward " \t")
-	 (looking-at "\\[[ X]\\]"))))
+	 (looking-at "\\[[- X]\\]"))))
 
 (defun org-toggle-checkbox (&optional arg)
   "Toggle the checkbox in the current line."
@@ -5720,7 +5732,11 @@
 	(setq beg (point) end (save-excursion (outline-next-heading) (point))))
        ((org-at-item-checkbox-p)
 	(save-excursion
-	  (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t))
+	  (replace-match
+	   (cond (arg "[-]")
+		 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
+		 (t "[ ]"))
+	   t t))
 	(throw 'exit t))
        (t (error "Not at a checkbox or heading, and no active region")))
       (save-excursion
@@ -5754,7 +5770,7 @@
 	   (end (move-marker (make-marker)
 			     (progn (outline-next-heading) (point))))
 	   (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)")
-	   (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)")
+	   (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
 	   b1 e1 f1 c-on c-off lim (cstat 0))
       (when all
 	(goto-char (point-min))
@@ -5774,7 +5790,7 @@
 	(goto-char e1)
 	(when lim
 	  (while (re-search-forward re-box lim t)
-	    (if (equal (match-string 2) "[ ]")
+	    (if (member (match-string 2) '("[ ]" "[-]"))
 		(setq c-off (1+ c-off))
 	      (setq c-on (1+ c-on))))
 	  (delete-region b1 e1)
@@ -7145,7 +7161,7 @@
 		    (setq n (concat new "|") org-table-may-need-update t)))
 	      (or (equal n o)
 		  (let (org-table-may-need-update)
-		    (replace-match n))))
+		    (replace-match n t t))))
 	  (setq org-table-may-need-update t))
 	(goto-char pos))))))
 
@@ -7316,7 +7332,6 @@
 	val)
     (forward-char 1) ""))
 
-
 (defun org-table-field-info (arg)
   "Show info about the current field, and highlight any reference at point."
   (interactive "P")
@@ -8723,7 +8738,7 @@
 	    (goto-line r1)
 	    (while (not (looking-at org-table-dataline-regexp))
 	      (beginning-of-line 2))
-	    (prog1 (org-table-get-field c1)
+	    (prog1 (org-trim (org-table-get-field c1))
 	      (if highlight (org-table-highlight-rectangle (point) (point)))))
 	;; A range, return a vector
 	;; First sort the numbers to get a regular ractangle
@@ -8743,7 +8758,8 @@
 	    (org-table-highlight-rectangle
 	     beg (progn (skip-chars-forward "^|\n") (point))))
 	;; return string representation of calc vector
-	(apply 'append (org-table-copy-region beg end))))))
+	(mapcar 'org-trim
+		(apply 'append (org-table-copy-region beg end)))))))
 
 (defun org-table-get-descriptor-line (desc &optional cline bline table)
   "Analyze descriptor DESC and retrieve the corresponding line number.
@@ -9327,10 +9343,10 @@
      ((looking-at "[ \t]")
       (goto-char pos)
       (call-interactively 'lisp-indent-line))
-     ((looking-at "[$@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
+     ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
      ((not (fboundp 'pp-buffer))
       (error "Cannot pretty-print.  Command `pp-buffer' is not available."))
-     ((looking-at "[$@0-9a-zA-Z]+ *= *'(")
+     ((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
       (goto-char (- (match-end 0) 2))
       (setq beg (point))
       (setq ind (make-string (current-column) ?\ ))
@@ -10814,9 +10830,10 @@
 	  (setq link (org-completing-read
 		      "Link: "
 		      (append
-		       (mapcar (lambda (x) (concat (car x) ":"))
+		       (mapcar (lambda (x) (list (concat (car x) ":")))
 			       (append org-link-abbrev-alist-local org-link-abbrev-alist))
-		       (mapcar (lambda (x) (concat x ":")) org-link-types))
+		       (mapcar (lambda (x) (list (concat x ":")))
+			       org-link-types))
 		      nil nil nil
 		      'tmphist
 		      (or (car (car org-stored-links)))))
@@ -11810,7 +11827,8 @@
 	     (org-startup-folded nil)
 	     org-time-was-given org-end-time-was-given x prompt char time)
 	(setq org-store-link-plist
-	      (append (list :annotation v-a :initial v-i)))
+	      (append (list :annotation v-a :initial v-i)
+		      org-store-link-plist))
 	(unless tpl (setq tpl "")	(message "No template") (ding))
 	(erase-buffer)
 	(insert (substitute-command-keys
@@ -13085,6 +13103,29 @@
 (defvar org-tags-overlay (org-make-overlay 1 1))
 (org-detach-overlay org-tags-overlay)
 
+(defun org-align-tags-here (to-col)
+  ;; Assumes that this is a headline
+  (let ((pos (point)) (col (current-column)) tags)
+    (beginning-of-line 1)
+    (if	(and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
+	     (< pos (match-beginning 2)))
+	(progn
+	  (setq tags (match-string 2))
+	  (goto-char (match-beginning 1))
+	  (insert " ")
+	  (delete-region (point) (1+ (match-end 0)))
+	  (backward-char 1)
+	  (move-to-column
+	   (max (1+ (current-column))
+		(1+ col)
+		(if (> to-col 0)
+		    to-col
+		  (- (abs to-col) (length tags))))
+	   t)
+	  (insert tags)
+	  (move-to-column (min (current-column) col) t))
+      (goto-char pos))))
+
 (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."
@@ -13123,30 +13164,31 @@
 	(while (string-match "[-+&]+" tags)
 	  ;; No boolean logic, just a list
 	  (setq tags (replace-match ":" t t tags))))
-
+      
       (if (string-match "\\`[\t ]*\\'" tags)
           (setq tags "")
 	(unless (string-match ":$" tags) (setq tags (concat tags ":")))
 	(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
-
+      
       ;; Insert new tags at the correct column
       (beginning-of-line 1)
-      (if (re-search-forward
-	   (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
-	   (point-at-eol) t)
-	  (progn
-	    (if (equal tags "")
-		(setq rpl "")
-	      (goto-char (match-beginning 0))
-	      (setq c0 (current-column) p0 (point)
-		    c1 (max (1+ c0) (if (> org-tags-column 0)
-					org-tags-column
-				      (- (- org-tags-column) (length tags))))
-		    rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
-	    (replace-match rpl t t)
-	    (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
-	    tags)
-	(error "Tags alignment failed")))))
+      (cond
+       ((and (equal current "") (equal tags "")))
+       ((re-search-forward
+	 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+	 (point-at-eol) t)
+	(if (equal tags "")
+	    (setq rpl "")
+	  (goto-char (match-beginning 0))
+	  (setq c0 (current-column) p0 (point)
+		c1 (max (1+ c0) (if (> org-tags-column 0)
+				    org-tags-column
+				  (- (- org-tags-column) (length tags))))
+		rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+	(replace-match rpl t t)
+	(and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
+	tags)
+       (t (error "Tags alignment failed"))))))
 
 (defun org-tags-completion-function (string predicate &optional flag)
   (let (s1 s2 rtn (ctable org-last-tags-completion-table)
@@ -13831,10 +13873,12 @@
   (interactive)
   (let* ((fmt org-columns-current-fmt-compiled)
 	 (beg (point-at-bol))
+	 (level-face (save-excursion
+		       (beginning-of-line 1)
+		       (looking-at "\\(\\**\\)\\(\\* \\)")
+		       (org-get-level-face 2)))
 	 (color (list :foreground 
-		      (face-attribute
-		       (or (get-text-property beg 'face) 'default)
-		       :foreground)))
+		      (face-attribute (or level-face 'default) :foreground)))
 	 props pom property ass width f string ov column)
     ;; Check if the entry is in another buffer.
     (unless props
@@ -18224,8 +18268,8 @@
 
 (defsubst org-cmp-category (a b)
   "Compare the string values of categories of strings A and B."
-  (let ((ca (or (get-text-property 1 'category a) ""))
-	(cb (or (get-text-property 1 'category b) "")))
+  (let ((ca (or (get-text-property 1 'org-category a) ""))
+	(cb (or (get-text-property 1 'org-category b) "")))
     (cond ((string-lessp ca cb) -1)
 	  ((string-lessp cb ca) +1)
 	  (t nil))))
@@ -22400,7 +22444,13 @@
 	(goto-char (match-beginning 0))
 	(self-insert-command N))
     (setq org-table-may-need-update t)
-    (self-insert-command N)))
+    (self-insert-command N)
+    (org-fix-tags-on-the-fly)))
+
+(defun org-fix-tags-on-the-fly ()
+  (when (and (equal (char-after (point-at-bol)) ?*)
+	     (org-on-heading-p))
+    (org-align-tags-here org-tags-column)))
 
 (defun org-delete-backward-char (N)
   "Like `delete-backward-char', insert whitespace at field end in tables.
@@ -22423,7 +22473,8 @@
 	;; 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)))
-    (backward-delete-char N)))
+    (backward-delete-char N)
+    (org-fix-tags-on-the-fly)))
 
 (defun org-delete-char (N)
   "Like `delete-char', but insert whitespace at field end in tables.
@@ -22448,7 +22499,8 @@
 	    ;; does not determine the width of the column.
 	    (if noalign (setq org-table-may-need-update c)))
 	(delete-char N))
-    (delete-char N)))
+    (delete-char N)
+    (org-fix-tags-on-the-fly)))
 
 ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
 (put 'org-self-insert-command 'delete-selection t)
@@ -22884,9 +22936,9 @@
      "--"
      ["Jump" org-goto t]
      "--"
-     ["C-a finds headline start"
-      (setq org-special-ctrl-a (not org-special-ctrl-a))
-      :style toggle :selected org-special-ctrl-a])
+     ["C-a/e find headline start/end"
+      (setq org-special-ctrl-a/e (not org-special-ctrl-a/e))
+      :style toggle :selected org-special-ctrl-a/e])
     ("Edit Structure"
      ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
      ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
@@ -23434,10 +23486,13 @@
 
 ;; 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?
-(defun org-beginning-of-line ()
+(defun org-beginning-of-line (&optional arg)
   "Go to the beginning of the current line.  If that is invisible, continue
-to a visible line beginning.  This makes the function of C-a more intuitive."
-  (interactive)
+to a visible line beginning.  This makes the function of C-a more intuitive.
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
+first attempt, and only move to after the tags when the cursor is already
+beyond the end of the headline."
+  (interactive "P")
   (let ((pos (point)))
     (beginning-of-line 1)
     (if (bobp)
@@ -23448,14 +23503,32 @@
 	    (backward-char 1)
 	    (beginning-of-line 1))
 	(forward-char 1)))
-    (when (and org-special-ctrl-a (looking-at org-todo-line-regexp)
+    (when (and org-special-ctrl-a/e (looking-at org-todo-line-regexp)
 	       (= (char-after (match-end 1)) ?\ ))
       (goto-char
        (cond ((> pos (match-beginning 3)) (match-beginning 3))
 	     ((= pos (point)) (match-beginning 3))
 	     (t (point)))))))
 
+(defun org-end-of-line (&optional arg)
+  "Go to the end of the line.
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
+first attempt, and only move to after the tags when the cursor is already
+beyond the end of the headline."
+  (interactive "P")
+  (if (or (not org-special-ctrl-a/e)
+	  (not (org-on-heading-p)))
+      (end-of-line arg)
+    (let ((pos (point)))
+      (beginning-of-line 1)
+      (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
+	  (if (or (< pos (match-beginning 1))
+		  (= pos (match-end 0)))
+	      (goto-char (match-beginning 1))
+	    (goto-char (match-end 0)))))))
+
 (define-key org-mode-map "\C-a" 'org-beginning-of-line)
+(define-key org-mode-map "\C-e" 'org-end-of-line)
 
 (defun org-invisible-p ()
   "Check if point is at a character currently not visible."