Mercurial > emacs
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."