[Emacs-diffs] Changes to emacs/lisp/textmodes/org.el,v

[Carsten Dominik]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Carsten Dominik <cdominik>      07/07/13 13:14:12

Index: org.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/textmodes/org.el,v
retrieving revision 1.144
retrieving revision 1.145
diff -u -b -r1.144 -r1.145
--- org.el      10 Jul 2007 07:23:03 -0000      1.144
+++ org.el      13 Jul 2007 13:14:11 -0000      1.145
@@ -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 "address@hidden *= *[^ \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 "address@hidden *= *'(")
+     ((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."
@@ -13131,10 +13172,11 @@
 
       ;; Insert new tags at the correct column
       (beginning-of-line 1)
-      (if (re-search-forward
+      (cond
+       ((and (equal current "") (equal tags "")))
+       ((re-search-forward
           (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
           (point-at-eol) t)
-         (progn
            (if (equal tags "")
                (setq rpl "")
              (goto-char (match-beginning 0))
@@ -13146,7 +13188,7 @@
            (replace-match rpl t t)
            (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
            tags)
-       (error "Tags alignment failed")))))
+       (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."