;;; org-list.el --- Plain lists for Org-mode
;;
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT altern DOT org>
+;; Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
;; This file contains the code dealing with plain lists in Org-mode.
-;; The fundamental idea behind lists work is to use structures.
-;; A structure is a snapshot of the list, in the shape of data tree
-;; (see `org-list-struct').
+;; The core concept behind lists is their structure. A structure is
+;; a snapshot of the list, in the shape of a data tree (see
+;; `org-list-struct').
;; Once the list structure is stored, it is possible to make changes
-;; directly on it or get useful information about the list, with the
-;; two helper functions, namely `org-list-parents-alist' and
-;; `org-list-prevs-alist', and using accessors or methods.
+;; on it that will be mirrored to the real list or to get information
+;; about the list, using accessors and methods provided in the
+;; library. Most of them require the use of one or two helper
+;; functions, namely `org-list-parents-alist' and
+;; `org-list-prevs-alist'.
;; Structure is eventually applied to the buffer with
;; `org-list-write-struct'. This function repairs (bullets,
-;; indentation, checkboxes) the structure before applying it. It
-;; should be called near the end of any function working on
-;; structures.
+;; indentation, checkboxes) the list in the process. It should be
+;; called near the end of any function working on structures.
;; Thus, a function applying to lists should usually follow this
;; template:
;; 1. Verify point is in a list and grab item beginning (with the same
;; function `org-in-item-p'). If the function requires the cursor
-;; to be at item's bullet, `org-at-item-p' is more selective. If
-;; the cursor is amidst the buffer, it is possible to find the
-;; closest item with `org-list-search-backward', or
-;; `org-list-search-forward', applied to `org-item-beginning-re'.
+;; to be at item's bullet, `org-at-item-p' is more selective. It
+;; is also possible to move point to the closest item with
+;; `org-list-search-backward', or `org-list-search-forward',
+;; applied to the function `org-item-beginning-re'.
;; 2. Get list structure with `org-list-struct'.
;; 4. Proceed with the modifications, using methods and accessors.
;; 5. Verify and apply structure to buffer, using
-;; `org-list-write-struct'. Possibly use
-;; `org-update-checkbox-count-maybe' if checkboxes might have been
-;; modified.
+;; `org-list-write-struct'.
-;; Computing a list structure can be a costly operation on huge lists
-;; (a few thousand lines long). Thus, code should follow the rule :
+;; 6. If changes made to the list might have modified check-boxes,
+;; call `org-update-checkbox-count-maybe'.
+
+;; Computing a structure can be a costly operation on huge lists (a
+;; few thousand lines long). Thus, code should follow the rule:
;; "collect once, use many". As a corollary, it is usually a bad idea
;; to use directly an interactive function inside the code, as those,
;; being independent entities, read the whole list structure another
(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-over-empty-lines "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-count "org" (cl-item cl-seq))
(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-on-heading-p "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-previous-line-empty-p "org" ())
(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
;;; Configuration variables
(defgroup org-plain-lists nil
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)
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
- (const :tab "both" t)))
+ (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
- :type 'boolean)
+ :version "24.1"
+ :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-list-ending-method 'both
- "Determine where plain lists should end.
-Valid values are: `regexp', `indent' or `both'.
-
-When set to `regexp', Org will look into two variables,
-`org-empty-line-terminates-plain-lists' and the more general
-`org-list-end-regexp', to determine what will end lists.
-
-When set to `indent', a list will end whenever a line following
-an item, but not starting one, is less or equally indented than
-the first item of the list.
-
-When set to `both', each of the preceding methods is applied to
-determine lists endings. This is the default method."
- :group 'org-plain-lists
- :type '(choice
- (const :tag "With a regexp defining ending" regexp)
- (const :tag "With indentation of regular (no bullet) text" indent)
- (const :tag "With both methods" both)))
-
-(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.
-This variable only makes sense if `org-list-ending-method' is set
-to `regexp' or `both'. This is then equivalent to set
-`org-list-end-regexp' to \"^[ \\t]*$\"."
+Otherwise, two of them will be necessary."
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
- "Regexp matching the end of all plain list levels.
-It must start with \"^\" and end with \"\\n\". It defaults to 2
-blank lines. `org-empty-line-terminates-plain-lists' has
-precedence over it."
- :group 'org-plain-lists
- :type 'string)
-
-(defcustom org-list-automatic-rules '((bullet . t)
- (checkbox . t)
+(defcustom org-list-automatic-rules '((checkbox . t)
(indent . t))
"Non-nil means apply set of rules when acting on lists.
By default, automatic actions are taken when using
\\[org-meta-return], \\[org-metaright], \\[org-metaleft],
\\[org-shiftmetaright], \\[org-shiftmetaleft],
\\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
- \\[org-insert-todo-heading]. You can disable individually these
+ \\[org-insert-todo-heading]. You can disable individually these
rules by setting them to nil. Valid rules are:
-bullet when non-nil, cycling bullet do not allow lists at
- column 0 to have * as a bullet and descriptions lists
- to be numbered.
checkbox when non-nil, checkbox statistics is updated each time
you either insert a new checkbox or toggle a checkbox.
- It also prevents from inserting a checkbox in a
- description item.
indent when non-nil, indenting or outdenting list top-item
with its subtree will move the whole list and
outdenting a list whose bullet is * to column 0 will
change that bullet to \"-\"."
- :group 'org-plain-lists
- :type '(alist :tag "Sets of rules"
- :key-type
- (choice
- (const :tag "Bullet" bullet)
- (const :tag "Checkbox" checkbox)
- (const :tag "Indent" indent))
- :value-type
- (boolean :tag "Activate" :value t)))
+ :group 'org-plain-lists
+ :version "24.1"
+ :type '(alist :tag "Sets of rules"
+ :key-type
+ (choice
+ (const :tag "Checkbox" checkbox)
+ (const :tag "Indent" indent))
+ :value-type
+ (boolean :tag "Activate" :value t)))
(defcustom org-list-use-circular-motion nil
"Non-nil means commands implying motion in lists should be cyclic.
\\[org-move-item-down], \\[org-next-item] and
\\[org-previous-item]."
:group 'org-plain-lists
+ :version "24.1"
:type 'boolean)
(defvar org-checkbox-statistics-hook nil
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."
By setting this to a small number, usually 1 or 2, one can more
clearly distinguish sub-items in a list."
:group 'org-plain-lists
+ :version "24.1"
:type 'integer)
(defcustom org-list-radio-list-templates
(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.")
`org-list-forbidden-blocks'.")
+\f
;;; Predicates and regexps
-(defconst org-list-end-re (if org-empty-line-terminates-plain-lists
- "^[ \t]*\n"
- org-list-end-regexp)
+(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]+\\)"
+ (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?"
"\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?")
"Matches a list item and puts everything into groups:
group 1: bullet
((= 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]*\\)")))
(not (org-in-block-p org-list-forbidden-blocks)))
(defun org-in-item-p ()
- "Return item beginning position when in a plain list, nil otherwise.
-This checks `org-list-ending-method'."
+ "Return item beginning position when in a plain list, nil otherwise."
(save-excursion
(beginning-of-line)
(let* ((case-fold-search t)
;; to compute its boundaries END-BOUNDS. When point is
;; in-between, move cursor before regexp beginning.
(let ((hl 0) (i -1) end-bounds)
- (when (and (not (eq org-list-ending-method 'indent))
- (progn
+ (when (and (progn
(while (setq i (string-match
"[\r\n]" org-list-end-re (1+ i)))
(setq hl (1+ hl)))
(< (point) (cdr end-bounds)))
(goto-char (car end-bounds))
(forward-line -1)))
- ;; Look for an item, less indented that reference line if
- ;; `org-list-ending-method' isn't `regexp'.
+ ;; Look for an item, less indented that reference line.
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(cond
;; This is exactly what we want.
- ((and (looking-at item-re)
- (or (< ind ind-ref)
- (eq org-list-ending-method 'regexp)))
+ ((and (looking-at item-re) (< ind ind-ref))
(throw 'exit (point)))
;; At upper bound of search or looking at the end of a
;; previous list: search is over.
((<= (point) lim-up) (throw 'exit nil))
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
- (throw 'exit nil))
+ ((looking-at org-list-end-re) (throw 'exit nil))
;; Skip blocks, drawers, inline-tasks, blank lines
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
(defun org-at-item-description-p ()
"Is point at a description list item?"
- (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
+ (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)"))
(defun org-at-item-checkbox-p ()
"Is point at a line starting a plain-list item with a checklet?"
(match-string 2)))
+\f
;;; Structures and helper functions
(defun org-list-context ()
;; Return association at point.
(lambda (ind)
(looking-at org-list-full-item-re)
- (list (point)
- ind
- (match-string-no-properties 1) ; bullet
- (match-string-no-properties 2) ; counter
- (match-string-no-properties 3) ; checkbox
- (match-string-no-properties 4))))) ; description tag
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data (string-match "[-+*]" bullet))
+ (match-string-no-properties 4)))))))
(end-before-blank
(function
;; Ensure list ends at the first blank line.
(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.
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
+ ((looking-at org-list-end-re)
(throw 'exit
(setq itm-lst
(memq (assq (car beg-cell) itm-lst) itm-lst))))
((looking-at item-re)
(push (funcall assoc-at-point ind) itm-lst)
(push (cons ind (point)) end-lst)
- (when (or (and (eq org-list-ending-method 'regexp)
- (<= ind (cdr beg-cell)))
- (< ind text-min-ind))
- (setq beg-cell (cons (point) ind)))
+ (when (< ind text-min-ind) (setq beg-cell (cons (point) ind)))
(forward-line -1))
;; Skip blocks, drawers, inline tasks, blank lines.
((and (looking-at "^[ \t]*#\\+end_")
(forward-line -1))
((looking-at "^[ \t]*$")
(forward-line -1))
- ;; From there, point is not at an item. Unless ending
- ;; method is `regexp', interpret line's indentation:
+ ;; From there, point is not at an item. Interpret
+ ;; line's indentation:
;; - text at column 0 is necessarily out of any list.
;; Dismiss data recorded above BEG-CELL. Jump to
;; part 2.
;; - any other case may be an ending position for an
;; hypothetical item above. Store it and proceed.
- ((eq org-list-ending-method 'regexp) (forward-line -1))
((zerop ind)
(throw 'exit
(setq itm-lst
;; equally indented than BEG-CELL's cdr. Also, store ending
;; position of items in END-LST-2.
(catch 'exit
- (while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
- (cond
- ((>= (point) lim-down)
+ (while t
+ (let ((ind (org-get-indentation)))
+ (cond
+ ((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
;; list. Save point as an ending position, and jump to
;; part 3.
- (throw 'exit
+ (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.
- ((and (not (eq org-list-ending-method 'indent))
- (looking-at org-list-end-re))
+ ((looking-at org-list-end-re)
(throw 'exit (push (cons 0 (point)) end-lst-2)))
((looking-at item-re)
;; Point is at an item. Add data to ITM-LST-2. It may
;; Ind is lesser or equal than BEG-CELL's. The list is
;; over: store point as an ending position and jump to
;; part 3.
- ((and (not (eq org-list-ending-method 'regexp))
- (<= ind (cdr beg-cell)))
+ ((<= ind (cdr beg-cell))
(throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
;; Else, if ind is lesser or equal than previous item's,
;; this is an ending position: store it. In any case,
;; skip block or drawer at point, and move to next line.
(t
- (when (and (not (eq org-list-ending-method 'regexp))
- (<= ind (nth 1 (car itm-lst-2))))
+ (when (<= ind (nth 1 (car itm-lst-2)))
(push (cons ind (point)) end-lst-2))
(cond
((and (looking-at "^[ \t]*#\\+begin_")
(forward-line 1))))))
(setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
end-lst (append end-lst (cdr (nreverse end-lst-2))))
- ;; 3. Correct ill-formed lists by ensuring top item is the least
- ;; indented.
- (let ((min-ind (nth 1 (car struct))))
- (mapc (lambda (item)
- (let ((ind (nth 1 item))
- (bul (nth 2 item)))
- (when (< ind min-ind)
- (setcar (cdr item) min-ind)
- ;; Trim bullet so item will be seen as different
- ;; when compared with repaired version.
- (setcar (nthcdr 2 item) (org-trim bul)))))
- struct))
- ;; 4. Associate each item to its end pos.
+ ;; 3. Associate each item to its end position.
(org-list-struct-assoc-end struct end-lst)
- ;; 5. Return STRUCT
+ ;; 4. Return STRUCT
struct)))
(defun org-list-struct-assoc-end (struct end-list)
(defun org-list-parents-alist (struct)
"Return alist between item and parent in STRUCT."
- (let ((ind-to-ori (list (list (nth 1 (car struct)))))
- (prev-pos (list (caar struct))))
+ (let* ((ind-to-ori (list (list (nth 1 (car struct)))))
+ (top-item (org-list-get-top-point struct))
+ (prev-pos (list top-item)))
(cons prev-pos
(mapcar (lambda (item)
(let ((pos (car item))
(push pos prev-pos)
(cond
((> prev-ind ind)
+ ;; A sub-list is over. Find the associated
+ ;; origin in IND-TO-ORI. If it cannot be
+ ;; found (ill-formed list), set its parent as
+ ;; the first item less indented. If there is
+ ;; none, make it a top-level item.
(setq ind-to-ori
- (member (assq ind ind-to-ori) ind-to-ori))
+ (or (member (assq ind ind-to-ori) ind-to-ori)
+ (catch 'exit
+ (mapc
+ (lambda (e)
+ (when (< (car e) ind)
+ (throw 'exit (member e ind-to-ori))))
+ ind-to-ori)
+ (list (list ind)))))
(cons pos (cdar ind-to-ori)))
+ ;; A sub-list starts. Every item at IND will
+ ;; have previous item as its parent.
((< prev-ind ind)
(let ((origin (nth 1 prev-pos)))
(push (cons ind origin) ind-to-ori)
(cons pos origin)))
+ ;; Another item in the same sub-list: it shares
+ ;; the same parent as the previous item.
(t (cons pos (cdar ind-to-ori))))))
(cdr struct)))))
+\f
;;; Accessors
(defsubst org-list-get-nth (n key struct)
(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'."
+STRUCT is the list structure. PARENTS is the alist of parents,
+as returned by `org-list-parents-alist'."
(let (all child)
(while (setq child (car (rassq item parents)))
(setq parents (cdr (member (assq child parents) parents)))
type is determined by the first item of the list."
(let ((first (org-list-get-list-begin item struct prevs)))
(cond
- ((org-list-get-tag first struct) 'descriptive)
((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
+ ((org-list-get-tag first struct) 'descriptive)
(t 'unordered))))
+(defun org-list-get-item-number (item struct prevs parents)
+ "Return ITEM's sequence number.
+
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'. PARENTS is the
+alist of ancestors, as returned by `org-list-parents-alist'.
+Return value is a list of integers. Counters have an impact on
+that value."
+ (let ((get-relative-number
+ (function
+ (lambda (item struct prevs)
+ ;; Return relative sequence number of ITEM in the sub-list
+ ;; it belongs. STRUCT is the list structure. PREVS is
+ ;; the alist of previous items.
+ (let ((seq 0) (pos item) counter)
+ (while (and (not (setq counter (org-list-get-counter pos struct)))
+ (setq pos (org-list-get-prev-item pos struct prevs)))
+ (incf seq))
+ (if (not counter) (1+ seq)
+ (cond
+ ((string-match "[A-Za-z]" counter)
+ (+ (- (string-to-char (upcase (match-string 0 counter))) 64)
+ seq))
+ ((string-match "[0-9]+" counter)
+ (+ (string-to-number (match-string 0 counter)) seq))
+ (t (1+ seq)))))))))
+ ;; Cons each parent relative number into return value (OUT).
+ (let ((out (list (funcall get-relative-number item struct prevs)))
+ (parent item))
+ (while (setq parent (org-list-get-parent parent struct parents))
+ (push (funcall get-relative-number parent struct prevs) out))
+ ;; Return value.
+ out)))
+
+
+\f
;;; Searching
(defun org-list-search-generic (search re bound noerr)
regexp (or bound (point-max)) noerror))
+\f
;;; Methods on structures
(defsubst org-list-bullet-string (bullet)
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.
-Blank lines at the end of items are left in place. Return the
-new structure after the changes.
+
+Blank lines at the end of items are left in place. Item
+visibility is preserved. Return the new structure after the
+changes.
Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
to the same sub-list.
(body-B (buffer-substring beg-B end-B-no-blank))
(between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
(sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
- (sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
+ (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
+ ;; Store overlays responsible for visibility status. We
+ ;; also need to store their boundaries as they will be
+ ;; removed from buffer.
+ (overlays (cons
+ (mapcar (lambda (ov)
+ (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-A end-A))
+ (mapcar (lambda (ov)
+ (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-B end-B)))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
(setcar e (+ pos (- size-B size-A)))
(setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
struct)
- (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))
+ (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ ;; Restore visibility status, by moving overlays to their new
+ ;; position.
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov)
+ (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
+ (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
+ (car overlays))
+ (mapc (lambda (ov)
+ (move-overlay (car ov)
+ (+ (nth 1 ov) (- beg-A beg-B))
+ (+ (nth 2 ov) (- beg-A beg-B))))
+ (cdr overlays))
+ ;; Return structure.
+ struct)))
(defun org-list-separating-blank-lines-number (pos struct prevs)
"Return number of blank lines that should separate items in list.
(let ((item (point))
(insert-blank-p
(cdr (assq 'plain-list-item org-blank-before-new-entry)))
- usr-blank)
+ usr-blank
+ (count-blanks
+ (function
+ (lambda ()
+ ;; Count blank lines above beginning of line.
+ (save-excursion
+ (count-lines (goto-char (point-at-bol))
+ (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))))))
(cond
;; Trivial cases where there should be none.
- ((or (and (not (eq org-list-ending-method 'indent))
- 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
- ;; neighboring 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?
(next-p (goto-char next-p)
- (org-back-over-empty-lines))
+ (funcall count-blanks))
;; Is there a previous item?
((org-list-get-prev-item item struct prevs)
- (org-back-over-empty-lines))
+ (funcall count-blanks))
;; User inserted blank lines, trust him.
((and (> pos (org-list-get-item-end-before-blank item struct))
- (> (save-excursion
- (goto-char pos)
- (skip-chars-backward " \t")
- (setq usr-blank (org-back-over-empty-lines))) 0))
+ (> (save-excursion (goto-char pos)
+ (setq usr-blank (funcall count-blanks)))
+ 0))
usr-blank)
;; Are there blank lines inside the list so far?
((save-excursion
(goto-char (org-list-get-top-point struct))
- (org-list-search-forward
+ ;; Do not use `org-list-search-forward' so blank lines
+ ;; in blocks can be counted in.
+ (re-search-forward
"^[ \t]*$" (org-list-get-item-end-before-blank item struct) t))
1)
;; Default choice: no blank line.
(let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin))))
(item-end (org-list-get-item-end item struct))
(item-end-no-blank (org-list-get-item-end-before-blank item struct))
- (beforep (and (looking-at org-list-full-item-re)
- (<= pos (match-end 0))))
+ (beforep
+ (progn
+ (looking-at org-list-full-item-re)
+ ;; Do not count tag in a non-descriptive list.
+ (<= pos (if (and (match-beginning 4)
+ (save-match-data
+ (string-match "[.)]" (match-string 1))))
+ (match-beginning 4)
+ (match-end 0)))))
(split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
(blank-nb (org-list-separating-blank-lines-number
pos struct prevs))
(insert body item-sep)
;; 5. Add new item to STRUCT.
(mapc (lambda (e)
- (let ((p (car e))
- (end (nth 6 e)))
- (cond
+ (let ((p (car e)) (end (nth 6 e)))
+ (cond
;; Before inserted item, positions don't change but
;; an item ending after insertion has its end shifted
;; by SIZE-OFFSET.
to another item in the same list as ITEM, and will move the
latter just before the former.
-If DEST is `begin' \(resp. `end'\), ITEM will be moved at the
-beginning \(resp. end\) of the list it belongs to.
+If DEST is `begin' (respectively `end'), ITEM will be moved at
+the beginning (respectively end) of the list it belongs to.
If DEST is a string like \"N\", where N is an integer, ITEM will
be moved at the Nth position in the list.
If DEST is `delete', ITEM will be deleted.
+Visibility of item is preserved.
+
This function returns, destructively, the new list structure."
(let* ((prevs (org-list-prevs-alist struct))
(item-end (org-list-get-item-end item struct))
(org-list-get-last-item item struct prevs))
(point-at-eol)))))
(t dest)))
- (org-M-RET-may-split-line nil))
+ (org-M-RET-may-split-line nil)
+ ;; Store visibility.
+ (visibility (overlays-in item item-end)))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
(+ end shift)))))))
moved-items))
(lambda (e1 e2) (< (car e1) (car e2))))))
- ;; 2. Eventually delete extra copy of the item and clean marker.
- (prog1
- (org-list-delete-item (marker-position item) struct)
+ ;; 2. Restore visibility.
+ (mapc (lambda (ov)
+ (move-overlay ov
+ (+ (overlay-start ov) (- (point) item))
+ (+ (overlay-end ov) (- (point) item))))
+ visibility)
+ ;; 3. Eventually delete extra copy of the item and clean marker.
+ (prog1 (org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
(t struct))))
(change-bullet-maybe
(function
(lambda (item)
- (let* ((bul (org-trim (org-list-get-bullet item struct)))
- (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet))))
+ (let ((new-bul-p
+ (cdr (assoc
+ ;; Normalize ordered bullets.
+ (let ((bul (org-trim
+ (org-list-get-bullet item struct))))
+ (cond ((string-match "[A-Z]\\." bul) "A.")
+ ((string-match "[A-Z])" bul) "A)")
+ ((string-match "[a-z]\\." bul) "a.")
+ ((string-match "[a-z])" bul) "a)")
+ ((string-match "[0-9]\\." bul) "1.")
+ ((string-match "[0-9])" bul) "1)")
+ (t bul)))
+ org-list-demote-modify-bullet))))
(when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
(ind
(lambda (cell)
(mapcar ind parents)))
+\f
;;; Repairing structures
(defun org-list-use-alpha-bul-p (first struct prevs)
"Non-nil if list starting at FIRST can have alphabetical bullets.
-STRUCT is list structure. PREVS is the alist of previous items,
+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
(if (> ascii 90)
(throw 'exit nil)
(setq item (org-list-get-next-item item struct prevs)))))
- ;; All items checked. All good.
+ ;; All items checked. All good.
t))))
(defun org-list-inc-bullet-maybe (bullet)
;; 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)
;; Return blocking item.
(nth index all-items)))))))
+(defun org-list-struct-fix-item-end (struct)
+ "Verify and correct each item end position in STRUCT.
+
+This function modifies STRUCT."
+ (let (end-list acc-end)
+ (mapc (lambda (e)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (end-pos (org-list-get-item-end pos struct)))
+ (unless (assq end-pos 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
+ ;; Else part is for the bottom point.
+ (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
+ end-pos)
+ end-list)))
+ (push (cons ind-pos pos) end-list)
+ (push (cons end-pos pos) acc-end)))
+ struct)
+ (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
+ (org-list-struct-assoc-end struct end-list)))
+
(defun org-list-struct-apply-struct (struct old-struct)
- "Apply set-difference between STRUCT and OLD-STRUCT to the buffer.
+ "Apply set difference between STRUCT and OLD-STRUCT to the buffer.
OLD-STRUCT is the structure before any modifications, and STRUCT
the structure to be applied. The function will only modify parts
of the list which have changed.
Initial position of cursor is restored after the changes."
- (let* ((origin (copy-marker (point)))
+ (let* ((origin (point-marker))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
- (box-rule-p (cdr (assq 'checkbox org-list-automatic-rules)))
(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
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
- ;; a. Replace bullet
+ ;; a. Replace bullet
(unless (equal old-bul new-bul)
(replace-match new-bul nil nil nil 1))
- ;; b. Replace checkbox.
+ ;; b. Replace checkbox.
(cond
- ((and new-box box-rule-p
- (save-match-data (org-at-item-description-p)))
- (message "Cannot add a checkbox to a description list item"))
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
((match-string 3)
- ;; (goto-char (or (match-end 2) (match-end 1)))
- ;; (skip-chars-backward " \t")
(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
(replace-match "" nil nil nil 1))
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
- (insert (concat new-box (unless counterp " "))))))
- ;; c. Indent item to appropriate column.
+ (insert (concat new-box (unless counterp " "))))))
+ ;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (point-at-bol))
(progn (skip-chars-forward " \t") (point)))
(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.
+ ;; 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)))
-(defun org-list-write-struct (struct parents)
+(defun org-list-write-struct (struct parents &optional old-struct)
"Correct bullets, checkboxes and indentation in list at point.
+
STRUCT is the list structure. PARENTS is the alist of parents,
-as returned by `org-list-parents-alist'."
+as returned by `org-list-parents-alist'.
+
+When non-nil, optional argument OLD-STRUCT is the reference
+structure of the list. It should be provided whenever STRUCT
+doesn't correspond anymore to the real list in buffer."
;; Order of functions matters here: checkboxes and endings need
;; correct indentation to be set, and indentation needs correct
;; bullets.
;;
;; 0. Save a copy of structure before modifications
- (let ((old-struct (copy-tree struct)))
+ (let ((old-struct (or old-struct (copy-tree struct))))
;; 1. Set a temporary, but coherent with PARENTS, indentation in
;; order to get items endings and bullets properly
(org-list-struct-fix-ind struct parents 2)
- ;; 2. Get pseudo-alist of ending positions and sort it by position.
- ;; Then associate them to the structure.
- (let (end-list acc-end)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (end-pos (org-list-get-item-end pos struct)))
- (unless (assq end-pos 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
- ;; Else part is for the bottom point.
- (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
- end-pos)
- end-list)))
- (push (cons ind-pos pos) end-list)
- (push (cons end-pos pos) acc-end)))
- struct)
- (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
- (org-list-struct-assoc-end struct end-list))
- ;; 3. Get bullets right.
- (let ((prevs (org-list-prevs-alist struct)))
- (org-list-struct-fix-bul struct prevs)
- ;; 4. Now get real indentation.
- (org-list-struct-fix-ind struct parents)
- ;; 5. Eventually fix checkboxes.
- (org-list-struct-fix-box struct parents prevs))
- ;; 6. Apply structure modifications to buffer.
- (org-list-struct-apply-struct struct old-struct)))
-
-
+ ;; 2. Fix each item end to get correct prevs alist.
+ (org-list-struct-fix-item-end struct)
+ ;; 3. Get bullets right.
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ ;; 4. Now get real indentation.
+ (org-list-struct-fix-ind struct parents)
+ ;; 5. Eventually fix checkboxes.
+ (org-list-struct-fix-box struct parents prevs))
+ ;; 6. Apply structure modifications to buffer.
+ (org-list-struct-apply-struct struct old-struct)))
+
+
+\f
;;; Misc Tools
(defun org-apply-on-list (function init-value &rest args)
(defun org-list-set-item-visibility (item struct view)
"Set visibility of ITEM in STRUCT to VIEW.
-Possible values are: `folded', `children' or `subtree'. See
+Possible values are: `folded', `children' or `subtree'. See
`org-cycle' for more information."
(cond
((eq view 'folded)
(let (bpos bcol tpos tcol)
(save-excursion
(goto-char item)
- (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+")
+ (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
(setq bpos (match-beginning 1) tpos (match-end 0)
bcol (progn (goto-char bpos) (current-column))
tcol (progn (goto-char tpos) (current-column)))
tcol))
+\f
;;; Interactive functions
(defalias 'org-list-get-item-begin 'org-in-item-p)
(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)))
(org-list-struct)))
(prevs (org-list-prevs-alist struct))
;; If we're in a description list, ask for the new term.
- (desc (when (org-list-get-tag itemp struct)
- (concat (read-string "Term: ") " :: ")))
- ;; Don't insert a checkbox if checkbox rule is applied
- ;; and it is a description item.
- (checkp (and checkbox
- (or (not desc)
- (not (cdr (assq 'checkbox
- org-list-automatic-rules)))))))
- (setq struct
- (org-list-insert-item pos struct prevs checkp desc))
+ (desc (when (eq (org-list-get-list-type itemp struct prevs)
+ 'descriptive)
+ " :: ")))
+ (setq struct (org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
- (when checkp (org-update-checkbox-count-maybe))
+ (when checkbox (org-update-checkbox-count-maybe))
(looking-at org-list-full-item-re)
- (goto-char (match-end 0))
+ (goto-char (if (and (match-beginning 4)
+ (save-match-data
+ (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))
(prevs (org-list-prevs-alist struct))
(list-beg (org-list-get-first-item (point) struct prevs))
(bullet (org-list-get-bullet list-beg struct))
- (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
(alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
(case-fold-search nil)
(current (cond
(bullet-list
(append '("-" "+" )
;; *-bullets are not allowed at column 0.
- (unless (and bullet-rule-p
- (looking-at "\\S-")) '("*"))
+ (unless (looking-at "\\S-") '("*"))
;; Description items cannot be numbered.
(unless (or (eq org-plain-list-ordered-item-terminator ?\))
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("1."))
(unless (or (eq org-plain-list-ordered-item-terminator ?.)
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("1)"))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?\))
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("a." "A."))
(unless (or (not alpha-p)
(eq org-plain-list-ordered-item-terminator ?.)
- (and bullet-rule-p (org-at-item-description-p)))
+ (org-at-item-description-p))
'("a)" "A)"))))
(len (length bullet-list))
(item-index (- len (length (member current bullet-list))))
(setq lim-up (point-at-bol))
(error "No item in region"))
(setq lim-down (copy-marker limit))))
- ((org-on-heading-p)
+ ((org-at-heading-p)
;; On an heading, start at first item after drawers and
;; time-stamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
((org-at-item-p)
(setq singlep t)
(setq lim-up (point-at-bol)
- lim-down (point-at-eol)))
+ lim-down (copy-marker (point-at-eol))))
(t (error "Not at an item or heading, and no active region"))))
;; Determine the checkbox going to be applied to all items
;; within bounds.
(lambda (e) (or (< e lim-up) (> e lim-down)))
(mapcar 'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
- e struct
- ;; If there is no box at item, leave as-is
- ;; unless function was called with C-u prefix.
- (let ((cur-box (org-list-get-checkbox e struct)))
- (if (or cur-box (equal toggle-presence '(4)))
- ref-checkbox
- cur-box))))
+ e struct
+ ;; If there is no box at item, leave as-is
+ ;; unless function was called with C-u prefix.
+ (let ((cur-box (org-list-get-checkbox e struct)))
+ (if (or cur-box (equal toggle-presence '(4)))
+ ref-checkbox
+ cur-box))))
items-to-toggle)
(setq block-item (org-list-struct-fix-box
struct parents prevs orderedp))
"Checkboxes were removed due to unchecked box at line %d"
(org-current-line block-item))))
(goto-char bottom)
- (move-marker lim-down nil)
(move-marker bottom nil)
- (org-list-struct-apply-struct struct struct-copy)))))
+ (org-list-struct-apply-struct struct struct-copy)))
+ (move-marker lim-down nil)))
(org-update-checkbox-count-maybe))
(defun org-reset-checkbox-state-subtree ()
(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
(cond ; boxes count
;; Cookie is at an heading, but specifically for todo,
;; not for checkboxes: skip it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(string-match "\\<todo\\>"
(downcase
(or (org-entry-get nil "COOKIE_DATA") ""))))
;; heading already have been read. Use data collected
;; in STRUCTS-BAK. This should only happen when
;; heading has more than one cookie on it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(<= (save-excursion (outline-next-heading) (point))
backup-end))
(funcall count-boxes nil structs-bak recursivep))
;; Cookie is at a fresh heading. Grab structure of
;; every list containing a checkbox between point and
;; next headline, and save them in STRUCTS-BAK.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(setq backup-end (save-excursion
(outline-next-heading) (point))
structs-bak nil)
'org-checkbox-statistics-todo)))
(defun org-update-checkbox-count-maybe (&optional all)
- "Update checkbox statistics unless turned off by user."
+ "Update checkbox statistics unless turned off by user.
+With an optional argument ALL, update them in the whole buffer."
(when (cdr (assq 'checkbox org-list-automatic-rules))
(org-update-checkbox-count all))
(run-hooks 'org-checkbox-statistics-hook))
Return t if successful."
(save-excursion
- (beginning-of-line)
(let* ((regionp (org-region-active-p))
(rbeg (and regionp (region-beginning)))
(rend (and regionp (region-end)))
(prevs (org-list-prevs-alist struct))
;; Are we going to move the whole list?
(specialp
- (and (= top (point))
+ (and (not regionp)
+ (= top (point-at-bol))
(cdr (assq 'indent org-list-automatic-rules))
(if no-subtree
(error
(progn
(set-marker org-last-indent-begin-marker rbeg)
(set-marker org-last-indent-end-marker rend))
- (set-marker org-last-indent-begin-marker (point))
+ (set-marker org-last-indent-begin-marker (point-at-bol))
(set-marker org-last-indent-end-marker
(cond
(specialp (org-list-get-bottom-point struct))
- (no-subtree (1+ (point)))
- (t (org-list-get-item-end (point) struct))))))
+ (no-subtree (1+ (point-at-bol)))
+ (t (org-list-get-item-end (point-at-bol) struct))))))
(let* ((beg (marker-position org-last-indent-begin-marker))
(end (marker-position org-last-indent-end-marker)))
(cond
"Outdent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
- (if (org-at-item-p)
- (let ((struct (org-list-struct)))
- (org-list-indent-item-generic -1 t struct))
- (error "Not at an item")))
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic -1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
(defun org-indent-item ()
"Indent a local list item, but not its children.
If a region is active, all items inside will be moved."
(interactive)
- (if (org-at-item-p)
- (let ((struct (org-list-struct)))
- (org-list-indent-item-generic 1 t struct))
- (error "Not at an item")))
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic 1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
(defun org-outdent-item-tree ()
"Outdent a local list item including its children.
(let ((regionp (org-region-active-p)))
(cond
((or (org-at-item-p)
- (and (org-region-active-p)
- (goto-char (region-beginning))
- (org-at-item-p)))
- (let ((struct (org-list-struct)))
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
(org-list-indent-item-generic -1 nil struct)))
(regionp (error "Region not starting at an item"))
(t (error "Not at an item")))))
(let ((regionp (org-region-active-p)))
(cond
((or (org-at-item-p)
- (and (org-region-active-p)
- (goto-char (region-beginning))
- (org-at-item-p)))
- (let ((struct (org-list-struct)))
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
(org-list-indent-item-generic 1 nil struct)))
(regionp (error "Region not starting at an item"))
(t (error "Not at an item")))))
(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.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
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."
+serve as the sorting key for that record. It will then use
+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)
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
((= dcst ?t) '<)
- (t nil)))
+ ((= dcst ?x) 'string<)))
(next-record (lambda ()
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)))
+ (skip-chars-forward " \r\t\n")
+ (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))))
+ ((= dcst ?x) (or (and (stringp (match-string 1))
+ (match-string 1))
+ ""))
((= dcst ?f)
(if getkey-func
(let ((value (funcall getkey-func)))
(message "Sorting items...done")))))
+\f
;;; Send and receive lists
(defun org-list-parse-list (&optional delete)
(goto-char e)
(looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
(match-end 0)))
- ;; Get counter number. For alphabetic counter, get
+ ;; Get counter number. For alphabetic counter, get
;; its position in the alphabet.
(counter (let ((c (org-list-get-counter e struct)))
(cond
(goto-char top)
(when delete
(delete-region top bottom)
- (when (and (not (eq org-list-ending-method 'indent))
- (not (looking-at "[ \t]*$"))
- (looking-at org-list-end-re))
+ (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
(replace-match "")))
out))
(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)))
+ (plain-list (buffer-substring-no-properties top-point bottom-point))
beg txt)
(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))
(insert txt "\n")))
(message "List converted and installed at receiver location"))))
+(defsubst org-list-item-trim-br (item)
+ "Trim line breaks in a list ITEM."
+ (setq item (replace-regexp-in-string "\n +" " " item)))
+
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-parse-list' to other formats.
Valid parameters PARAMS are:
:cbon String to insert for a checked check-box
:cbtrans String to insert for a check-box in transitional state
+:nobr Non-nil means remove line breaks in lists items.
+
Alternatively, each parameter can also be a form returning
a string. These sexp can use keywords `counter' and `depth',
representing respectively counter associated to the current
(cbon (plist-get p :cbon))
(cboff (plist-get p :cboff))
(cbtrans (plist-get p :cbtrans))
+ (nobr (plist-get p :nobr))
export-sublist ; for byte-compiler
(export-item
(function
((and counter (eq type 'ordered))
(concat (eval icount) "%s"))
(t (concat (eval istart) "%s")))
- (eval iend)))
+ (eval iend)))
(first (car item)))
;; Replace checkbox if any is found.
(cond
(setq first (replace-match cboff t t first)))
((string-match "\\[CBTRANS\\]" first)
(setq first (replace-match cbtrans t t first))))
+ ;; Replace line breaks if required
+ (when nobr (setq first (org-list-item-trim-br first)))
;; Insert descriptive term if TYPE is `descriptive'.
(when (eq type 'descriptive)
(let* ((complete (string-match "^\\(.*\\)[ \t]+::" first))
(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)))
+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.
(provide 'org-list)
-
;;; org-list.el ends here