ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-element: Refactor code

This commit is contained in:
Nicolas Goaziou 2012-02-24 20:40:53 +01:00
parent 404ede23fc
commit 752a531eb5
2 changed files with 65 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
contrib/lisp/org-element.el
View File

@ -3538,7 +3538,7 @@ in-between, if any, are siblings of the element at point."
((let ((end (org-element-property :end element))) ((let ((end (org-element-property :end element)))
(when (<= end origin) (when (<= end origin)
(if (> (point-max) end) (goto-char end) (if (> (point-max) end) (goto-char end)
(throw 'exit (if keep-trail trail element)))))) (throw 'exit (or trail element))))))
;; 2. An element containing point is always the element at ;; 2. An element containing point is always the element at
;; point. ;; point.
((not (memq type org-element-greater-elements)) ((not (memq type org-element-greater-elements))
@ -3547,44 +3547,27 @@ in-between, if any, are siblings of the element at point."
((eq type 'plain-list) ((eq type 'plain-list)
(setq struct (org-element-property :structure element) (setq struct (org-element-property :structure element)
prevs (or prevs (org-list-prevs-alist struct))) prevs (or prevs (org-list-prevs-alist struct)))
(cond (let ((beg (org-element-property :contents-begin element)))
;; 3.1. ORIGIN isn't at a list item: try to find the (if (= beg origin) (throw 'exit (or trail element))
;; smallest item containing it. ;; Find the item at this level containing ORIGIN.
((not (assq origin struct)) (let ((items (org-list-get-all-items beg struct prevs)))
(catch 'local (let (parent)
(let (parent) (catch 'local
(mapc (mapc
(lambda (item) (lambda (pos)
(let ((pos (car item))) (cond
(cond ;; Item ends before point: skip it.
;; Item ends before point: skip it. ((<= (org-list-get-item-end pos struct) origin))
((<= (org-list-get-item-end pos struct) origin)) ;; Item contains point: store is in PARENT.
;; Item contains point: store is in PARENT. ((<= pos origin) (setq parent pos))
((< pos origin) (setq parent pos)) ;; We went too far: return PARENT.
;; We went too far: return PARENT. (t (throw 'local nil)))) items))
(t ;; No parent: no item contained point, though
(setq item-flag 'item) ;; the plain list does. Point is in the blank
(throw 'local (goto-char parent)))))) ;; lines after the list: return plain list.
struct)) (if (not parent) (throw 'exit (or trail element))
;; No item contained point, though the plain list (setq item-flag 'item)
;; does. Point is in the blank lines after the list: (goto-char parent)))))))
;; return plain list.
(throw 'exit (if keep-trail trail element))))
;; 3.2. ORIGIN is at a the beginning of the first item
;; in a list. This is a special case. Return
;; plain list.
((= (org-list-get-list-begin origin struct prevs) origin)
(goto-char origin)
(let ((lst (org-element-plain-list-parser struct)))
(cond ((not keep-trail) (throw 'exit lst))
((/= (org-list-get-top-point struct) origin)
(throw 'exit (push lst trail)))
(t (throw 'exit trail)))))
;; 3.3. ORIGIN is at a list item. Parse it and return
;; it.
(t (goto-char origin)
(let ((item (org-element-item-parser struct)))
(throw 'exit (if keep-trail (push item trail) item))))))
;; 4. At any other greater element type, if point is ;; 4. At any other greater element type, if point is
;; within contents, move into it. Otherwise, return ;; within contents, move into it. Otherwise, return
;; that element. ;; that element.
@ -3593,7 +3576,7 @@ in-between, if any, are siblings of the element at point."
(let ((beg (org-element-property :contents-begin element)) (let ((beg (org-element-property :contents-begin element))
(end (org-element-property :contents-end element))) (end (org-element-property :contents-end element)))
(if (or (> beg origin) (< end origin)) (if (or (> beg origin) (< end origin))
(throw 'exit (if keep-trail trail element)) (throw 'exit (or trail element))
;; Reset trail, since we found a parent. ;; Reset trail, since we found a parent.
(when keep-trail (setq trail (list element))) (when keep-trail (setq trail (list element)))
(narrow-to-region beg end) (narrow-to-region beg end)
@ -3672,23 +3655,18 @@ Move to the previous element at the same level, when possible."
(let ((dest (save-excursion (org-backward-same-level 1) (point)))) (let ((dest (save-excursion (org-backward-same-level 1) (point))))
(if (= (point-min) dest) (error "Cannot move further up") (if (= (point-min) dest) (error "Cannot move further up")
(goto-char dest)))) (goto-char dest))))
;; At an item: unless point is at top position, move to the ;; At an item: try to move to the previous item, if any.
;; previous item, or parent item.
((and (eq type 'item) ((and (eq type 'item)
(let ((struct (org-element-property :structure element))) (let* ((struct (org-element-property :structure element))
(when (/= (org-list-get-top-point struct) beg) (prev (org-list-get-prev-item
(let ((prevs (org-list-prevs-alist struct))) beg struct (org-list-prevs-alist struct))))
(goto-char (when prev (goto-char prev)))))
(or (org-list-get-prev-item beg struct prevs)
(org-list-get-parent
beg struct (org-list-parents-alist struct)))))))))
;; In any other case, find the previous element in the ;; In any other case, find the previous element in the
;; trail and move to its beginning. If no previous element ;; trail and move to its beginning. If no previous element
;; can be found, move to headline. ;; can be found, move to headline.
(t (t (let ((prev (nth 1 trail)))
(let ((prev (nth 1 trail))) (if prev (goto-char (org-element-property :begin prev))
(if prev (goto-char (org-element-property :begin prev)) (org-back-to-heading))))))))))
(org-back-to-heading))))))))))
(defun org-element-drag-backward () (defun org-element-drag-backward ()
"Drag backward element at point." "Drag backward element at point."
@ -3754,39 +3732,35 @@ Move to the next element at the same level, when possible."
(if (eobp) (error "Cannot move further down") (if (eobp) (error "Cannot move further down")
(let* ((trail (org-element-at-point 'keep-trail)) (let* ((trail (org-element-at-point 'keep-trail))
(element (car trail)) (element (car trail))
(type (org-element-type element))
(end (org-element-property :end element))) (end (org-element-property :end element)))
(case (org-element-type element) (cond
;; At an headline, move to next headline at the same level. ;; At an headline, move to next headline at the same level.
(headline (goto-char end)) ((eq type 'headline) (goto-char end))
;; At an item, if the first of the sub-list and point is at ;; At an item. Move to the next item, if possible.
;; beginning of list, move to the end of that sub-list. ((and (eq type 'item)
;; Otherwise, move to the next item. (let* ((struct (org-element-property :structure element))
(item (prevs (org-list-prevs-alist struct))
(let* ((struct (org-element-property :structure element)) (beg (org-element-property :begin element))
(prevs (org-list-prevs-alist struct)) (next-item (org-list-get-next-item beg struct prevs)))
(beg (org-element-property :begin element)) (when next-item (goto-char next-item)))))
(next-item (org-list-get-next-item beg struct prevs))) ;; In any other case, move to element's end, unless this
(if next-item (goto-char next-item) ;; position is also the end of its parent's contents, in which
(goto-char (org-list-get-list-end beg struct prevs)) ;; case, directly jump to parent's end.
(org-skip-whitespace) (t
(beginning-of-line)))) (let ((parent
;; In any other case, move to element's end, unless this ;; Determine if TRAIL contains the real parent of ELEMENT.
;; position is also the end of its parent's contents, in which (and (> (length trail) 1)
;; case, directly jump to parent's end. (let* ((parent-candidate (car (last trail))))
(otherwise (and (memq (org-element-type parent-candidate)
(let ((parent org-element-greater-elements)
;; Determine if TRAIL contains the real parent of ELEMENT. (>= (org-element-property
(and (> (length trail) 1) :contents-end parent-candidate) end)
(let* ((parent-candidate (car (last trail)))) parent-candidate)))))
(and (memq (org-element-type parent-candidate) (cond ((not parent) (goto-char end))
org-element-greater-elements) ((= (org-element-property :contents-end parent) end)
(>= (org-element-property (goto-char (org-element-property :end parent)))
:contents-end parent-candidate) end) (t (goto-char end)))))))))
parent-candidate)))))
(cond ((not parent) (goto-char end))
((= (org-element-property :contents-end parent) end)
(goto-char (org-element-property :end parent)))
(t (goto-char end)))))))))
(defun org-element-mark-element () (defun org-element-mark-element ()
"Put point at beginning of this element, mark at end. "Put point at beginning of this element, mark at end.

8
testing/contrib/lisp/test-org-element.el
View File

@ -240,11 +240,15 @@ Outside."
Outside." Outside."
;; 5.1. At beginning of sub-list: expected to move at parent item. ;; 5.1. At beginning of sub-list: expected to move to the
;; paragraph before it.
(goto-line 4) (goto-line 4)
(org-element-backward) (org-element-backward)
(should (looking-at "- item1")) (should (looking-at "item1"))
;; 5.2. At an item in a list: expected to move at previous item. ;; 5.2. At an item in a list: expected to move at previous item.
(goto-line 8)
(org-element-backward)
(should (looking-at " - sub2"))
(goto-line 12) (goto-line 12)
(org-element-backward) (org-element-backward)
(should (looking-at "- item1")) (should (looking-at "- item1"))