;;; org-list.el --- Plain lists for Org-mode
;;
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT gnu DOT org>
+;; Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-flag-region "outline" (from to flag))
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-previous-heading "outline" ())
+
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
-(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
-(declare-function org-inlinetask-goto-end "org-inlinetask" ())
-(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
-(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
(declare-function org-show-subtree "org" ())
+(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-trim "org" (s))
(declare-function org-uniquify "org" (list))
-(declare-function outline-invisible-p "outline" (&optional pos))
-(declare-function outline-flag-region "outline" (from to flag))
-(declare-function outline-next-heading "outline" ())
-(declare-function outline-previous-heading "outline" ())
+
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+
+(declare-function org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
+
\f
treated as text. This is the most stable way of handling this,
which is why it is the default.
-When this is the symbol `integrate', then during cycling, plain
-list items will *temporarily* be interpreted as outline headlines
-with a level given by 1000+i where i is the indentation of the
-bullet. This setting can lead to strange effects when switching
-visibility to `children', because the first \"child\" in a
-subtree decides what children should be listed. If that first
-\"child\" is a plain list item with an implied large level
-number, all true children and grand children of the outline
-heading will be exposed in a children' view."
+When this is the symbol `integrate', then integrate plain list
+items when cycling, as if they were children of outline headings.
+
+This setting can lead to strange effects when switching visibility
+to `children', because the first \"child\" in a subtree decides
+what children should be listed. If that first \"child\" is a
+plain list item with an implied large level number, all true
+children and grand children of the outline heading will be
+exposed in a children' view."
:group 'org-plain-lists
+ :group 'org-cycle
:type '(choice
(const :tag "Never" nil)
(const :tag "With cursor in plain list (recommended)" t)
For example,
(setq org-list-demote-modify-bullet
- '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
+ \\='((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
will make
(const :tag "paren like in \"2)\"" ?\))
(const :tag "both" t)))
-(defcustom org-alphabetical-lists nil
+(define-obsolete-variable-alias 'org-alphabetical-lists
+ 'org-list-allow-alphabetical "24.4") ; Since 8.0
+(defcustom org-list-allow-alphabetical nil
"Non-nil means single character alphabetical bullets are allowed.
+
Both uppercase and lowercase are handled. Lists with more than
26 items will fallback to standard numbering. Alphabetical
-counters like \"[@c]\" will be recognized."
+counters like \"[@c]\" will be recognized.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code after updating it:
+
+ (when (featurep \\='org-element) (load \"org-element\" t t))"
:group 'org-plain-lists
:version "24.1"
- :type 'boolean)
+ :type 'boolean
+ :set (lambda (var val)
+ (when (featurep 'org-element) (load "org-element" t t))
+ (set var val)))
(defcustom org-list-two-spaces-after-bullet-regexp nil
"A regular expression matching bullets that should have 2 spaces after them.
(const :tag "never" nil)
(regexp)))
-(defcustom org-empty-line-terminates-plain-lists nil
+(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists
+ 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0
+(defcustom org-list-empty-line-terminates-plain-lists nil
"Non-nil means an empty line ends all plain list levels.
Otherwise, two of them will be necessary."
:group 'org-plain-lists
implement alternative ways of collecting statistics
information.")
-(defcustom org-hierarchical-checkbox-statistics t
+(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
+ 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0
+(defcustom org-checkbox-hierarchical-statistics t
"Non-nil means checkbox statistics counts only the state of direct children.
When nil, all boxes below the cookie are counted.
This can be set to nil on a per-node basis using a COOKIE_DATA property
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-description-max-indent 20
+(org-defvaralias 'org-description-max-indent
+ 'org-list-description-max-indent) ;; Since 8.0
+(defcustom org-list-description-max-indent 20
"Maximum indentation for the second line of a description list.
When the indentation would be larger than this, it will become
5 characters instead."
(string :tag "Format"))))
(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "docbook" "html" "latex" "odt")
+ "html" "latex" "odt")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
\f
;;; Predicates and regexps
-(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n"
+(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n"
"^[ \t]*\n[ \t]*\n")
"Regex corresponding to the end of a list.
-It depends on `org-empty-line-terminates-plain-lists'.")
+It depends on `org-list-empty-line-terminates-plain-lists'.")
(defconst org-list-full-item-re
(concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
((= org-plain-list-ordered-item-terminator ?\)) ")")
((= org-plain-list-ordered-item-terminator ?.) "\\.")
(t "[.)]")))
- (alpha (if org-alphabetical-lists "\\|[A-Za-z]" "")))
+ (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" "")))
(concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
"\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
(save-excursion
(goto-char (match-end 0))
(let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?"
- (if org-alphabetical-lists
+ (if org-list-allow-alphabetical
"\\([0-9]+\\|[A-Za-z]\\)"
"[0-9]+")
"\\][ \t]*\\)")))
(context (org-list-context))
(lim-up (car context))
(drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
;; Can't use org-drawers-regexp as this function might
;; be called in buffers not in Org mode.
(beg-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$")))
(when (save-excursion
(and (not (looking-at beg-re))
will get the following structure:
-\(\(1 0 \"- \" nil \"[X]\" nil 97\)
- \(18 2 \"1. \" nil nil nil 34\)
- \(34 2 \"5. \" \"5\" nil nil 55\)
- \(97 0 \"- \" nil nil nil 131\)
- \(109 2 \"+ \" nil nil \"tag\" 131\)
+ ((1 0 \"- \" nil \"[X]\" nil 97)
+ (18 2 \"1. \" nil nil nil 34)
+ (34 2 \"5. \" \"5\" nil nil 55)
+ (97 0 \"- \" nil nil nil 131)
+ (109 2 \"+ \" nil nil \"tag\" 131))
Assume point is at an item."
(save-excursion
(text-min-ind 10000)
(item-re (org-item-re))
(drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(beg-cell (cons (point) (org-get-indentation)))
- ind itm-lst itm-lst-2 end-lst end-lst-2 struct
+ itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
(function
;; Return association at point.
(save-excursion
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((<= (point) lim-up)
;; At upward limit: if we ended at an item, store it,
;; Jump to part 2.
(throw 'exit
(setq itm-lst
- (if (or (not (looking-at item-re))
- (get-text-property (point) 'org-example))
+ (if (not (looking-at item-re))
(memq (assq (car beg-cell) itm-lst) itm-lst)
(setq beg-cell (cons (point) ind))
(cons (funcall assoc-at-point ind) itm-lst)))))
- ;; At a verbatim block, go before its beginning. Move
- ;; from eol to ensure `previous-single-property-change'
- ;; will return a value.
- ((get-text-property (point) 'org-example)
- (goto-char (previous-single-property-change
- (point-at-eol) 'org-example nil lim-up))
- (forward-line -1))
;; Looking at a list ending regexp. Dismiss useless
;; data recorded above BEG-CELL. Jump to part 2.
((looking-at org-list-end-re)
;; position of items in END-LST-2.
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
;; part 3.
(throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
- ;; At a verbatim block, move to its end. Point is at bol
- ;; and 'org-example property is set by whole lines:
- ;; `next-single-property-change' always return a value.
- ((get-text-property (point) 'org-example)
- (goto-char
- (next-single-property-change (point) 'org-example nil lim-down)))
;; Looking at a list ending regexp. Save point as an
;; ending position and jump to part 3.
((looking-at org-list-end-re)
(< ind (org-list-get-ind child-maybe struct)))
child-maybe)))
-(defun org-list-get-next-item (item struct prevs)
+(defun org-list-get-next-item (item _struct prevs)
"Return next item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
(car (rassq item prevs)))
-(defun org-list-get-prev-item (item struct prevs)
+(defun org-list-get-prev-item (item _struct prevs)
"Return previous item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
(push next-item after-item))
(append before-item (list item) (nreverse after-item))))
-(defun org-list-get-children (item struct parents)
+(defun org-list-get-children (item _struct parents)
"List all children of ITEM, or nil.
STRUCT is the list structure. PARENTS is the alist of parents,
as returned by `org-list-parents-alist'."
(defun org-list-get-bottom-point (struct)
"Return point at bottom of list.
STRUCT is the list structure."
- (apply 'max
+ (apply #'max
(mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct)))
(defun org-list-get-list-begin (item struct prevs)
org-list-two-spaces-after-bullet-regexp bullet))
" "
" ")))
- (string-match "\\S-+\\([ \t]*\\)" bullet)
- (replace-match spaces nil nil bullet 1))))
+ (if (string-match "\\S-+\\([ \t]*\\)" bullet)
+ (replace-match spaces nil nil bullet 1)
+ bullet))))
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
(point))))))))
(cond
;; Trivial cases where there should be none.
- ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
;; When `org-blank-before-new-entry' says so, it is 1.
((eq insert-blank-p t) 1)
;; `plain-list-item' is 'auto. Count blank lines separating
- ;; neighbours items in list.
+ ;; neighbors' items in list.
(t (let ((next-p (org-list-get-next-item item struct prevs)))
(cond
;; Is there a next item?
If POS is before first character after bullet of the item, the
new item will be created before the current one.
-STRUCT is the list structure. PREVS is the the alist of previous
+STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'.
Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
STRUCT is list structure. PREVS is the alist of previous items,
as returned by `org-list-prevs-alist'."
- (and org-alphabetical-lists
+ (and org-list-allow-alphabetical
(catch 'exit
(let ((item first) (ascii 64) (case-fold-search nil))
;; Pretend that bullets are uppercase and check if alphabet
;; is sufficient, taking counters into account.
(while item
- (let ((bul (org-list-get-bullet item struct))
- (count (org-list-get-counter item struct)))
+ (let ((count (org-list-get-counter item struct)))
;; Virtually determine current bullet
(if (and count (string-match "[a-zA-Z]" count))
;; Counters are not case-sensitive.
(replace-match "1" nil nil bullet))
;; Not an ordered list: keep bullet.
(t bullet)))))))))
- (mapc fix-bul (mapcar 'car struct))))
+ (mapc fix-bul (mapcar #'car struct))))
(defun org-list-struct-fix-ind (struct parents &optional bullet-size)
"Verify and correct indentation in STRUCT.
org-list-indent-offset))
;; If no parent, indent like top-point.
(org-list-set-ind item struct top-ind))))))
- (mapc new-ind (mapcar 'car (cdr struct)))))
+ (mapc new-ind (mapcar #'car (cdr struct)))))
(defun org-list-struct-fix-box (struct parents prevs &optional ordered)
"Verify and correct checkboxes in STRUCT.
all others cases, the return value will be nil.
This function modifies STRUCT."
- (let ((all-items (mapcar 'car struct))
+ (let ((all-items (mapcar #'car struct))
(set-parent-box
(function
(lambda (item)
;; There are boxes checked after an unchecked one: fix that.
(when (member "[X]" after-unchecked)
(let ((index (- (length struct) (length after-unchecked))))
- (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]"))
+ (mapc (lambda (e)
+ (when (org-list-get-checkbox e struct)
+ (org-list-set-checkbox e struct "[ ]")))
(nthcdr index all-items))
;; Verify once again the structure, without ORDERED.
(org-list-struct-fix-box struct parents prevs nil)
(item-re (org-item-re))
(shift-body-ind
(function
- ;; Shift the indentation between END and BEG by DELTA.
- ;; Start from the line before END.
- (lambda (end beg delta)
+ ;; Shift the indentation between END and BEG by DELTA. If
+ ;; MAX-IND is non-nil, ensure that no line will be indented
+ ;; more than that number. Start from the line before END.
+ (lambda (end beg delta max-ind)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
;; Shift only non-empty lines.
((org-looking-at-p "^[ \t]*\\S-")
(let ((i (org-get-indentation)))
- (org-indent-line-to (+ i delta)))))
+ (org-indent-line-to
+ (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
(forward-line -1)))))
(modify-item
(function
(indent-to new-ind)))))))
;; 1. First get list of items and position endings. We maintain
;; two alists: ITM-SHIFT, determining indentation shift needed
- ;; at item, and END-POS, a pseudo-alist where key is ending
+ ;; at item, and END-LIST, a pseudo-alist where key is ending
;; position and value point.
(let (end-list acc-end itm-shift all-ends sliced-struct)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (ind-old (org-list-get-ind pos old-struct))
- (bul-pos (org-list-get-bullet pos struct))
- (bul-old (org-list-get-bullet pos old-struct))
- (ind-shift (- (+ ind-pos (length bul-pos))
- (+ ind-old (length bul-old))))
- (end-pos (org-list-get-item-end pos old-struct)))
- (push (cons pos ind-shift) itm-shift)
- (unless (assq end-pos old-struct)
- ;; To determine real ind of an ending position that
- ;; is not at an item, we have to find the item it
- ;; belongs to: it is the last item (ITEM-UP), whose
- ;; ending is further than the position we're
- ;; interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
- (push (cons end-pos item-up) end-list)))
- (push (cons end-pos pos) acc-end)))
- old-struct)
+ (dolist (e old-struct)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (ind-old (org-list-get-ind pos old-struct))
+ (bul-pos (org-list-get-bullet pos struct))
+ (bul-old (org-list-get-bullet pos old-struct))
+ (ind-shift (- (+ ind-pos (length bul-pos))
+ (+ ind-old (length bul-old))))
+ (end-pos (org-list-get-item-end pos old-struct)))
+ (push (cons pos ind-shift) itm-shift)
+ (unless (assq end-pos old-struct)
+ ;; To determine real ind of an ending position that
+ ;; is not at an item, we have to find the item it
+ ;; belongs to: it is the last item (ITEM-UP), whose
+ ;; ending is further than the position we're
+ ;; interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons end-pos item-up) end-list)))
+ (push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
- ;; same amount of indentation. The slices are returned in
- ;; reverse order so changes modifying buffer do not change
- ;; positions they refer to.
- (setq all-ends (sort (append (mapcar 'car itm-shift)
- (org-uniquify (mapcar 'car end-list)))
+ ;; same amount of indentation. Each slice follow the pattern
+ ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
+ ;; reverse order.
+ (setq all-ends (sort (append (mapcar #'car itm-shift)
+ (org-uniquify (mapcar #'car end-list)))
'<))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
- (ind (if (assq up struct)
- (cdr (assq up itm-shift))
- (cdr (assq (cdr (assq up end-list)) itm-shift)))))
- (push (list down up ind) sliced-struct)))
+ (itemp (assq up struct))
+ (item (if itemp up (cdr (assq up end-list))))
+ (ind (cdr (assq item itm-shift)))
+ ;; If we're not at an item, there's a child of the item
+ ;; point belongs to above. Make sure this slice isn't
+ ;; moved within that child by specifying a maximum
+ ;; indentation.
+ (max-ind (and (not itemp)
+ (+ (org-list-get-ind item struct)
+ (length (org-list-get-bullet item struct))
+ org-list-indent-offset))))
+ (push (list down up ind max-ind) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
- (mapc (lambda (e)
- (unless (zerop (nth 2 e)) (apply shift-body-ind e))
- (let* ((beg (nth 1 e))
- (cell (assq beg struct)))
- (unless (or (not cell) (equal cell (assq beg old-struct)))
- (funcall modify-item beg))))
- sliced-struct))
+ (dolist (e sliced-struct)
+ (unless (and (zerop (nth 2 e)) (not (nth 3 e)))
+ (apply shift-body-ind e))
+ (let* ((beg (nth 1 e))
+ (cell (assq beg struct)))
+ (unless (or (not cell) (equal cell (assq beg old-struct)))
+ (funcall modify-item beg)))))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))
FUNCTION is applied on items in reverse order.
-As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\)
+As an example, \(org-apply-on-list \(lambda \(result) \(1+ result)) 0)
will return the number of items in the current list.
Sublists of the list are skipped. Cursor is always at the
(prevs (org-list-prevs-alist struct))
(next-item (org-list-get-next-item (point-at-bol) struct prevs)))
(unless (or next-item org-list-use-circular-motion)
- (error "Cannot move this item further down"))
+ (user-error "Cannot move this item further down"))
(if (not next-item)
(setq struct (org-list-send-item item 'begin struct))
(setq struct (org-list-swap-items item next-item struct))
(prevs (org-list-prevs-alist struct))
(prev-item (org-list-get-prev-item (point-at-bol) struct prevs)))
(unless (or prev-item org-list-use-circular-motion)
- (error "Cannot move this item further up"))
+ (user-error "Cannot move this item further up"))
(if (not prev-item)
(setq struct (org-list-send-item item 'end struct))
(setq struct (org-list-swap-items prev-item item struct)))
;; If we're in a description list, ask for the new term.
(desc (when (eq (org-list-get-list-type itemp struct prevs)
'descriptive)
- (concat (read-string "Term: ") " :: "))))
- (setq struct
- (org-list-insert-item pos struct prevs checkbox desc))
+ " :: ")))
+ (setq struct (org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
(when checkbox (org-update-checkbox-count-maybe))
(looking-at org-list-full-item-re)
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))
+ (if desc (backward-char 1))
t)))))
(defun org-list-repair ()
- "Fix indentation, bullets and checkboxes is the list at point."
+ "Fix indentation, bullets and checkboxes in the list at point."
(interactive)
(unless (org-at-item-p) (error "This is not a list"))
(let* ((struct (org-list-struct))
lim-up
lim-down
(drawer-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
"\\|" org-deadline-string
"\\|" org-clock-string "\\)"
" *[[<]\\([^]>]+\\)[]>]"))
(orderedp (org-entry-get nil "ORDERED"))
- (bounds
+ (_bounds
;; In a region, start at first item in region.
(cond
((org-region-active-p)
(bottom (copy-marker (org-list-get-bottom-point struct)))
(items-to-toggle (org-remove-if
(lambda (e) (or (< e lim-up) (> e lim-down)))
- (mapcar 'car struct))))
+ (mapcar #'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
e struct
;; If there is no box at item, leave as-is
(let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
(box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
(recursivep
- (or (not org-hierarchical-checkbox-statistics)
+ (or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
(bounds (if all
(items
(cond
((and recursivep item) (org-list-get-subtree item s))
- (recursivep (mapcar 'car s))
+ (recursivep (mapcar #'car s))
(item (org-list-get-children item s par))
(t (org-list-get-all-items
(org-list-get-top-point s) s pre))))
structs)
(cons c-on c-all)))))
(backup-end 1)
- cookies-list structs-bak box-num)
+ cookies-list structs-bak)
(goto-char (car bounds))
;; 1. Build an alist for each cookie found within BOUNDS. The
;; key will be position at beginning of cookie and values
(checked (car (nth 3 cookie)))
(total (cdr (nth 3 cookie)))
(new (if percentp
- (format "[%d%%]" (/ (* 100 checked)
- (max 1 total)))
+ (format "[%d%%]" (floor (* 100.0 checked)
+ (max 1 total)))
(format "[%d/%d]" checked total))))
(goto-char beg)
(insert new)
(t (error "Not at an item")))))
(defvar org-tab-ind-state)
+(defvar org-adapt-indentation)
(defun org-cycle-item-indentation ()
"Cycle levels of indentation of an empty item.
The first run indents the item, if applicable. Subsequent runs
(cond
((ignore-errors (org-list-indent-item-generic 1 t struct)))
((ignore-errors (org-list-indent-item-generic -1 t struct)))
- (t (error "Cannot move item"))))
+ (t (user-error "Cannot move item"))))
t))))
(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
The command prompts for the sorting type unless it has been given
to the function through the SORTING-TYPE argument, which needs to
-be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
-meaning of each character:
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the
+detailed meaning of each character:
n Numerically, by converting the beginning of the item to a number.
a Alphabetically. Only the first line of item is checked.
t By date/time, either the first active time stamp in the entry, if
any, or by the first inactive one. In a timer list, sort the timers.
+x By \"checked\" status of a check list.
Capital letters will reverse the sort order.
a function to be called with point at the beginning of the
record. It must return either a string or a number that should
serve as the sorting key for that record. It will then use
-COMPARE-FUNC to compare entries."
+COMPARE-FUNC to compare entries.
+
+Sorting is done against the visible part of the headlines, it
+ignores hidden links."
(interactive "P")
(let* ((case-func (if with-case 'identity 'downcase))
(struct (org-list-struct))
(start (org-list-get-list-begin (point-at-bol) struct prevs))
(end (org-list-get-list-end (point-at-bol) struct prevs))
(sorting-type
- (progn
- (message
- "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
- (read-char-exclusive)))
- (getkey-func (and (= (downcase sorting-type) ?f)
- (intern (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil)))))
+ (or sorting-type
+ (progn
+ (message
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
+ (read-char-exclusive))))
+ (getkey-func
+ (or getkey-func
+ (and (= (downcase sorting-type) ?f)
+ (intern (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil))))))
(message "Sorting items...")
(save-restriction
(narrow-to-region start end)
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((= dcst ?t) '<)))
+ ((= dcst ?t) '<)
+ ((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
- (beginning-of-line)))
+ (or (eobp) (beginning-of-line))))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
(when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
(cond
((= dcst ?n)
- (string-to-number (buffer-substring (match-end 0)
- (point-at-eol))))
+ (string-to-number
+ (org-sort-remove-invisible
+ (buffer-substring (match-end 0) (point-at-eol)))))
((= dcst ?a)
(funcall case-func
- (buffer-substring (match-end 0) (point-at-eol))))
+ (org-sort-remove-invisible
+ (buffer-substring
+ (match-end 0) (point-at-eol)))))
((= dcst ?t)
(cond
;; If it is a timer list, convert timer to seconds
((org-at-item-timer-p)
(org-timer-hms-to-secs (match-string 1)))
- ((or (re-search-forward org-ts-regexp (point-at-eol) t)
- (re-search-forward org-ts-regexp-both
- (point-at-eol) t))
+ ((or (save-excursion
+ (re-search-forward org-ts-regexp (point-at-eol) t))
+ (save-excursion (re-search-forward org-ts-regexp-both
+ (point-at-eol) t)))
(org-time-string-to-seconds (match-string 0)))
- (t (org-float-time now))))
+ (t (float-time now))))
+ ((= dcst ?x) (or (and (stringp (match-string 1))
+ (match-string 1))
+ ""))
((= dcst ?f)
(if getkey-func
(let ((value (funcall getkey-func)))
will be parsed as:
-\(ordered
- \(nil \"first item\"
- \(unordered
- \(nil \"sub-item one\"\)
- \(nil \"[CBON] sub-item two\"\)\)
- \"more text in first item\"\)
- \(3 \"last item\"\)\)
+ (ordered
+ (nil \"first item\"
+ (unordered
+ (nil \"sub-item one\")
+ (nil \"[CBON] sub-item two\"))
+ \"more text in first item\")
+ (3 \"last item\"))
Point is left at list end."
+ (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'.
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct))
(top (org-list-get-top-point struct))
(bottom (org-list-get-bottom-point struct))
out
- parse-item ; for byte-compiler
(get-text
(function
;; Return text between BEG and END, trimmed, with
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
(re-search-backward "#\\+ORGLST" nil t)
- (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
- (if maybe
- (throw 'exit nil)
+ (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
+ (if maybe (throw 'exit nil)
(error "Don't know how to transform this list"))))
(let* ((name (match-string 1))
(transform (intern (match-string 2)))
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
- (list (save-restriction
- (narrow-to-region top-point bottom-point)
- (org-list-parse-list)))
- beg txt)
+ (plain-list (buffer-substring-no-properties top-point bottom-point))
+ beg)
(unless (fboundp transform)
(error "No such transformation function %s" transform))
- (let ((txt (funcall transform list)))
+ (let ((txt (funcall transform plain-list)))
;; Find the insertion place
(save-excursion
(goto-char (point-min))
(unless (re-search-forward
(concat "BEGIN RECEIVE ORGLST +"
name
- "\\([ \t]\\|$\\)") nil t)
+ "\\([ \t]\\|$\\)")
+ nil t)
(error "Don't know where to insert translated list"))
(goto-char (match-beginning 0))
(beginning-of-line 2)
items (or (eval isep) ""))))))))
(concat (funcall export-sublist list 0) "\n")))
-(defun org-list-to-latex (list &optional params)
+(defun org-list-to-latex (list &optional _params)
"Convert LIST into a LaTeX list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
- :ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
- :dstart "\\begin{description}\n" :dend "\\end{description}"
- :dtstart "[" :dtend "] "
- :istart "\\item " :iend "\n"
- :icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
- (if enum
- ;; LaTeX increments counter just before
- ;; using it, so set it to the desired
- ;; value, minus one.
- (format "\\setcounter{enum%s}{%s}\n\\item "
- enum (1- counter))
- "\\item "))
- :csep "\n"
- :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
- :cbtrans "\\texttt{[-]}")
- params)))
-
-(defun org-list-to-html (list &optional params)
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-latex)
+ (org-export-string-as list 'latex t))
+
+(defun org-list-to-html (list)
"Convert LIST into a HTML list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
- :ustart "<ul>\n" :uend "\n</ul>"
- :dstart "<dl>\n" :dend "\n</dl>"
- :dtstart "<dt>" :dtend "</dt>\n"
- :ddstart "<dd>" :ddend "</dd>"
- :istart "<li>" :iend "</li>"
- :icount (format "<li value=\"%s\">" counter)
- :isep "\n" :lsep "\n" :csep "\n"
- :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
- :cbtrans "<code>[-]</code>")
- params)))
-
-(defun org-list-to-texinfo (list &optional params)
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-html)
+ (org-export-string-as list 'html t))
+
+(defun org-list-to-texinfo (list &optional _params)
"Convert LIST into a Texinfo list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
- :ustart "@enumerate\n" :uend "@end enumerate"
- :dstart "@table @asis\n" :dend "@end table"
- :dtstart " " :dtend "\n"
- :istart "@item\n" :iend "\n"
- :icount "@item\n"
- :csep "\n"
- :cbon "@code{[X]}" :cboff "@code{[ ]}"
- :cbtrans "@code{[-]}")
- params)))
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-texinfo)
+ (org-export-string-as list 'texinfo t))
(defun org-list-to-subtree (list &optional params)
"Convert LIST into an Org subtree.
LIST is as returned by `org-list-parse-list'. PARAMS is a property list
with overruling parameters for `org-list-to-generic'."
+ (defvar get-stars) (defvar org--blankp)
(let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
(level (org-reduced-level (or (org-current-level) 0)))
- (blankp (or (eq rule t)
+ (org--blankp (or (eq rule t)
(and (eq rule 'auto)
(save-excursion
(outline-previous-heading)
(org-previous-line-empty-p)))))
- (get-stars
+ (get-stars ;FIXME: Can't rename without renaming it in org.el as well!
(function
;; Return the string for the heading, depending on depth D
;; of current sub-list.
list
(org-combine-plists
'(:splice t
- :dtstart " " :dtend " "
- :istart (funcall get-stars depth)
- :icount (funcall get-stars depth)
- :isep (if blankp "\n\n" "\n")
- :csep (if blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ :dtstart " " :dtend " "
+ :istart (funcall get-stars depth)
+ :icount (funcall get-stars depth)
+ :isep (if org--blankp "\n\n" "\n")
+ :csep (if org--blankp "\n\n" "\n")
+ :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
params))))
(provide 'org-list)