Merge branch 'master' of orgmode.org:org-mode

Code Cleanup of org-e-man.el and org-e-groff.el
This commit is contained in:
Luis Anaya 2012-08-08 06:06:17 -04:00
commit 4983e86444
6 changed files with 97 additions and 45 deletions

View File

@ -185,7 +185,7 @@ oldorg: # do what the old Makfile did by default
(setq org-version (substring git0 8))
(setq org-version git0))))
(cd origin)))))
(message "org-fixup.el: redefined org version.")
(message "org-fixup.el: redefined Org version")
`(progn
(defun org-release () ,org-version)
(defun org-git-version () ,org-git-version))))

View File

@ -2062,10 +2062,11 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
(substitute-key-definition 'next-line 'org-agenda-next-line
org-agenda-mode-map global-map)
(substitute-key-definition 'previous-line 'org-agenda-previous-line
@ -2074,7 +2075,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-show-priority)
(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
@ -3894,10 +3895,10 @@ given in `org-agenda-start-on-weekday'."
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t))
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(if rtnall (insert ;; all entries
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall ndays todayp))
(org-finalize-agenda-entries rtnall)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@ -7257,6 +7258,29 @@ When called with a prefix argument, include all archive files as well."
(call-interactively 'previous-line)
(org-agenda-do-context-action))
(defun org-agenda-next-item (n)
"Move cursor to next agenda item."
(interactive "p")
(let ((col (current-column)))
(dotimes (c n)
(when (next-single-property-change (point-at-eol) 'org-marker)
(move-end-of-line 1)
(goto-char (next-single-property-change (point) 'org-marker))))
(org-move-to-column col))
(org-agenda-do-context-action))
(defun org-agenda-previous-item (n)
"Move cursor to next agenda item."
(interactive "p")
(dotimes (c n)
(let ((col (current-column))
(goto (save-excursion
(move-end-of-line 0)
(previous-single-property-change (point) 'org-marker))))
(if goto (goto-char goto))
(org-move-to-column col)))
(org-agenda-do-context-action))
(defun org-agenda-do-context-action ()
"Show outline path and, maybe, follow mode window."
(let ((m (org-get-at-bol 'org-marker)))

View File

@ -981,10 +981,12 @@ Assume point is at the beginning of the item."
64))
((string-match "[0-9]+" c)
(string-to-number (match-string 0 c))))))
(end (org-list-get-item-end begin struct))
(end (save-excursion (goto-char (org-list-get-item-end begin struct))
(unless (bolp) (forward-line))
(point)))
(contents-begin (progn (looking-at org-list-full-item-re)
(goto-char (match-end 0))
(org-skip-whitespace)
(skip-chars-forward " \r\t\n" limit)
;; If first line isn't empty,
;; contents really start at the text
;; after item's meta-data.
@ -1039,10 +1041,10 @@ CONTENTS is the contents of the element."
(concat
bullet
(and counter (format "[@%d] " counter))
(cond
((eq checkbox 'on) "[X] ")
((eq checkbox 'off) "[ ] ")
((eq checkbox 'trans) "[-] "))
(case checkbox
(on "[X] ")
(off "[ ] ")
(trans "[-] "))
(and tag (format "%s :: " tag))
(let ((contents (replace-regexp-in-string
"\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
@ -1072,14 +1074,11 @@ Assume point is at the beginning of the list."
(keywords (org-element--collect-affiliated-keywords))
(begin (car keywords))
(contents-end
(goto-char (org-list-get-list-end (point) struct prevs)))
(end (save-excursion (org-skip-whitespace)
(if (eobp) (point) (point-at-bol)))))
;; Blank lines below list belong to the top-level list only.
(unless (= (org-list-get-top-point struct) contents-begin)
(setq end (min (org-list-get-bottom-point struct)
(progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (point-at-bol))))))
(progn (goto-char (org-list-get-list-end (point) struct prevs))
(unless (bolp) (forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (point-at-bol)))))
;; Return value.
(list 'plain-list
(nconc
@ -4076,31 +4075,35 @@ first element of current section."
(org-element-put-property element :parent parent)
(when keep-trail (push element trail))
(cond
;; 1. Skip any element ending before point or at point
;; because the following element has started. On the
;; other hand, if the element ends at point and that
;; point is also the end of the buffer, do not skip it.
((let ((end (org-element-property :end element)))
(when (or (< end origin)
(and (= end origin) (/= (point-max) end)))
(if (> (point-max) end) (goto-char end)
(throw 'exit (if keep-trail trail element))))))
;; 1. Skip any element ending before point. Also skip
;; element ending at point when we're sure that another
;; element has started.
((let ((elem-end (org-element-property :end element)))
(when (or (< elem-end origin)
(and (= elem-end origin) (/= elem-end end)))
(goto-char elem-end))))
;; 2. An element containing point is always the element at
;; point.
((not (memq type org-element-greater-elements))
(throw 'exit (if keep-trail trail element)))
;; 3. At any other greater element type, if point is
;; within contents, move into it. Otherwise, return
;; that element. As a special case, when ORIGIN is
;; contents end and is also the end of the buffer, try
;; to move inside the greater element to find the end
;; of the innermost element.
;; within contents, move into it.
(t
(let ((cbeg (org-element-property :contents-begin element))
(cend (org-element-property :contents-end element)))
(if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
(and (= cend origin) (/= (point-max) origin))
(and (= cbeg origin) (memq type '(plain-list table))))
;; Create an anchor for tables and plain lists:
;; when point is at the very beginning of these
;; elements, ignoring affiliated keywords,
;; target them instead of their contents.
(and (= cbeg origin) (memq type '(plain-list table)))
;; When point is at contents end, do not move
;; into elements with an explicit ending, but
;; return that element instead.
(and (= cend origin)
(memq type
'(center-block drawer dynamic-block inlinetask
quote-block special-block))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type

View File

@ -20682,11 +20682,11 @@ This puts point at the start of the current subtree, and mark at
the end. If a numeric prefix UP is given, move up into the
hierarchy of headlines by UP levels before marking the subtree."
(interactive "P")
(when (org-with-limited-levels (org-before-first-heading-p))
(error "Not currently in a subtree"))
(if (org-at-heading-p) (beginning-of-line)
(org-with-limited-levels (outline-previous-visible-heading 1)))
(when up (dotimes (c (abs up)) (ignore-errors (org-element-up))))
(org-with-limited-levels
(cond ((org-at-heading-p) (beginning-of-line))
((org-before-first-heading-p) (error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
(when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
(org-element-mark-element))
;;; Indentation
@ -21718,8 +21718,8 @@ clocking lines, and drawers."
(defun org-forward-same-level (arg &optional invisible-ok)
"Move forward to the arg'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading.
Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
it wil also look at invisible ones."
Normally this only looks at visible headings, but when INVISIBLE-OK is
non-nil it will also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
(org-at-heading-p)

View File

@ -2263,6 +2263,13 @@ Paragraph \\alpha."
(eq 'plain-list
(org-test-with-temp-text "- item"
(org-element-type (org-element-at-point)))))
;; Special case: at the closing line of a greater element, be sure
;; to return it instead of the last element in its contents.
(should
(eq 'center-block
(org-test-with-temp-text "#+BEGIN_CENTER\nParagraph\n#+END_CENTER"
(progn (forward-line 2)
(org-element-type (org-element-at-point))))))
;; With an optional argument, return trail.
(should
(equal '(paragraph center-block)

View File

@ -151,6 +151,15 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
(goto-char (point-max))
(org-fill-paragraph)
(buffer-string)))))
;; Correctly fill the last paragraph of a greater element.
(should
(equal "#+BEGIN_CENTER\n- 012345\n 789\n#+END_CENTER"
(org-test-with-temp-text "#+BEGIN_CENTER\n- 012345 789\n#+END_CENTER"
(let ((fill-column 8))
(forward-line)
(end-of-line)
(org-fill-paragraph)
(buffer-string)))))
;; Special case: Fill first paragraph when point is at an item or
;; a plain-list or a footnote reference.
(should
@ -354,9 +363,18 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
(progn (transient-mark-mode 1)
(forward-line 2)
(org-mark-subtree 1)
(list (region-beginning) (region-end)))))))
(list (region-beginning) (region-end))))))
;; Do not get fooled with inlinetasks.
(when (featurep 'org-inlinetask)
(should
(= 1
(org-test-with-temp-text "* Headline\n*************** Task\nContents"
(progn (transient-mark-mode 1)
(forward-line 1)
(let ((org-inlinetask-min-level 15)) (org-mark-subtree))
(region-beginning))))))
(provide 'test-org)
(provide 'test-org))
;;; test-org.el ends here