1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284 |
- ;;; org-list.el --- Plain lists for Org-mode
- ;;
- ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
- ;; Free Software Foundation, Inc.
- ;;
- ;; Author: Carsten Dominik <carsten at orgmode dot org>
- ;; Bastien Guerry <bzg AT altern DOT org>
- ;; Keywords: outlines, hypermedia, calendar, wp
- ;; Homepage: http://orgmode.org
- ;; Version: 7.01trans
- ;;
- ;; This file is part of GNU Emacs.
- ;;
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;;; Commentary:
- ;; This file contains the code dealing with plain lists in Org-mode.
- ;;; Code:
- (eval-when-compile
- (require 'cl))
- (require 'org-macs)
- (require 'org-compat)
- (defvar org-blank-before-new-entry)
- (defvar org-M-RET-may-split-line)
- (defvar org-complex-heading-regexp)
- (defvar org-odd-levels-only)
- (defvar org-outline-regexp)
- (defvar org-ts-regexp)
- (defvar org-ts-regexp-both)
- (declare-function org-invisible-p "org" ())
- (declare-function org-on-heading-p "org" (&optional invisible-ok))
- (declare-function outline-next-heading "outline" ())
- (declare-function org-back-to-heading "org" (&optional invisible-ok))
- (declare-function org-back-over-empty-lines "org" ())
- (declare-function org-trim "org" (s))
- (declare-function org-get-indentation "org" (&optional line))
- (declare-function org-timer-item "org-timer" (&optional arg))
- (declare-function org-timer-hms-to-secs "org-timer" (hms))
- (declare-function org-combine-plists "org" (&rest plists))
- (declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
- (declare-function org-narrow-to-subtree "org" ())
- (declare-function org-show-subtree "org" ())
- (declare-function org-in-regexps-block-p "org"
- (start-re end-re &optional bound))
- (declare-function org-level-increment "org" ())
- (declare-function org-at-heading-p "org" (&optional ignored))
- (declare-function outline-previous-heading "outline" ())
- (declare-function org-icompleting-read "org" (&rest args))
- (declare-function org-time-string-to-seconds "org" (s))
- (defgroup org-plain-lists nil
- "Options concerning plain lists in Org-mode."
- :tag "Org Plain lists"
- :group 'org-structure)
- (defcustom org-cycle-include-plain-lists t
- "When t, make TAB cycle visibility on plain list items.
- Cycling plain lists works only when the cursor is on a plain list
- item. When the cursor is on an outline heading, plain lists are
- 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."
- :group 'org-plain-lists
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "With cursor in plain list (recommended)" t)
- (const :tag "As children of outline headings" integrate)))
- (defcustom org-list-demote-modify-bullet nil
- "Default bullet type installed when demoting an item.
- This is an association list, for each bullet type, this alist will point
- to the bullet that should be used when this item is demoted.
- For example,
- (setq org-list-demote-modify-bullet
- '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
- will make
- + Movies
- + Silence of the Lambs
- + My Cousin Vinny
- + Books
- + The Hunt for Red October
- + The Road to Omaha
- into
- + Movies
- - Silence of the Lambs
- - My Cousin Vinny
- + Books
- - The Hunt for Red October
- - The Road to Omaha"
- :group 'org-plain-lists
- :type '(repeat
- (cons
- (choice :tag "If the current bullet is "
- (const "-")
- (const "+")
- (const "*")
- (const "1.")
- (const "1)"))
- (choice :tag "demotion will change it to"
- (const "-")
- (const "+")
- (const "*")
- (const "1.")
- (const "1)")))))
- (defcustom org-plain-list-ordered-item-terminator t
- "The character that makes a line with leading number an ordered list item.
- Valid values are ?. and ?\). To get both terminators, use t. While
- ?. may look nicer, it creates the danger that a line with leading
- number may be incorrectly interpreted as an item. ?\) therefore is
- the safe choice."
- :group 'org-plain-lists
- :type '(choice (const :tag "dot like in \"2.\"" ?.)
- (const :tag "paren like in \"2)\"" ?\))
- (const :tab "both" t)))
- (defcustom org-list-two-spaces-after-bullet-regexp nil
- "A regular expression matching bullets that should have 2 spaces after them.
- When nil, no bullet will have two spaces after them.
- When a string, it will be used as a regular expression. When the
- bullet type of a list is changed, the new bullet type will be
- matched against this regexp. If it matches, there will be two
- spaces instead of one after the bullet in each item of the list."
- :group 'org-plain-lists
- :type '(choice
- (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. This is
- the fastest method.
- When set to `indent', a list will end whenever a line following
- an item, but not starting one, is less or equally indented than
- it.
- 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
- "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]*$\"."
- :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)
- (indent . t)
- (insert . 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
- 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 -
- insert when non-nil, trying to insert an item inside a block
- will insert it right before the block instead of
- throwing an error."
- :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)
- (const :tag "Insert" insert))
- :value-type
- (boolean :tag "Activate" :value t)))
- (defcustom org-hierarchical-checkbox-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
- with the word \"recursive\" in the value."
- :group 'org-plain-lists
- :type 'boolean)
- (defcustom org-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."
- :group 'org-plain-lists
- :type 'integer)
- (defcustom org-list-radio-list-templates
- '((latex-mode "% BEGIN RECEIVE ORGLST %n
- % END RECEIVE ORGLST %n
- \\begin{comment}
- #+ORGLST: SEND %n org-list-to-latex
- -
- \\end{comment}\n")
- (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
- @c END RECEIVE ORGLST %n
- @ignore
- #+ORGLST: SEND %n org-list-to-texinfo
- -
- @end ignore\n")
- (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
- <!-- END RECEIVE ORGLST %n -->
- <!--
- #+ORGLST: SEND %n org-list-to-html
- -
- -->\n"))
- "Templates for radio lists in different major modes.
- All occurrences of %n in a template will be replaced with the name of the
- list, obtained by prompting the user."
- :group 'org-plain-lists
- :type '(repeat
- (list (symbol :tag "Major mode")
- (string :tag "Format"))))
- ;;; Internal functions
- (defun org-list-end-re ()
- "Return the regex corresponding to the end of a list.
- It depends on `org-empty-line-terminates-plain-lists'."
- (if org-empty-line-terminates-plain-lists
- "^[ \t]*\n"
- org-list-end-regexp))
- (defun org-item-re (&optional general)
- "Return the correct regular expression for plain lists.
- If GENERAL is non-nil, return the general regexp independent of the value
- of `org-plain-list-ordered-item-terminator'."
- (cond
- ((or general (eq org-plain-list-ordered-item-terminator t))
- "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
- ((= org-plain-list-ordered-item-terminator ?.)
- "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
- ((= org-plain-list-ordered-item-terminator ?\))
- "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
- (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
- (defconst org-item-beginning-re (concat "^" (org-item-re))
- "Regexp matching the beginning of a plain list item.")
- (defun org-list-ending-between (min max &optional firstp)
- "Find the position of a list ending between MIN and MAX, or nil.
- This function looks for `org-list-end-re' outside a block.
- If FIRSTP in non-nil, return the point at the beginning of the
- nearest valid terminator from MIN. Otherwise, return the point at
- the end of the nearest terminator from MAX."
- (save-excursion
- (let* ((start (if firstp min max))
- (end (if firstp max min))
- (search-fun (if firstp
- #'org-search-forward-unenclosed
- #'org-search-backward-unenclosed))
- (list-end-p (progn
- (goto-char start)
- (funcall search-fun (org-list-end-re) end t))))
- ;; Is there a valid list ending somewhere ?
- (and list-end-p
- ;; we want to be on the first line of the list ender
- (match-beginning 0)))))
- (defun org-list-maybe-skip-block (search limit)
- "Return non-nil value if point is in a block, skipping it on the way.
- It looks for the boundary of the block in SEARCH direction,
- stopping at LIMIT."
- (save-match-data
- (let ((case-fold-search t)
- (boundary (if (eq search 're-search-forward) 3 5)))
- (when (save-excursion
- (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t)
- (= (length (match-string 1)) boundary)))
- ;; We're in a block: get out of it
- (goto-char (match-beginning 0))))))
- (defun org-list-search-unenclosed-generic (search re bound noerr)
- "Search a string outside blocks and protected places.
- Arguments SEARCH, RE, BOUND and NOERR are similar to those in
- `search-forward', `search-backward', `re-search-forward' and
- `re-search-backward'."
- (catch 'exit
- (let ((origin (point)))
- (while t
- ;; 1. No match: return to origin or bound, depending on NOERR.
- (unless (funcall search re bound noerr)
- (throw 'exit (and (goto-char (if (booleanp noerr) origin bound))
- nil)))
- ;; 2. Match not in block or protected: return point. Else
- ;; skip the block and carry on.
- (unless (or (get-text-property (match-beginning 0) 'org-protected)
- (org-list-maybe-skip-block search bound))
- (throw 'exit (point)))))))
- (defun org-search-backward-unenclosed (regexp &optional bound noerror)
- "Like `re-search-backward' but don't stop inside blocks or protected places.
- Arguments REGEXP, BOUND and NOERROR are similar to those used in
- `re-search-backward'."
- (org-list-search-unenclosed-generic
- #'re-search-backward regexp (or bound (point-min)) noerror))
- (defun org-search-forward-unenclosed (regexp &optional bound noerror)
- "Like `re-search-forward' but don't stop inside blocks or protected places.
- Arguments REGEXP, BOUND and NOERROR are similar to those used in
- `re-search-forward'."
- (org-list-search-unenclosed-generic
- #'re-search-forward regexp (or bound (point-max)) noerror))
- (defun org-list-in-item-p-with-indent (limit)
- "Is the cursor inside a plain list?
- Plain lists are considered ending when a non-blank line is less
- indented than the previous item within LIMIT."
- (save-excursion
- (beginning-of-line)
- (cond
- ;; do not start searching inside a block...
- ((org-list-maybe-skip-block #'re-search-backward limit))
- ;; ... or at a blank line
- ((looking-at "^[ \t]*$")
- (skip-chars-backward " \r\t\n")
- (beginning-of-line)))
- (beginning-of-line)
- (or (org-at-item-p)
- (let* ((case-fold-search t)
- (ind-ref (org-get-indentation))
- ;; Ensure there is at least an item above
- (up-item-p (save-excursion
- (org-search-backward-unenclosed
- org-item-beginning-re limit t))))
- (and up-item-p
- (catch 'exit
- (while t
- (cond
- ((org-at-item-p)
- (throw 'exit (< (org-get-indentation) ind-ref)))
- ((looking-at "^[ \t]*$")
- (skip-chars-backward " \r\t\n")
- (beginning-of-line))
- ((looking-at "^[ \t]*#\\+end_")
- (re-search-backward "^[ \t]*#\\+begin_"))
- (t
- (setq ind-ref (min (org-get-indentation) ind-ref))
- (forward-line -1))))))))))
- (defun org-list-in-item-p-with-regexp (limit)
- "Is the cursor inside a plain list?
- Plain lists end when `org-list-end-regexp' is matched, or at a
- blank line if `org-empty-line-terminates-plain-lists' is true.
- Argument LIMIT specifies the upper-bound of the search."
- (save-excursion
- (let* ((actual-pos (goto-char (point-at-eol)))
- ;; Moved to eol so current line can be matched by
- ;; `org-item-re'.
- (last-item-start (save-excursion
- (org-search-backward-unenclosed
- org-item-beginning-re limit t)))
- (list-ender (org-list-ending-between
- last-item-start actual-pos)))
- ;; We are in a list when we are on an item line or when we can
- ;; find an item before point and there is no valid list ender
- ;; between it and the point.
- (and last-item-start (not list-ender)))))
- (defun org-list-top-point-with-regexp (limit)
- "Return point at the top level item in a list.
- Argument LIMIT specifies the upper-bound of the search.
- List ending is determined by regexp. See
- `org-list-ending-method'. for more information."
- (save-excursion
- (let ((pos (point-at-eol)))
- ;; Is there some list above this one ? If so, go to its ending.
- ;; Otherwise, go back to the heading above or bob.
- (goto-char (or (org-list-ending-between limit pos) limit))
- ;; From there, search down our list.
- (org-search-forward-unenclosed org-item-beginning-re pos t)
- (point-at-bol))))
- (defun org-list-bottom-point-with-regexp (limit)
- "Return point just before list ending.
- Argument LIMIT specifies the lower-bound of the search.
- List ending is determined by regexp. See
- `org-list-ending-method'. for more information."
- (save-excursion
- (let ((pos (org-get-item-beginning)))
- ;; The list ending is either first point matching
- ;; `org-list-end-re', point at first white-line before next
- ;; heading, or eob.
- (or (org-list-ending-between (min pos limit) limit t) limit))))
- (defun org-list-top-point-with-indent (limit)
- "Return point at the top level in a list.
- Argument LIMIT specifies the upper-bound of the search.
- List ending is determined by indentation of text. See
- `org-list-ending-method'. for more information."
- (save-excursion
- (let ((case-fold-search t))
- (let ((item-ref (goto-char (org-get-item-beginning)))
- (ind-ref 10000))
- (forward-line -1)
- (catch 'exit
- (while t
- (let ((ind (org-get-indentation)))
- (cond
- ((looking-at "^[ \t]*:END:")
- (throw 'exit item-ref))
- ((<= (point) limit)
- (throw 'exit
- (if (and (org-at-item-p) (< ind ind-ref))
- (point-at-bol)
- item-ref)))
- ((looking-at "^[ \t]*$")
- (skip-chars-backward " \r\t\n")
- (beginning-of-line))
- ((looking-at "^[ \t]*#\\+end_")
- (re-search-backward "^[ \t]*#\\+begin_"))
- ((not (org-at-item-p))
- (setq ind-ref (min ind ind-ref))
- (forward-line -1))
- ((>= ind ind-ref)
- (throw 'exit item-ref))
- (t
- (setq item-ref (point-at-bol) ind-ref 10000)
- (forward-line -1))))))))))
- (defun org-list-bottom-point-with-indent (limit)
- "Return point just before list ending or nil if not in a list.
- Argument LIMIT specifies the lower-bound of the search.
- List ending is determined by the indentation of text. See
- `org-list-ending-method' for more information."
- (save-excursion
- (let ((ind-ref (progn
- (goto-char (org-get-item-beginning))
- (org-get-indentation)))
- (case-fold-search t))
- ;; do not start inside a block
- (org-list-maybe-skip-block #'re-search-forward limit)
- (beginning-of-line)
- (catch 'exit
- (skip-chars-forward " \t")
- (while t
- (let ((ind (org-get-indentation)))
- (cond
- ((or (>= (point) limit)
- (looking-at ":END:"))
- (throw 'exit (progn
- ;; Ensure bottom is just after a
- ;; non-blank line.
- (skip-chars-backward " \r\t\n")
- (min (point-max) (1+ (point-at-eol))))))
- ((= (point) (point-at-eol))
- (skip-chars-forward " \r\t\n")
- (beginning-of-line))
- ((org-at-item-p)
- (setq ind-ref ind)
- (forward-line 1))
- ((<= ind ind-ref)
- (throw 'exit (point-at-bol)))
- ((looking-at "#\\+begin_")
- (re-search-forward "[ \t]*#\\+end_")
- (forward-line 1))
- (t (forward-line 1)))))))))
- (defun org-list-at-regexp-after-bullet-p (regexp)
- "Is point at a list item with REGEXP after bullet?"
- (and (org-at-item-p)
- (save-excursion
- (goto-char (match-end 0))
- ;; Ignore counter if any
- (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
- (goto-char (match-end 0)))
- (looking-at regexp))))
- (defun org-list-get-item-same-level (search-fun pos limit pre-move)
- "Return point at the beginning of next item at the same level.
- Search items using function SEARCH-FUN, from POS to LIMIT. It
- uses PRE-MOVE before search. Return nil if no item was found."
- (save-excursion
- (goto-char pos)
- (let* ((start (org-get-item-beginning))
- (ind (progn (goto-char start) (org-get-indentation))))
- ;; We don't want to match the current line.
- (funcall pre-move)
- ;; Skip any sublist on the way
- (while (and (funcall search-fun org-item-beginning-re limit t)
- (> (org-get-indentation) ind)))
- (when (and (/= (point-at-bol) start) ; Have we moved ?
- (= (org-get-indentation) ind))
- (point-at-bol)))))
- (defun org-list-separating-blank-lines-number (pos top bottom)
- "Return number of blank lines that should separate items in list.
- POS is the position of point to be considered.
- TOP and BOTTOM are respectively position of list beginning and
- list ending.
- Assume point is at item's beginning. If the item is alone, apply
- some heuristics to guess the result."
- (save-excursion
- (let ((insert-blank-p
- (cdr (assq 'plain-list-item org-blank-before-new-entry)))
- usr-blank)
- (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)
- ;; 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.
- (t (let ((next-p (org-get-next-item (point) bottom)))
- (cond
- ;; Is there a next item?
- (next-p (goto-char next-p)
- (org-back-over-empty-lines))
- ;; Is there a previous item?
- ((org-get-previous-item (point) top)
- (org-back-over-empty-lines))
- ;; User inserted blank lines, trust him
- ((and (> pos (org-end-of-item-before-blank bottom))
- (> (save-excursion
- (goto-char pos)
- (skip-chars-backward " \t")
- (setq usr-blank (org-back-over-empty-lines))) 0))
- usr-blank)
- ;; Are there blank lines inside the item ?
- ((save-excursion
- (org-search-forward-unenclosed
- "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1)
- ;; No parent: no blank line.
- (t 0))))))))
- (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
- "Insert a new list item at POS.
- If POS is before first character after bullet of the item, the
- new item will be created before the current one.
- Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
- after the bullet. Cursor will be after this text once the
- function ends."
- (goto-char pos)
- ;; Is point in a special block?
- (when (org-in-regexps-block-p
- "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
- '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
- (if (not (cdr (assq 'insert org-list-automatic-rules)))
- ;; Rule in `org-list-automatic-rules' forbids insertion.
- (error "Cannot insert item inside a block")
- ;; Else, move before it prior to add a new item.
- (end-of-line)
- (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
- (end-of-line 0)))
- (let* ((true-pos (point))
- (top (org-list-top-point))
- (bottom (copy-marker (org-list-bottom-point)))
- (bullet (and (goto-char (org-get-item-beginning))
- (org-list-bullet-string (org-get-bullet))))
- (ind (org-get-indentation))
- (before-p (progn
- ;; Description item: text starts after colons.
- (or (org-at-item-description-p)
- ;; At a checkbox: text starts after it.
- (org-at-item-checkbox-p)
- ;; Otherwise, text starts after bullet.
- (org-at-item-p))
- (<= true-pos (match-end 0))))
- (blank-lines-nb (org-list-separating-blank-lines-number
- true-pos top bottom))
- (insert-fun
- (lambda (text)
- ;; insert bullet above item in order to avoid bothering
- ;; with possible blank lines ending last item.
- (goto-char (org-get-item-beginning))
- (indent-to-column ind)
- (insert (concat bullet (when checkbox "[ ] ") after-bullet))
- ;; Stay between after-bullet and before text.
- (save-excursion
- (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
- (unless before-p
- ;; store bottom: exchanging items doesn't change list
- ;; bottom point but will modify marker anyway
- (setq bottom (marker-position bottom))
- (let ((col (current-column)))
- (org-list-exchange-items
- (org-get-item-beginning) (org-get-next-item (point) bottom)
- bottom)
- ;; recompute next-item: last sexp modified list
- (goto-char (org-get-next-item (point) bottom))
- (org-move-to-column col)))
- ;; checkbox update might modify bottom point, so use a
- ;; marker here
- (setq bottom (copy-marker bottom))
- (when checkbox (org-update-checkbox-count-maybe))
- (org-list-repair nil top bottom))))
- (goto-char true-pos)
- (cond
- (before-p (funcall insert-fun nil) t)
- ;; Can't split item: insert bullet at the end of item.
- ((not (org-get-alist-option org-M-RET-may-split-line 'item))
- (funcall insert-fun nil) t)
- ;; else, insert a new bullet along with everything from point
- ;; down to last non-blank line of item.
- (t
- (delete-horizontal-space)
- ;; Get pos again in case previous command modified line.
- (let* ((pos (point))
- (end-before-blank (org-end-of-item-before-blank bottom))
- (after-text
- (when (< pos end-before-blank)
- (prog1
- (delete-and-extract-region pos end-before-blank)
- ;; delete any blank line at and before point.
- (beginning-of-line)
- (while (looking-at "^[ \t]*$")
- (delete-region (point-at-bol) (1+ (point-at-eol)))
- (beginning-of-line 0))))))
- (funcall insert-fun after-text) t)))))
- (defvar org-last-indent-begin-marker (make-marker))
- (defvar org-last-indent-end-marker (make-marker))
- (defun org-list-indent-item-generic (arg no-subtree top bottom)
- "Indent a local list item including its children.
- When number ARG is a negative, item will be outdented, otherwise
- it will be indented.
- If a region is active, all items inside will be moved.
- If NO-SUBTREE is non-nil, only indent the item itself, not its
- children.
- TOP and BOTTOM are respectively position at item beginning and at
- item ending.
- Return t if successful."
- (let* ((regionp (org-region-active-p))
- (rbeg (and regionp (region-beginning)))
- (rend (and regionp (region-end))))
- (cond
- ((and regionp
- (goto-char rbeg)
- (not (org-search-forward-unenclosed org-item-beginning-re rend t)))
- (error "No item in region"))
- ((not (org-at-item-p))
- (error "Not on an item"))
- (t
- ;; Are we going to move the whole list?
- (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules))
- (not no-subtree)
- (= top (point-at-bol)))))
- ;; Determine begin and end points of zone to indent. If moving
- ;; more than one item, ensure we keep them on subsequent moves.
- (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
- (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
- (if regionp
- (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-at-bol))
- (set-marker org-last-indent-end-marker
- (save-excursion
- (cond
- (specialp bottom)
- (no-subtree (org-end-of-item-or-at-child bottom))
- (t (org-get-end-of-item bottom)))))))
- ;; Get everything ready
- (let* ((beg (marker-position org-last-indent-begin-marker))
- (end (marker-position org-last-indent-end-marker))
- (struct (org-list-struct
- beg end top (if specialp end bottom) (< arg 0)))
- (origins (org-list-struct-origins struct))
- (beg-item (assq beg struct)))
- (cond
- ;; Special case: moving top-item with indent rule
- (specialp
- (let* ((level-skip (org-level-increment))
- (offset (if (< arg 0) (- level-skip) level-skip))
- (top-ind (nth 1 beg-item)))
- (if (< (+ top-ind offset) 0)
- (error "Cannot outdent beyond margin")
- ;; Change bullet if necessary
- (when (and (= (+ top-ind offset) 0)
- (string-match "*" (nth 2 beg-item)))
- (setcdr beg-item (list (nth 1 beg-item)
- (org-list-bullet-string "-"))))
- ;; Shift ancestor
- (let ((anc (car struct)))
- (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
- (org-list-struct-fix-struct struct origins)
- (org-list-struct-apply-struct struct end))))
- ;; Forbidden move
- ((and (< arg 0)
- (or (and no-subtree
- (not regionp)
- (org-list-struct-get-child beg-item struct))
- (let ((last-item (save-excursion
- (goto-char end)
- (skip-chars-backward " \r\t\n")
- (goto-char (org-get-item-beginning))
- (org-list-struct-assoc-at-point))))
- (org-list-struct-get-child last-item struct))))
- (error "Cannot outdent an item without its children"))
- ;; Normal shifting
- (t
- (let* ((shifted-ori (if (< arg 0)
- (org-list-struct-outdent beg end origins)
- (org-list-struct-indent beg end origins struct))))
- (org-list-struct-fix-struct struct shifted-ori)
- (org-list-struct-apply-struct struct bottom))))))))))
- ;;; Predicates
- (defun org-in-item-p ()
- "Is the cursor inside a plain list?
- This checks `org-list-ending-method'."
- (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
- (let* ((prev-head (save-excursion (outline-previous-heading)))
- (bound (if prev-head
- (or (save-excursion
- (let ((case-fold-search t))
- (re-search-backward "^[ \t]*:END:" prev-head t)))
- prev-head)
- (point-min))))
- (cond
- ((eq org-list-ending-method 'regexp)
- (org-list-in-item-p-with-regexp bound))
- ((eq org-list-ending-method 'indent)
- (org-list-in-item-p-with-indent bound))
- (t (and (org-list-in-item-p-with-regexp bound)
- (org-list-in-item-p-with-indent bound)))))))
- (defun org-list-first-item-p (top)
- "Is this item the first item in a plain list?
- Assume point is at an item.
- TOP is the position of list's top-item."
- (save-excursion
- (beginning-of-line)
- (let ((ind (org-get-indentation)))
- (or (not (org-search-backward-unenclosed org-item-beginning-re top t))
- (< (org-get-indentation) ind)))))
- (defun org-at-item-p ()
- "Is point in a line starting a hand-formatted item?"
- (save-excursion
- (beginning-of-line) (looking-at org-item-beginning-re)))
- (defun org-at-item-bullet-p ()
- "Is point at the bullet of a plain list item?"
- (and (org-at-item-p)
- (not (member (char-after) '(?\ ?\t)))
- (< (point) (match-end 0))))
- (defun org-at-item-timer-p ()
- "Is point at a line starting a plain list item with a timer?"
- (org-list-at-regexp-after-bullet-p
- "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
- (defun org-at-item-description-p ()
- "Is point at a description list item?"
- (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?"
- (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
- (defun org-checkbox-blocked-p ()
- "Is the current checkbox blocked from for being checked now?
- A checkbox is blocked if all of the following conditions are fulfilled:
- 1. The checkbox is not checked already.
- 2. The current entry has the ORDERED property set.
- 3. There is an unchecked checkbox in this entry before the current line."
- (catch 'exit
- (save-match-data
- (save-excursion
- (unless (org-at-item-checkbox-p) (throw 'exit nil))
- (when (equal (match-string 1) "[X]")
- ;; the box is already checked!
- (throw 'exit nil))
- (let ((end (point-at-bol)))
- (condition-case nil (org-back-to-heading t)
- (error (throw 'exit nil)))
- (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
- (when (org-search-forward-unenclosed
- "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t)
- (org-current-line)))))))
- ;;; Navigate
- ;; Every interactive navigation function is derived from a
- ;; non-interactive one, which doesn't move point, assumes point is
- ;; already in a list and doesn't compute list boundaries.
- ;; If you plan to use more than one org-list function is some code,
- ;; you should therefore first check if point is in a list with
- ;; `org-in-item-p' or `org-at-item-p', then compute list boundaries
- ;; with `org-list-top-point' and `org-list-bottom-point', and make use
- ;; of non-interactive forms.
- (defun org-list-top-point ()
- "Return point at the top level in a list.
- Assume point is in a list."
- (let* ((prev-head (save-excursion (outline-previous-heading)))
- (bound (if prev-head
- (or (save-excursion
- (let ((case-fold-search t))
- (re-search-backward "^[ \t]*:END:" prev-head t)))
- prev-head)
- (point-min))))
- (cond
- ((eq org-list-ending-method 'regexp)
- (org-list-top-point-with-regexp bound))
- ((eq org-list-ending-method 'indent)
- (org-list-top-point-with-indent bound))
- (t (let ((top-re (org-list-top-point-with-regexp bound)))
- (org-list-top-point-with-indent (or top-re bound)))))))
- (defun org-list-bottom-point ()
- "Return point just before list ending.
- Assume point is in a list."
- (let* ((next-head (save-excursion
- (and (let ((outline-regexp org-outline-regexp))
- ;; Use default regexp because folding
- ;; changes OUTLINE-REGEXP.
- (outline-next-heading)))))
- (limit (or (save-excursion
- (and (re-search-forward "^[ \t]*:END:" next-head t)
- (point-at-bol)))
- next-head
- (point-max))))
- (cond
- ((eq org-list-ending-method 'regexp)
- (org-list-bottom-point-with-regexp limit))
- ((eq org-list-ending-method 'indent)
- (org-list-bottom-point-with-indent limit))
- (t (let ((bottom-re (org-list-bottom-point-with-regexp limit)))
- (org-list-bottom-point-with-indent (or bottom-re limit)))))))
- (defun org-get-item-beginning ()
- "Return position of current item beginning."
- (save-excursion
- ;; possibly match current line
- (end-of-line)
- (org-search-backward-unenclosed org-item-beginning-re nil t)
- (point-at-bol)))
- (defun org-beginning-of-item ()
- "Go to the beginning of the current hand-formatted item.
- If the cursor is not in an item, throw an error."
- (interactive)
- (if (org-in-item-p)
- (goto-char (org-get-item-beginning))
- (error "Not in an item")))
- (defun org-get-beginning-of-list (top)
- "Return position of the first item of the current list or sublist.
- TOP is the position at list beginning."
- (save-excursion
- (let (prev-p)
- (while (setq prev-p (org-get-previous-item (point) top))
- (goto-char prev-p))
- (point-at-bol))))
- (defun org-beginning-of-item-list ()
- "Go to the beginning item of the current list or sublist.
- Return an error if not in a list."
- (interactive)
- (if (org-in-item-p)
- (goto-char (org-get-beginning-of-list (org-list-top-point)))
- (error "Not in an item")))
- (defun org-get-end-of-list (bottom)
- "Return position at the end of the current list or sublist.
- BOTTOM is the position at list ending."
- (save-excursion
- (goto-char (org-get-item-beginning))
- (let ((ind (org-get-indentation)))
- (while (and (/= (point) bottom)
- (>= (org-get-indentation) ind))
- (org-search-forward-unenclosed org-item-beginning-re bottom 'move))
- (if (= (point) bottom) bottom (point-at-bol)))))
- (defun org-end-of-item-list ()
- "Go to the end of the current list or sublist.
- If the cursor in not in an item, throw an error."
- (interactive)
- (if (org-in-item-p)
- (goto-char (org-get-end-of-list (org-list-bottom-point)))
- (error "Not in an item")))
- (defun org-get-end-of-item (bottom)
- "Return position at the end of the current item.
- BOTTOM is the position at list ending."
- (or (org-get-next-item (point) bottom)
- (org-get-end-of-list bottom)))
- (defun org-end-of-item ()
- "Go to the end of the current hand-formatted item.
- If the cursor is not in an item, throw an error."
- (interactive)
- (if (org-in-item-p)
- (goto-char (org-get-end-of-item (org-list-bottom-point)))
- (error "Not in an item")))
- (defun org-end-of-item-or-at-child (bottom)
- "Move to the end of the item, stops before the first child if any.
- BOTTOM is the position at list ending."
- (end-of-line)
- (goto-char
- (if (org-search-forward-unenclosed org-item-beginning-re bottom t)
- (point-at-bol)
- (org-get-end-of-item bottom))))
- (defun org-end-of-item-before-blank (bottom)
- "Return point at end of item, before any blank line.
- Point returned is at eol.
- BOTTOM is the position at list ending."
- (save-excursion
- (goto-char (org-get-end-of-item bottom))
- (skip-chars-backward " \r\t\n")
- (point-at-eol)))
- (defun org-get-previous-item (pos limit)
- "Return point of the previous item at the same level as POS.
- Stop searching at LIMIT. Return nil if no item is found."
- (org-list-get-item-same-level
- #'org-search-backward-unenclosed pos limit #'beginning-of-line))
- (defun org-previous-item ()
- "Move to the beginning of the previous item.
- Item is at the same level in the current plain list. Error if not
- in a plain list, or if this is the first item in the list."
- (interactive)
- (if (not (org-in-item-p))
- (error "Not in an item")
- (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
- (if prev-p (goto-char prev-p) (error "On first item")))))
- (defun org-get-next-item (pos limit)
- "Return point of the next item at the same level as POS.
- Stop searching at LIMIT. Return nil if no item is found."
- (org-list-get-item-same-level
- #'org-search-forward-unenclosed pos limit #'end-of-line))
- (defun org-next-item ()
- "Move to the beginning of the next item.
- Item is at the same level in the current plain list. Error if not
- in a plain list, or if this is the last item in the list."
- (interactive)
- (if (not (org-in-item-p))
- (error "Not in an item")
- (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
- (if next-p (goto-char next-p) (error "On last item")))))
- ;;; Manipulate
- (defun org-list-exchange-items (beg-A beg-B bottom)
- "Swap item starting at BEG-A with item starting at BEG-B.
- Blank lines at the end of items are left in place. Assume BEG-A
- is lesser than BEG-B.
- BOTTOM is the position at list ending."
- (save-excursion
- (let* ((end-of-item-no-blank
- (lambda (pos)
- (goto-char pos)
- (goto-char (org-end-of-item-before-blank bottom))))
- (end-A-no-blank (funcall end-of-item-no-blank beg-A))
- (end-B-no-blank (funcall end-of-item-no-blank beg-B))
- (body-A (buffer-substring beg-A end-A-no-blank))
- (body-B (buffer-substring beg-B end-B-no-blank))
- (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
- (goto-char beg-A)
- (delete-region beg-A end-B-no-blank)
- (insert (concat body-B between-A-no-blank-and-B body-A)))))
- (defun org-move-item-down ()
- "Move the plain list item at point down, i.e. swap with following item.
- Subitems (items with larger indentation) are considered part of the item,
- so this really moves item trees."
- (interactive)
- (if (not (org-at-item-p))
- (error "Not at an item")
- (let* ((pos (point))
- (col (current-column))
- (bottom (org-list-bottom-point))
- (actual-item (goto-char (org-get-item-beginning)))
- (next-item (org-get-next-item (point) bottom)))
- (if (not next-item)
- (progn
- (goto-char pos)
- (error "Cannot move this item further down"))
- (org-list-exchange-items actual-item next-item bottom)
- (org-list-repair nil nil bottom)
- (goto-char (org-get-next-item (point) bottom))
- (move-to-column col)))))
- (defun org-move-item-up ()
- "Move the plain list item at point up, i.e. swap with previous item.
- Subitems (items with larger indentation) are considered part of the item,
- so this really moves item trees."
- (interactive)
- (if (not (org-at-item-p))
- (error "Not at an item")
- (let* ((pos (point))
- (col (current-column))
- (top (org-list-top-point))
- (bottom (org-list-bottom-point))
- (actual-item (goto-char (org-get-item-beginning)))
- (prev-item (org-get-previous-item (point) top)))
- (if (not prev-item)
- (progn
- (goto-char pos)
- (error "Cannot move this item further up"))
- (org-list-exchange-items prev-item actual-item bottom)
- (org-list-repair nil top bottom)
- (move-to-column col)))))
- (defun org-insert-item (&optional checkbox)
- "Insert a new item at the current level.
- If cursor is before first character after bullet of the item, the
- new item will be created before the current one.
- If CHECKBOX is non-nil, add a checkbox next to the bullet.
- Return t when things worked, nil when we are not in an item, or
- item is invisible."
- (unless (or (not (org-in-item-p))
- (save-excursion
- (goto-char (org-get-item-beginning))
- (org-invisible-p)))
- (if (save-excursion
- (goto-char (org-get-item-beginning))
- (org-at-item-timer-p))
- ;; Timer list: delegate to `org-timer-item'.
- (progn (org-timer-item) t)
- ;; if we're in a description list, ask for the new term.
- (let ((desc-text (when (save-excursion
- (and (goto-char (org-get-item-beginning))
- (org-at-item-description-p)))
- (concat (read-string "Term: ") " :: "))))
- ;; Don't insert a checkbox if checkbox rule is applied and it
- ;; is a description item.
- (org-list-insert-item-generic
- (point) (and checkbox
- (or (not desc-text)
- (not (cdr (assq 'checkbox org-list-automatic-rules)))))
- desc-text)))))
- ;;; Structures
- ;; The idea behind structures is to avoid moving back and forth in the
- ;; buffer on costly operations like indenting or fixing bullets.
- ;; It achieves this by taking a snapshot of an interesting part of the
- ;; list, in the shape of an alist, using `org-list-struct'.
- ;; It then proceeds to changes directly on the alist, with the help of
- ;; and `org-list-struct-origins'. When those are done,
- ;; `org-list-struct-apply-struct' applies the changes to the buffer.
- (defun org-list-struct-assoc-at-point ()
- "Return the structure association at point.
- It is a cons-cell whose key is point and values are indentation,
- bullet string and bullet counter, if any."
- (save-excursion
- (beginning-of-line)
- (list (point-at-bol)
- (org-get-indentation)
- (progn
- (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
- (match-string 1))
- (progn
- (goto-char (match-end 0))
- (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]")
- (match-string 1))))))
- (defun org-list-struct (begin end top bottom &optional outdent)
- "Return the structure containing the list between BEGIN and END.
- A structure is an alist where key is point of item and values
- are, in that order, indentation, bullet string and value of
- counter, if any. A structure contains every list and sublist that
- has items between BEGIN and END along with their common ancestor.
- If no such ancestor can be found, the function will add a virtual
- ancestor at position 0.
- TOP and BOTTOM are respectively the position of list beginning
- and list ending.
- If OUTDENT is non-nil, it will also grab all of the parent list
- and the grand-parent. Setting OUTDENT to t is mandatory when next
- change is an outdent."
- (save-excursion
- (let* (struct
- (extend
- (lambda (struct)
- (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
- (begin (caar struct))
- (end (caar (last struct)))
- pre-list post-list)
- (goto-char begin)
- ;; Find beginning of most outdented list (min list)
- (while (and (org-search-backward-unenclosed
- org-item-beginning-re top t)
- (>= (org-get-indentation) ind-min))
- (setq pre-list (cons (org-list-struct-assoc-at-point)
- pre-list)))
- ;; Now get the parent. If none, add a virtual ancestor
- (if (< (org-get-indentation) ind-min)
- (setq pre-list (cons (org-list-struct-assoc-at-point)
- pre-list))
- (setq pre-list (cons (list 0 (org-get-indentation) "" nil)
- pre-list)))
- ;; Find end of min list
- (goto-char end)
- (end-of-line)
- (while (and (org-search-forward-unenclosed
- org-item-beginning-re bottom 'move)
- (>= (org-get-indentation) ind-min))
- (setq post-list (cons (org-list-struct-assoc-at-point)
- post-list)))
- ;; Is list is malformed? If some items are less
- ;; indented that top-item, add them anyhow.
- (when (and (= (caar pre-list) 0) (< (point) bottom))
- (beginning-of-line)
- (while (org-search-forward-unenclosed
- org-item-beginning-re bottom t)
- (setq post-list (cons (org-list-struct-assoc-at-point)
- post-list))))
- (append pre-list struct (reverse post-list))))))
- ;; Here we start: first get the core zone...
- (goto-char end)
- (while (org-search-backward-unenclosed org-item-beginning-re begin t)
- (setq struct (cons (org-list-struct-assoc-at-point) struct)))
- ;; ... then, extend it to make it a structure...
- (let ((extended (funcall extend struct)))
- ;; ... twice when OUTDENT is non-nil and struct still can be
- ;; extended
- (if (and outdent (> (caar extended) 0))
- (funcall extend extended)
- extended)))))
- (defun org-list-struct-origins (struct)
- "Return an alist where key is item's position and value parent's.
- STRUCT is the list's structure looked up."
- (let* ((struct-rev (reverse struct))
- (acc (list (cons (nth 1 (car struct)) 0)))
- (prev-item (lambda (item)
- (car (nth 1 (member (assq item struct) struct-rev)))))
- (get-origins
- (lambda (item)
- (let* ((item-pos (car item))
- (ind (nth 1 item))
- (prev-ind (caar acc)))
- (cond
- ;; List closing.
- ((> prev-ind ind)
- (let ((current-origin (or (member (assq ind acc) acc)
- ;; needed if top-point is
- ;; not the most outdented
- (last acc))))
- (setq acc current-origin)
- (cons item-pos (cdar acc))))
- ;; New list
- ((< prev-ind ind)
- (let ((origin (funcall prev-item item-pos)))
- (setq acc (cons (cons ind origin) acc))
- (cons item-pos origin)))
- ;; Current list going on
- (t (cons item-pos (cdar acc))))))))
- (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
- (defun org-list-struct-get-parent (item struct origins)
- "Return parent association of ITEM in STRUCT or nil.
- ORIGINS is the alist of parents. See `org-list-struct-origins'."
- (let* ((parent-pos (cdr (assq (car item) origins))))
- (when (> parent-pos 0) (assq parent-pos struct))))
- (defun org-list-struct-get-child (item struct)
- "Return child association of ITEM in STRUCT or nil."
- (let ((ind (nth 1 item))
- (next-item (cadr (member item struct))))
- (when (and next-item (> (nth 1 next-item) ind)) next-item)))
- (defun org-list-struct-fix-bul (struct origins)
- "Verify and correct bullets for every association in STRUCT.
- ORIGINS is the alist of parents. See `org-list-struct-origins'.
- This function modifies STRUCT."
- (let* (acc
- (init-bul (lambda (item)
- (let ((counter (nth 3 item))
- (bullet (org-list-bullet-string (nth 2 item))))
- (cond
- ((and (string-match "[0-9]+" bullet) counter)
- (replace-match counter nil nil bullet))
- ((string-match "[0-9]+" bullet)
- (replace-match "1" nil nil bullet))
- (t bullet)))))
- (set-bul (lambda (item bullet)
- (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
- (get-bul (lambda (item bullet)
- (let* ((counter (nth 3 item)))
- (if (and counter (string-match "[0-9]+" bullet))
- (replace-match counter nil nil bullet)
- bullet))))
- (fix-bul
- (lambda (item) struct
- (let* ((parent (cdr (assq (car item) origins)))
- (orig-ref (assq parent acc)))
- (if orig-ref
- ;; Continuing previous list
- (let* ((prev-bul (cdr orig-ref))
- (new-bul (funcall get-bul item prev-bul)))
- (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
- (funcall set-bul item new-bul))
- ;; A new list is starting
- (let ((new-bul (funcall init-bul item)))
- (funcall set-bul item new-bul)
- (setq acc (cons (cons parent
- (org-list-inc-bullet-maybe new-bul))
- acc))))))))
- (mapc fix-bul (cdr struct))))
- (defun org-list-struct-fix-ind (struct origins)
- "Verify and correct indentation for every association in STRUCT.
- ORIGINS is the alist of parents. See `org-list-struct-origins'.
- This function modifies STRUCT."
- (let* ((headless (cdr struct))
- (ancestor (car struct))
- (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
- (new-ind
- (lambda (item)
- (let* ((parent (org-list-struct-get-parent item headless origins)))
- (if parent
- ;; Indent like parent + length of parent's bullet
- (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent))
- (cddr item)))
- ;; If no parent, indent like top-point
- (setcdr item (cons top-ind (cddr item))))))))
- (mapc new-ind headless)))
- (defun org-list-struct-fix-struct (struct origins)
- "Return STRUCT with correct bullets and indentation.
- ORIGINS is the alist of parents. See `org-list-struct-origins'.
- Only elements of STRUCT that have changed are returned."
- (let ((old (copy-alist struct)))
- (org-list-struct-fix-bul struct origins)
- (org-list-struct-fix-ind struct origins)
- (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct))))
- (defun org-list-struct-outdent (start end origins)
- "Outdent items in a structure.
- Items are indented when their key is between START, included, and
- END, excluded.
- ORIGINS is the alist of parents. See `org-list-struct-origins'.
- STRUCT is the concerned structure."
- (let* (acc
- (out (lambda (cell)
- (let* ((item (car cell))
- (parent (cdr cell)))
- (cond
- ;; Item not yet in zone: keep association
- ((< item start) cell)
- ;; Item out of zone: follow associations in acc
- ((>= item end)
- (let ((convert (assq parent acc)))
- (if convert (cons item (cdr convert)) cell)))
- ;; Item has no parent: error
- ((<= parent 0)
- (error "Cannot outdent top-level items"))
- ;; Parent is outdented: keep association
- ((>= parent start)
- (setq acc (cons (cons parent item) acc)) cell)
- (t
- ;; Parent isn't outdented: reparent to grand-parent
- (let ((grand-parent (cdr (assq parent origins))))
- (setq acc (cons (cons parent item) acc))
- (cons item grand-parent))))))))
- (mapcar out origins)))
- (defun org-list-struct-indent (start end origins struct)
- "Indent items in a structure.
- Items are indented when their key is between START, included, and
- END, excluded.
- ORIGINS is the alist of parents. See `org-list-struct-origins'.
- STRUCT is the concerned structure. It may be modified if
- `org-list-demote-modify-bullet' matches bullets between START and
- END."
- (let* (acc
- (orig-rev (reverse origins))
- (get-prev-item
- (lambda (cell parent)
- (car (rassq parent (cdr (memq cell orig-rev))))))
- (set-assoc
- (lambda (cell)
- (setq acc (cons cell acc)) cell))
- (change-bullet-maybe
- (lambda (item)
- (let* ((full-item (assq item struct))
- (item-bul (org-trim (nth 2 full-item)))
- (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet))))
- (when new-bul-p
- ;; new bullet is stored without space to ensure item
- ;; will be modified
- (setcdr full-item
- (list (nth 1 full-item)
- new-bul-p
- (nth 3 full-item)))))))
- (ind
- (lambda (cell)
- (let* ((item (car cell))
- (parent (cdr cell)))
- (cond
- ;; Item not yet in zone: keep association
- ((< item start) cell)
- ((>= item end)
- ;; Item out of zone: follow associations in acc
- (let ((convert (assq parent acc)))
- (if convert (cons item (cdr convert)) cell)))
- (t
- ;; Item is in zone...
- (let ((prev (funcall get-prev-item cell parent)))
- ;; Check if bullet needs to be changed
- (funcall change-bullet-maybe item)
- (cond
- ;; First item indented but not parent: error
- ((and (or (not prev) (= prev 0)) (< parent start))
- (error "Cannot indent the first item of a list"))
- ;; First item and parent indented: keep same parent
- ((or (not prev) (= prev 0))
- (funcall set-assoc cell))
- ;; Previous item not indented: reparent to it
- ((< prev start)
- (funcall set-assoc (cons item prev)))
- ;; Previous item indented: reparent like it
- (t
- (funcall set-assoc (cons item
- (cdr (assq prev acc)))))))))))))
- (mapcar ind origins)))
- (defun org-list-struct-apply-struct (struct bottom)
- "Apply modifications to list so it mirrors STRUCT.
- BOTTOM is position at list ending.
- Initial position is restored after the changes."
- (let* ((pos (copy-marker (point)))
- (ancestor (caar struct))
- (modify
- (lambda (item)
- (goto-char (car item))
- (let* ((new-ind (nth 1 item))
- (new-bul (org-list-bullet-string (nth 2 item)))
- (old-ind (org-get-indentation))
- (old-bul (progn
- (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
- (match-string 1)))
- (old-body-ind (+ (length old-bul) old-ind))
- (new-body-ind (+ (length new-bul) new-ind)))
- ;; 1. Shift item's body
- (unless (= old-body-ind new-body-ind)
- (org-shift-item-indentation
- (- new-body-ind old-body-ind) bottom))
- ;; 2. Replace bullet
- (unless (equal new-bul old-bul)
- (save-excursion
- (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
- (replace-match new-bul nil nil nil 1)))
- ;; 3. Indent item to appropriate column
- (unless (= new-ind old-ind)
- (delete-region (point-at-bol)
- (progn
- (skip-chars-forward " \t")
- (point)))
- (indent-to new-ind)))))
- ;; Remove ancestor if it is left.
- (struct-to-apply (if (or (not ancestor) (= 0 ancestor))
- (cdr struct)
- struct)))
- ;; Apply changes from bottom to top
- (mapc modify (nreverse struct-to-apply))
- (goto-char pos)))
- ;;; Indentation
- (defun org-get-string-indentation (s)
- "What indentation has S due to SPACE and TAB at the beginning of the string?"
- (let ((n -1) (i 0) (w tab-width) c)
- (catch 'exit
- (while (< (setq n (1+ n)) (length s))
- (setq c (aref s n))
- (cond ((= c ?\ ) (setq i (1+ i)))
- ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
- (t (throw 'exit t)))))
- i))
- (defun org-shift-item-indentation (delta bottom)
- "Shift the indentation in current item by DELTA.
- Sub-items are not moved.
- BOTTOM is position at list ending."
- (save-excursion
- (let ((beg (point-at-bol))
- (end (org-end-of-item-or-at-child bottom)))
- (beginning-of-line (unless (eolp) 0))
- (while (> (point) beg)
- (when (looking-at "[ \t]*\\S-")
- ;; this is not an empty line
- (let ((i (org-get-indentation)))
- (when (and (> i 0) (> (+ i delta) 0))
- (indent-line-to (+ i delta)))))
- (beginning-of-line 0)))))
- (defun org-outdent-item ()
- "Outdent a local list item, but not its children.
- If a region is active, all items inside will be moved."
- (interactive)
- (org-list-indent-item-generic
- -1 t (org-list-top-point) (org-list-bottom-point)))
- (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)
- (org-list-indent-item-generic
- 1 t (org-list-top-point) (org-list-bottom-point)))
- (defun org-outdent-item-tree ()
- "Outdent a local list item including its children.
- If a region is active, all items inside will be moved."
- (interactive)
- (org-list-indent-item-generic
- -1 nil (org-list-top-point) (org-list-bottom-point)))
- (defun org-indent-item-tree ()
- "Indent a local list item including its children.
- If a region is active, all items inside will be moved."
- (interactive)
- (org-list-indent-item-generic
- 1 nil (org-list-top-point) (org-list-bottom-point)))
- (defvar org-tab-ind-state)
- (defun org-cycle-item-indentation ()
- "Cycle levels of indentation of an empty item.
- The first run indent the item, if applicable. Subsequents runs
- outdent it at meaningful levels in the list. When done, item is
- put back at its original position with its original bullet.
- Return t at each successful move."
- (let ((org-adapt-indentation nil)
- (ind (org-get-indentation))
- (bottom (and (org-at-item-p) (org-list-bottom-point))))
- (when (and (or (org-at-item-description-p)
- (org-at-item-checkbox-p)
- (org-at-item-p))
- ;; Check that item is really empty
- (>= (match-end 0) (save-excursion
- (org-end-of-item-or-at-child bottom)
- (skip-chars-backward " \r\t\n")
- (point))))
- (setq this-command 'org-cycle-item-indentation)
- (let ((top (org-list-top-point)))
- ;; When in the middle of the cycle, try to outdent first. If it
- ;; fails, and point is still at initial position, indent. Else,
- ;; go back to original position.
- (if (eq last-command 'org-cycle-item-indentation)
- (cond
- ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
- ((and (= (org-get-indentation) (car org-tab-ind-state))
- (ignore-errors
- (org-list-indent-item-generic 1 t top bottom))))
- (t (back-to-indentation)
- (indent-to-column (car org-tab-ind-state))
- (end-of-line)
- (org-list-repair (cdr org-tab-ind-state))
- ;; Break cycle
- (setq this-command 'identity)))
- ;; If a cycle is starting, remember indentation and bullet,
- ;; then try to indent. If it fails, try to outdent.
- (setq org-tab-ind-state (cons ind (org-get-bullet)))
- (cond
- ((ignore-errors (org-list-indent-item-generic 1 t top bottom)))
- ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
- (t (error "Cannot move item")))))
- t)))
- ;;; Bullets
- (defun org-get-bullet ()
- "Return the bullet of the item at point.
- Assume cursor is at an item."
- (save-excursion
- (beginning-of-line)
- (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))))
- (defun org-list-bullet-string (bullet)
- "Return BULLET with the correct number of whitespaces.
- It determines the number of whitespaces to append by looking at
- `org-list-two-spaces-after-bullet-regexp'."
- (save-match-data
- (string-match "\\S-+\\([ \t]*\\)" bullet)
- (replace-match
- (save-match-data
- (concat
- " "
- ;; Do we need to concat another white space ?
- (when (and org-list-two-spaces-after-bullet-regexp
- (string-match org-list-two-spaces-after-bullet-regexp bullet))
- " ")))
- nil nil bullet 1)))
- (defun org-list-inc-bullet-maybe (bullet)
- "Increment BULLET if applicable."
- (if (string-match "[0-9]+" bullet)
- (replace-match
- (number-to-string (1+ (string-to-number (match-string 0 bullet))))
- nil nil bullet)
- bullet))
- (defun org-list-repair (&optional force-bullet top bottom)
- "Make sure all items are correctly indented, with the right bullet.
- This function scans the list at point, along with any sublist.
- If FORCE-BULLET is a string, ensure all items in list share this
- bullet, or a logical successor in the case of an ordered list.
- When non-nil, TOP and BOTTOM specify respectively position of
- list beginning and list ending.
- Item's body is not indented, only shifted with the bullet."
- (interactive)
- (unless (org-at-item-p) (error "This is not a list"))
- (let* ((bottom (or bottom (org-list-bottom-point)))
- (struct (org-list-struct
- (point-at-bol) (point-at-eol)
- (or top (org-list-top-point)) bottom))
- (origins (org-list-struct-origins struct))
- fixed-struct)
- (if (stringp force-bullet)
- (let ((begin (nth 1 struct)))
- (setcdr begin (list (nth 1 begin)
- (org-list-bullet-string force-bullet)
- (nth 3 begin)))
- (setq fixed-struct
- (cons begin (org-list-struct-fix-struct struct origins))))
- (setq fixed-struct (org-list-struct-fix-struct struct origins)))
- (org-list-struct-apply-struct fixed-struct bottom)))
- (defun org-cycle-list-bullet (&optional which)
- "Cycle through the different itemize/enumerate bullets.
- This cycle the entire list level through the sequence:
- `-' -> `+' -> `*' -> `1.' -> `1)'
- If WHICH is a valid string, use that as the new bullet. If WHICH
- is an integer, 0 means `-', 1 means `+' etc. If WHICH is
- 'previous, cycle backwards."
- (interactive "P")
- (let* ((top (org-list-top-point))
- (bullet (save-excursion
- (goto-char (org-get-beginning-of-list top))
- (org-get-bullet)))
- (current (cond
- ((string-match "\\." bullet) "1.")
- ((string-match ")" bullet) "1)")
- (t bullet)))
- (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
- (bullet-list (append '("-" "+" )
- ;; *-bullets are not allowed at column 0
- (unless (and bullet-rule-p
- (looking-at "\\S-")) '("*"))
- ;; Description items cannot be numbered
- (unless (and bullet-rule-p
- (or (eq org-plain-list-ordered-item-terminator ?\))
- (org-at-item-description-p))) '("1."))
- (unless (and bullet-rule-p
- (or (eq org-plain-list-ordered-item-terminator ?.)
- (org-at-item-description-p))) '("1)"))))
- (len (length bullet-list))
- (item-index (- len (length (member current bullet-list))))
- (get-value (lambda (index) (nth (mod index len) bullet-list)))
- (new (cond
- ((member which bullet-list) which)
- ((numberp which) (funcall get-value which))
- ((eq 'previous which) (funcall get-value (1- item-index)))
- (t (funcall get-value (1+ item-index))))))
- (org-list-repair new top)))
- ;;; Checkboxes
- (defun org-toggle-checkbox (&optional toggle-presence)
- "Toggle the checkbox in the current line.
- With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
- double prefix, set checkbox to [-].
- When there is an active region, toggle status or presence of the
- first checkbox there, and make every item inside have the
- same status or presence, respectively.
- If the cursor is in a headline, apply this to all checkbox items
- in the text below the heading, taking as reference the first item
- in subtree, ignoring drawers."
- (interactive "P")
- ;; Bounds is a list of type (beg end single-p) where single-p is t
- ;; when `org-toggle-checkbox' is applied to a single item. Only
- ;; toggles on single items will return errors.
- (let* ((bounds
- (cond
- ((org-region-active-p)
- (let ((rbeg (region-beginning))
- (rend (region-end)))
- (save-excursion
- (goto-char rbeg)
- (if (org-search-forward-unenclosed org-item-beginning-re rend 'move)
- (list (point-at-bol) rend nil)
- (error "No item in region")))))
- ((org-on-heading-p)
- ;; In this case, reference line is the first item in
- ;; subtree outside drawers
- (let ((pos (point))
- (limit (save-excursion (outline-next-heading) (point))))
- (save-excursion
- (goto-char limit)
- (org-search-backward-unenclosed ":END:" pos 'move)
- (org-search-forward-unenclosed
- org-item-beginning-re limit 'move)
- (list (point) limit nil))))
- ((org-at-item-p)
- (list (point-at-bol) (point-at-eol) t))
- (t (error "Not at an item or heading, and no active region"))))
- (beg (car bounds))
- ;; marker is needed because deleting or inserting checkboxes
- ;; will change bottom point
- (end (copy-marker (nth 1 bounds)))
- (single-p (nth 2 bounds))
- (ref-presence (save-excursion
- (goto-char beg)
- (org-at-item-checkbox-p)))
- (ref-status (equal (match-string 1) "[X]"))
- (act-on-item
- (lambda (ref-pres ref-stat)
- (if (equal toggle-presence '(4))
- (cond
- ((and ref-pres (org-at-item-checkbox-p))
- (replace-match ""))
- ((and (not ref-pres)
- (not (org-at-item-checkbox-p))
- (org-at-item-p))
- (goto-char (match-end 0))
- ;; Ignore counter, if any
- (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
- (goto-char (match-end 0)))
- (let ((desc-p (and (org-at-item-description-p)
- (cdr (assq 'checkbox org-list-automatic-rules)))))
- (cond
- ((and single-p desc-p)
- (error "Cannot add a checkbox in a description list"))
- ((not desc-p) (insert "[ ] "))))))
- (let ((blocked (org-checkbox-blocked-p)))
- (cond
- ((and blocked single-p)
- (error "Checkbox blocked because of unchecked box in line %d" blocked))
- (blocked nil)
- ((org-at-item-checkbox-p)
- (replace-match
- (cond ((equal toggle-presence '(16)) "[-]")
- (ref-stat "[ ]")
- (t "[X]"))
- t t nil 1))))))))
- (save-excursion
- (goto-char beg)
- (while (< (point) end)
- (funcall act-on-item ref-presence ref-status)
- (org-search-forward-unenclosed org-item-beginning-re end 'move)))
- (org-update-checkbox-count-maybe)))
- (defun org-reset-checkbox-state-subtree ()
- "Reset all checkboxes in an entry subtree."
- (interactive "*")
- (save-restriction
- (save-excursion
- (org-narrow-to-subtree)
- (org-show-subtree)
- (goto-char (point-min))
- (let ((end (point-max)))
- (while (< (point) end)
- (when (org-at-item-checkbox-p)
- (replace-match "[ ]" t t nil 1))
- (beginning-of-line 2))))
- (org-update-checkbox-count-maybe)))
- (defvar org-checkbox-statistics-hook nil
- "Hook that is run whenever Org thinks checkbox statistics should be updated.
- This hook runs even if checkbox rule in
- `org-list-automatic-rules' does not apply, so it can be used to
- implement alternative ways of collecting statistics
- information.")
- (defun org-update-checkbox-count-maybe ()
- "Update checkbox statistics unless turned off by user."
- (when (cdr (assq 'checkbox org-list-automatic-rules))
- (org-update-checkbox-count))
- (run-hooks 'org-checkbox-statistics-hook))
- (defun org-update-checkbox-count (&optional all)
- "Update the checkbox statistics in the current section.
- This will find all statistic cookies like [57%] and [6/12] and update them
- with the current numbers. With optional prefix argument ALL, do this for
- the whole buffer."
- (interactive "P")
- (save-excursion
- (let ((cstat 0))
- (catch 'exit
- (while t
- (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
- (beg (condition-case nil
- (progn (org-back-to-heading) (point))
- (error (point-min))))
- (end (copy-marker (save-excursion
- (outline-next-heading) (point))))
- (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
- beg-cookie end-cookie is-percent c-on c-off lim new
- curr-ind next-ind continue-from startsearch list-beg list-end
- (recursive
- (or (not org-hierarchical-checkbox-statistics)
- (string-match "\\<recursive\\>"
- (or (ignore-errors
- (org-entry-get nil "COOKIE_DATA"))
- "")))))
- (goto-char end)
- ;; find each statistics cookie
- (while (and (org-search-backward-unenclosed re-cookie beg 'move)
- (not (save-match-data
- (and (org-on-heading-p)
- (string-match "\\<todo\\>"
- (downcase
- (or (org-entry-get
- nil "COOKIE_DATA")
- "")))))))
- (setq beg-cookie (match-beginning 1)
- end-cookie (match-end 1)
- cstat (+ cstat (if end-cookie 1 0))
- startsearch (point-at-eol)
- continue-from (match-beginning 0)
- is-percent (match-beginning 2)
- lim (cond
- ((org-on-heading-p) (outline-next-heading) (point))
- ;; Ensure many cookies in the same list won't imply
- ;; computing list boundaries as many times.
- ((org-at-item-p)
- (unless (and list-beg (>= (point) list-beg))
- (setq list-beg (org-list-top-point)
- list-end (copy-marker
- (org-list-bottom-point))))
- (org-get-end-of-item list-end))
- (t nil))
- c-on 0
- c-off 0)
- (when lim
- ;; find first checkbox for this cookie and gather
- ;; statistics from all that are at this indentation level
- (goto-char startsearch)
- (if (org-search-forward-unenclosed re-box lim t)
- (progn
- (beginning-of-line)
- (setq curr-ind (org-get-indentation))
- (setq next-ind curr-ind)
- (while (and (bolp) (org-at-item-p)
- (if recursive
- (<= curr-ind next-ind)
- (= curr-ind next-ind)))
- (when (org-at-item-checkbox-p)
- (if (member (match-string 1) '("[ ]" "[-]"))
- (setq c-off (1+ c-off))
- (setq c-on (1+ c-on))))
- (if (not recursive)
- ;; org-get-next-item goes through list-enders
- ;; with proper limit.
- (goto-char (or (org-get-next-item (point) lim) lim))
- (end-of-line)
- (when (org-search-forward-unenclosed
- org-item-beginning-re lim t)
- (beginning-of-line)))
- (setq next-ind (org-get-indentation)))))
- (goto-char continue-from)
- ;; update cookie
- (when end-cookie
- (setq new (if is-percent
- (format "[%d%%]" (/ (* 100 c-on)
- (max 1 (+ c-on c-off))))
- (format "[%d/%d]" c-on (+ c-on c-off))))
- (goto-char beg-cookie)
- (insert new)
- (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
- ;; update items checkbox if it has one
- (when (and (org-at-item-checkbox-p)
- (> (+ c-on c-off) 0))
- (setq beg-cookie (match-beginning 1)
- end-cookie (match-end 1))
- (delete-region beg-cookie end-cookie)
- (goto-char beg-cookie)
- (cond ((= c-off 0) (insert "[X]"))
- ((= c-on 0) (insert "[ ]"))
- (t (insert "[-]")))))
- (goto-char continue-from)))
- (unless (and all (outline-next-heading)) (throw 'exit nil))))
- (when (interactive-p)
- (message "Checkbox statistics updated %s (%d places)"
- (if all "in entire file" "in current outline entry") cstat)))))
- (defun org-get-checkbox-statistics-face ()
- "Select the face for checkbox statistics.
- The face will be `org-done' when all relevant boxes are checked.
- Otherwise it will be `org-todo'."
- (if (match-end 1)
- (if (equal (match-string 1) "100%")
- 'org-checkbox-statistics-done
- 'org-checkbox-statistics-todo)
- (if (and (> (match-end 2) (match-beginning 2))
- (equal (match-string 2) (match-string 3)))
- 'org-checkbox-statistics-done
- 'org-checkbox-statistics-todo)))
- ;;; Misc Tools
- (defun org-apply-on-list (function init-value &rest args)
- "Call FUNCTION on each item of the list at point.
- FUNCTION must be called with at least one argument: INIT-VALUE,
- that will contain the value returned by the function at the
- previous item, plus ARGS extra arguments.
- 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
- beginning of the item."
- (let* ((pos (copy-marker (point)))
- (end (copy-marker (org-list-bottom-point)))
- (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point))))
- (value init-value))
- (while (< next-p end)
- (goto-char next-p)
- (set-marker next-p (or (org-get-next-item (point) end) end))
- (setq value (apply function value args)))
- (goto-char pos)
- value))
- (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
- "Sort plain list items.
- The cursor may be at any item of the list that should be sorted.
- Sublists are not sorted. Checkboxes, if any, are ignored.
- Sorting can be alphabetically, numerically, by date/time as given by
- a time stamp, by a property or by priority.
- Comparing entries ignores case by default. However, with an
- optional argument WITH-CASE, the sorting considers case as well.
- 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:
- 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.
- 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."
- (interactive "P")
- (let* ((case-func (if with-case 'identity 'downcase))
- (top (org-list-top-point))
- (bottom (org-list-bottom-point))
- (start (org-get-beginning-of-list top))
- (end (org-get-end-of-list bottom))
- (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)
- (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil)
- (intern getkey-func))))
- (message "Sorting items...")
- (save-restriction
- (narrow-to-region start end)
- (let* ((dcst (downcase sorting-type))
- (case-fold-search nil)
- (now (current-time))
- (sort-func (cond
- ((= dcst ?a) 'string<)
- ((= dcst ?f) compare-func)
- ((= dcst ?t) '<)
- (t nil)))
- (begin-record (lambda ()
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)))
- (end-record (lambda ()
- (goto-char (org-end-of-item-before-blank end))))
- (value-to-sort
- (lambda ()
- (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
- (cond
- ((= dcst ?n)
- (string-to-number (buffer-substring (match-end 0)
- (point-at-eol))))
- ((= dcst ?a)
- (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 (org-search-forward-unenclosed org-ts-regexp
- (point-at-eol) t)
- (org-search-forward-unenclosed org-ts-regexp-both
- (point-at-eol) t))
- (org-time-string-to-seconds (match-string 0)))
- (t (org-float-time now))))
- ((= dcst ?f)
- (if getkey-func
- (let ((value (funcall getkey-func)))
- (if (stringp value)
- (funcall case-func value)
- value))
- (error "Invalid key function `%s'" getkey-func)))
- (t (error "Invalid sorting type `%c'" sorting-type)))))))
- (sort-subr (/= dcst sorting-type)
- begin-record
- end-record
- value-to-sort
- nil
- sort-func)
- (org-list-repair nil top bottom)
- (run-hooks 'org-after-sorting-entries-or-items-hook)
- (message "Sorting items...done")))))
- ;;; Send and receive lists
- (defun org-list-parse-list (&optional delete)
- "Parse the list at point and maybe DELETE it.
- Return a list containing first level items as strings and
- sublevels as a list of strings."
- (let* ((start (goto-char (org-list-top-point)))
- (end (org-list-bottom-point))
- output itemsep ltype)
- (while (org-search-forward-unenclosed org-item-beginning-re end t)
- (save-excursion
- (beginning-of-line)
- (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
- ((org-at-item-description-p) 'descriptive)
- (t 'unordered))))
- (let* ((indent1 (org-get-indentation))
- (nextitem (or (org-get-next-item (point) end) end))
- (item (org-trim (buffer-substring (point)
- (org-end-of-item-or-at-child end))))
- (nextindent (if (= (point) end) 0 (org-get-indentation)))
- (item (if (string-match
- "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]"
- item)
- (replace-match (if (equal (match-string 1 item) " ")
- "CBOFF"
- "CBON")
- t nil item 1)
- item)))
- (push item output)
- (when (> nextindent indent1)
- (save-restriction
- (narrow-to-region (point) nextitem)
- (push (org-list-parse-list) output)))))
- (when delete
- (delete-region start end)
- (save-match-data
- (when (and (not (eq org-list-ending-method 'indent))
- (looking-at (org-list-end-re)))
- (replace-match "\n"))))
- (setq output (nreverse output))
- (push ltype output)))
- (defun org-list-make-subtree ()
- "Convert the plain list at point into a subtree."
- (interactive)
- (if (not (org-in-item-p))
- (error "Not in a list")
- (let ((list (org-list-parse-list t)) nstars)
- (save-excursion
- (if (ignore-errors
- (org-back-to-heading))
- (progn (looking-at org-complex-heading-regexp)
- (setq nstars (length (match-string 1))))
- (setq nstars 0)))
- (org-list-make-subtrees list (1+ nstars)))))
- (defun org-list-make-subtrees (list level)
- "Convert LIST into subtrees starting at LEVEL."
- (if (symbolp (car list))
- (org-list-make-subtrees (cdr list) level)
- (mapcar (lambda (item)
- (if (stringp item)
- (insert (make-string
- (if org-odd-levels-only
- (1- (* 2 level)) level) ?*) " " item "\n")
- (org-list-make-subtrees item (1+ level))))
- list)))
- (defun org-list-insert-radio-list ()
- "Insert a radio list template appropriate for this major mode."
- (interactive)
- (let* ((e (assq major-mode org-list-radio-list-templates))
- (txt (nth 1 e))
- name pos)
- (unless e (error "No radio list setup defined for %s" major-mode))
- (setq name (read-string "List name: "))
- (while (string-match "%n" txt)
- (setq txt (replace-match name t t txt)))
- (or (bolp) (insert "\n"))
- (setq pos (point))
- (insert txt)
- (goto-char pos)))
- (defun org-list-send-list (&optional maybe)
- "Send a transformed version of this list to the receiver position.
- With argument MAYBE, fail quietly if no transformation is defined for
- this list."
- (interactive)
- (catch 'exit
- (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)
- (error "Don't know how to transform this list"))))
- (let* ((name (match-string 1))
- (transform (intern (match-string 2)))
- (bottom-point
- (save-excursion
- (re-search-forward
- "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
- (match-beginning 0)))
- (top-point
- (progn
- (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)
- (unless (fboundp transform)
- (error "No such transformation function %s" transform))
- (let ((txt (funcall transform list)))
- ;; Find the insertion place
- (save-excursion
- (goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN RECEIVE ORGLST +"
- name
- "\\([ \t]\\|$\\)") nil t)
- (error "Don't know where to insert translated list"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (setq beg (point))
- (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
- (error "Cannot find end of insertion region"))
- (delete-region beg (point-at-bol))
- (goto-char beg)
- (insert txt "\n")))
- (message "List converted and installed at receiver location"))))
- (defun org-list-to-generic (list params)
- "Convert a LIST parsed through `org-list-parse-list' to other formats.
- Valid parameters PARAMS are
- :ustart String to start an unordered list
- :uend String to end an unordered list
- :ostart String to start an ordered list
- :oend String to end an ordered list
- :dstart String to start a descriptive list
- :dend String to end a descriptive list
- :dtstart String to start a descriptive term
- :dtend String to end a descriptive term
- :ddstart String to start a description
- :ddend String to end a description
- :splice When set to t, return only list body lines, don't wrap
- them into :[u/o]start and :[u/o]end. Default is nil.
- :istart String to start a list item
- :iend String to end a list item
- :isep String to separate items
- :lsep String to separate sublists
- :cboff String to insert for an unchecked checkbox
- :cbon String to insert for a checked checkbox"
- (interactive)
- (let* ((p params) sublist
- (splicep (plist-get p :splice))
- (ostart (plist-get p :ostart))
- (oend (plist-get p :oend))
- (ustart (plist-get p :ustart))
- (uend (plist-get p :uend))
- (dstart (plist-get p :dstart))
- (dend (plist-get p :dend))
- (dtstart (plist-get p :dtstart))
- (dtend (plist-get p :dtend))
- (ddstart (plist-get p :ddstart))
- (ddend (plist-get p :ddend))
- (istart (plist-get p :istart))
- (iend (plist-get p :iend))
- (isep (plist-get p :isep))
- (lsep (plist-get p :lsep))
- (cbon (plist-get p :cbon))
- (cboff (plist-get p :cboff)))
- (let ((wrapper
- (cond ((eq (car list) 'ordered)
- (concat ostart "\n%s" oend "\n"))
- ((eq (car list) 'unordered)
- (concat ustart "\n%s" uend "\n"))
- ((eq (car list) 'descriptive)
- (concat dstart "\n%s" dend "\n"))))
- rtn term defstart defend)
- (while (setq sublist (pop list))
- (cond ((symbolp sublist) nil)
- ((stringp sublist)
- (when (string-match "^\\(.*\\)[ \t]+::" sublist)
- (setq term (org-trim (format (concat dtstart "%s" dtend)
- (match-string 1 sublist))))
- (setq sublist (concat ddstart
- (org-trim (substring sublist
- (match-end 0)))
- ddend)))
- (if (string-match "\\[CBON\\]" sublist)
- (setq sublist (replace-match cbon t t sublist)))
- (if (string-match "\\[CBOFF\\]" sublist)
- (setq sublist (replace-match cboff t t sublist)))
- (if (string-match "\\[-\\]" sublist)
- (setq sublist (replace-match "$\\boxminus$" t t sublist)))
- (setq rtn (concat rtn istart term sublist iend isep)))
- (t (setq rtn (concat rtn ;; previous list
- lsep ;; list separator
- (org-list-to-generic sublist p)
- lsep ;; list separator
- )))))
- (format wrapper rtn))))
- (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
- '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
- :ustart "\\begin{itemize}" :uend "\\end{itemize}"
- :dstart "\\begin{description}" :dend "\\end{description}"
- :dtstart "[" :dtend "]"
- :ddstart "" :ddend ""
- :istart "\\item " :iend ""
- :isep "\n" :lsep "\n"
- :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
- params)))
- (defun org-list-to-html (list &optional params)
- "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
- '(:splicep nil :ostart "<ol>" :oend "</ol>"
- :ustart "<ul>" :uend "</ul>"
- :dstart "<dl>" :dend "</dl>"
- :dtstart "<dt>" :dtend "</dt>"
- :ddstart "<dd>" :ddend "</dd>"
- :istart "<li>" :iend "</li>"
- :isep "\n" :lsep "\n"
- :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
- params)))
- (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
- '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
- :ustart "@enumerate" :uend "@end enumerate"
- :dstart "@table" :dend "@end table"
- :dtstart "@item " :dtend "\n"
- :ddstart "" :ddend ""
- :istart "@item\n" :iend ""
- :isep "\n" :lsep "\n"
- :cbon "@code{[X]}" :cboff "@code{[ ]}")
- params)))
- (provide 'org-list)
- ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
- ;;; org-list.el ends here
|