diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2010-12-19 22:03:05 +0100 |
---|---|---|
committer | Nicolas Goaziou <n.goaziou@gmail.com> | 2011-02-18 12:45:07 +0100 |
commit | 7e57111524884effcde424446c22ef58dfb2de6b (patch) | |
tree | 8e1a62ed66e72d73e473c4c2b9f78d03c3fe42be | |
parent | cad24d757d50ec83b81cd5c528c532d7922119a4 (diff) | |
download | org-mode-7e57111524884effcde424446c22ef58dfb2de6b.tar.gz |
org-list: implement new accessors to list structures
* lisp/org-list.el (org-list-get-all-items): new function
(org-list-get-all-children): new function
(org-list-get-nth): new function
(org-list-set-nth): new function
(org-list-get-ind): new function
(org-list-set-ind): new function
(org-list-get-bullet): new function
(org-list-set-bullet): new function
(org-list-get-checkbox): new function
(org-list-set-checkbox): new function
(org-list-struct-fix-bul): use new accessors
(org-list-repair): use new accessors
(org-list-indent-item-generic): make use of accessors
(org-list-get-parent): renamed from org-list-struct-get-parent
(org-list-get-child): renamed from org-list-struct-get-child
(org-list-struct-fix-ind): make use of accessors
(org-list-get-next-item): new function
(org-list-get-subtree): new function
-rw-r--r-- | lisp/org-list.el | 134 |
1 files changed, 100 insertions, 34 deletions
diff --git a/lisp/org-list.el b/lisp/org-list.el index c698d92..3d0514c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -64,6 +64,8 @@ (declare-function outline-previous-heading "outline" ()) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-sublist "org" (list start end)) +(declare-function org-remove-if-not "org" (predicate seq)) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -738,37 +740,35 @@ Return t if successful." (end (marker-position org-last-indent-end-marker)) (struct (org-list-struct beg end top (if specialp end bottom) (< arg 0))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct))) + (origins (org-list-struct-origins struct))) (cond ;; Special case: moving top-item with indent rule (specialp (let* ((level-skip (org-level-increment)) (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) + (top-ind (org-list-get-ind beg struct))) (if (< (+ top-ind offset) 0) (error "Cannot outdent beyond margin") ;; Change bullet if necessary (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) + (string-match "*" (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct (org-list-bullet-string "-"))) ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (let ((anc (caar struct))) + (org-list-set-ind anc struct (+ (org-list-get-ind anc struct) + offset))) (org-list-struct-fix-struct struct origins) (org-list-struct-apply-struct struct end)))) ;; Forbidden move ((and (< arg 0) (or (and no-subtree (not regionp) - (org-list-struct-get-child beg-item struct)) + (org-list-get-child beg origins)) (let ((last-item (save-excursion (goto-char end) (skip-chars-backward " \r\t\n") - (goto-char (org-get-item-beginning)) - (org-list-struct-assoc-at-point)))) - (org-list-struct-get-child last-item struct)))) + (org-get-item-beginning)))) + (org-list-get-child last-item origins)))) (error "Cannot outdent an item without its children")) ;; Normal shifting (t @@ -1244,17 +1244,82 @@ STRUCT is the list's structure looked up." (t (cons item-pos (cdar acc)))))))) (cons '(0 . 0) (mapcar get-origins (cdr struct))))) -(defun org-list-struct-get-parent (item struct origins) - "Return parent association of ITEM in STRUCT or nil. +(defun org-list-get-parent (item origins) + "Return parent of ITEM or nil. ORIGINS is the alist of parents. See `org-list-struct-origins'." - (let* ((parent-pos (cdr (assq (car item) origins)))) - (when (> parent-pos 0) (assq parent-pos struct)))) + (let* ((parent (cdr (assq item origins)))) + (and (> parent 0) parent))) -(defun org-list-struct-get-child (item struct) - "Return child association of ITEM in STRUCT or nil." - (let ((ind (nth 1 item)) - (next-item (cadr (member item struct)))) - (when (and next-item (> (nth 1 next-item) ind)) next-item))) +(defun org-list-get-child (item origins) + "Return child of ITEM or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (car (rassq item origins))) + +(defun org-list-get-next-item (item origins) + "Return next item at same level of ITEM or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (unless (zerop item) + (let ((parent (cdr (assq item origins)))) + (car (rassq parent (cdr (member (assq item origins) origins))))))) + +(defun org-list-get-subtree (item origins) + "Return all items with ITEM as a common ancestor or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let ((next (org-list-get-next-item item origins))) + (if next + (let ((len (length origins)) + (orig-car (mapcar 'car origins))) + (cdr (org-sublist orig-car + (- len (1- (length (memq item orig-car)))) + (- len (length (memq next orig-car)))))) + (mapcar 'car (cdr (member (assq item origins) origins)))))) + +(defun org-list-get-all-items (item origins) + "List of items in the same sub-list as ITEM. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let ((anc (cdr (assq item origins)))) + (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) anc)) origins)))) + +(defun org-list-get-all-children (item origins) + "List all children of ITEM, or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) item)) origins))) + +(defun org-list-get-nth (n key struct) + "Return the Nth value of KEY in STRUCT." + (nth n (assq key struct))) + +(defun org-list-set-nth (n key struct new) + "Set the Nth value of KEY in STRUCT to NEW. +\nThis function modifies STRUCT." + (setcar (nthcdr n (assq key struct)) new)) + +(defun org-list-get-ind (item struct) + "Return indentation of ITEM in STRUCT." + (org-list-get-nth 1 item struct)) + +(defun org-list-set-ind (item struct ind) + "Set indentation of ITEM in STRUCT to IND. +\nThis function modifies STRUCT." + (org-list-set-nth 1 item struct ind)) + +(defun org-list-get-bullet (item struct) + "Return bullet of ITEM in STRUCT." + (org-list-get-nth 2 item struct)) + +(defun org-list-set-bullet (item struct bullet) + "Set bullet of ITEM in STRUCT to BULLET. +\nThis function modifies STRUCT." + (org-list-set-nth 2 item struct bullet)) + +(defun org-list-get-checkbox (item struct) + "Return checkbox of ITEM in STRUCT or nil." + (org-list-get-nth 4 item struct)) + +(defun org-list-set-checkbox (item struct checkbox) + "Set checkbox of ITEM in STRUCT to CHECKBOX. +\nThis function modifies STRUCT." + (org-list-set-nth 4 item struct checkbox)) (defun org-list-struct-fix-bul (struct origins) "Verify and correct bullets for every association in STRUCT. @@ -1287,10 +1352,10 @@ This function modifies STRUCT." (let* ((prev-bul (cdr orig-ref)) (new-bul (funcall get-bul item prev-bul))) (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) - (funcall set-bul item new-bul)) + (org-list-set-bullet (car item) struct new-bul)) ;; A new list is starting (let ((new-bul (funcall init-bul item))) - (funcall set-bul item new-bul) + (org-list-set-bullet (car item) struct new-bul) (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))) @@ -1301,19 +1366,21 @@ This function modifies STRUCT." ORIGINS is the alist of parents. See `org-list-struct-origins'. This function modifies STRUCT." - (let* ((headless (cdr struct)) - (ancestor (car struct)) - (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) + (let* ((ancestor (caar struct)) + (top-ind (+ (org-list-get-ind ancestor struct) + (length (org-list-get-bullet ancestor struct)))) (new-ind (lambda (item) - (let* ((parent (org-list-struct-get-parent item headless origins))) + (let ((parent (org-list-get-parent item origins))) (if parent ;; Indent like parent + length of parent's bullet - (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) - (cddr item))) + (org-list-set-ind item + struct + (+ (length (org-list-get-bullet parent struct)) + (org-list-get-ind parent struct))) ;; If no parent, indent like top-point - (setcdr item (cons top-ind (cddr item)))))))) - (mapc new-ind headless))) + (org-list-set-ind item struct top-ind)))))) + (mapc new-ind (mapcar 'car (cdr struct))))) (defun org-list-struct-fix-struct (struct origins) "Return STRUCT with correct bullets and indentation. @@ -1629,9 +1696,8 @@ Item's body is not indented, only shifted with the bullet." fixed-struct) (if (stringp force-bullet) (let ((begin (nth 1 struct))) - (setcdr begin (list (nth 1 begin) - (org-list-bullet-string force-bullet) - (nth 3 begin))) + (org-list-set-bullet (car begin) struct + (org-list-bullet-string force-bullet)) (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins)))) (setq fixed-struct (org-list-struct-fix-struct struct origins))) |