org-index.el 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217
  1. ;;; org-index.el --- A personal index for org and beyond
  2. ;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
  3. ;; Author: Marc Ihm <org-index@2484.de>
  4. ;; Keywords: outlines, hypermedia, matching
  5. ;; Requires: org
  6. ;; Version: 2.4.3
  7. ;; This file is not part of GNU Emacs.
  8. ;;; License:
  9. ;; This program is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 3, or (at your option)
  12. ;; any later version.
  13. ;;
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;;
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  21. ;;; Commentary:
  22. ;; Purpose:
  23. ;;
  24. ;; Mark and find your favorite org-locations and other points of interest
  25. ;; easily; create and update a lookup table of references and links. When
  26. ;; searching, frequently used entries appear at the the top and entering
  27. ;; some keywords narrows down to matching entries only, so that the
  28. ;; right one can be spotted easily.
  29. ;;
  30. ;; References are essentially small numbers (e.g. "R237" or "-455-"),
  31. ;; which are created by this package; they are well suited to be used
  32. ;; outside org. Links are normal org-mode links.
  33. ;;
  34. ;;
  35. ;; Setup:
  36. ;;
  37. ;; - Add these lines to your .emacs:
  38. ;;
  39. ;; ;; use the real path from your org-installation
  40. ;; (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
  41. ;; (require 'org-index)
  42. ;;
  43. ;; - Restart your emacs to make these lines effective
  44. ;;
  45. ;; - Invoke `org-index', which will assist in creating your index
  46. ;; table. The variable org-index-id will be persisted within your
  47. ;; customization file (typically .emacs).
  48. ;;
  49. ;;
  50. ;; Further reading:
  51. ;;
  52. ;; See the documentation of `org-index', which can also be read
  53. ;; by invoking `org-index' and and choosing the help-command.
  54. ;;
  55. ;; For more documentation and working examples, see:
  56. ;;
  57. ;; http://orgmode.org/worg/org-contrib/org-index.html
  58. ;;
  59. ;;
  60. ;; Updates:
  61. ;;
  62. ;; The latest tested version of this file can always be found at:
  63. ;;
  64. ;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
  65. ;;; Change Log:
  66. ;; [2014-04-26 Sa] Version 2.4.3:
  67. ;; - Some Bugfixes and enhancements for occur-command
  68. ;; - Fixes for assistant to create index table
  69. ;;
  70. ;; [2014-02-01 Sa] Version 2.4.2:
  71. ;; - Follow mode in occur-buffer
  72. ;; - Reorder for x-columns
  73. ;;
  74. ;; [2014-01-02 Th] Version 2.4.0:
  75. ;; - New command "put" to store a nodes reference in a property
  76. ;; - New functions org-index-new-line and org-index-get-line
  77. ;; offer access to org-index from other lisp programs
  78. ;; - New flag p, new columns x1,x2 and x3
  79. ;; - Major Code refactoring
  80. ;; - Regression tests with ert
  81. ;; - Lots of bugfixes
  82. ;;
  83. ;; [2013-10-04 Fr] Version 2.3.2:
  84. ;; - Bugfix: index-table created by assistant is found after
  85. ;; restart of emacs instead of invoking assistent again
  86. ;;
  87. ;; [2013-07-20 Sa] Version 2.3.0:
  88. ;; - Renamed from "org-favtable" to "org-index"
  89. ;; - Added an assistent to set up the index table
  90. ;; - occur is now incremental, searching as you type
  91. ;; - simplified the documentation and help-system
  92. ;; - Saving keystrokes, as "+g237" is now valid input
  93. ;; - Many bugfixes
  94. ;;
  95. ;; [2013-02-28 Th] Version 2.2.0:
  96. ;; - Allowed shortcuts like "h237" for command "head" with argument "237"
  97. ;; - Integrated with org-mark-ring-goto
  98. ;;
  99. ;; [2013-01-25 Fr] Version 2.1.0:
  100. ;; - Added full support for links
  101. ;; - New commands "missing" and "statistics"
  102. ;; - Renamed the package from "org-reftable" to "org-favtable"
  103. ;; - Additional columns are required (e.g. "link"). Error messages will
  104. ;; guide you
  105. ;;
  106. ;; [2012-12-07 Fr] Version 2.0.0:
  107. ;; - The format of the table of favorites has changed ! You need to bring
  108. ;; your existing table into the new format by hand (which however is
  109. ;; easy and explained below)
  110. ;; - Reference table can be sorted after usage count or date of last access
  111. ;; - Ask user explicitly, which command to invoke
  112. ;; - Renamed the package from "org-refer-by-number" to "org-reftable"
  113. ;;
  114. ;; [2012-09-22 Sa] Version 1.5.0:
  115. ;; - New command "sort" to sort a buffer or region by reference number
  116. ;; - New commands "highlight" and "unhighlight" to mark references
  117. ;;
  118. ;; [2012-07-13 Fr] Version 1.4.0:
  119. ;; - New command "head" to find a headline with a reference number
  120. ;;
  121. ;; [2012-04-28 Sa] Version 1.3.0:
  122. ;; - New commands occur and multi-occur
  123. ;; - All commands can now be invoked explicitly
  124. ;; - New documentation
  125. ;; - Many bugfixes
  126. ;;
  127. ;; [2011-12-10 Sa] Version 1.2.0:
  128. ;; - Fixed a bug, which lead to a loss of newly created reference numbers
  129. ;; - Introduced single and double prefix arguments
  130. ;; - Started this Change Log
  131. ;;; Code:
  132. (require 'org-table)
  133. (require 'cl)
  134. (defcustom org-index-id nil
  135. "Id of the Org-mode node, which contains the index table."
  136. :group 'org
  137. :group 'org-index)
  138. ;; Variables to hold the configuration of the index table
  139. (defvar org-index--maxref) ; Maximum number from reference table (e.g. "153")
  140. (defvar org-index--head) ; Any header before number (e.g. "R")
  141. (defvar org-index--tail) ; Tail after number (e.g. "}" or "")
  142. (defvar org-index--numcols) ; Number of columns in index table
  143. (defvar org-index--ref-regex) ; Regular expression to match a reference
  144. (defvar org-index--has-reuse nil) ; True, if table contains a line for reuse
  145. (defvar org-index--ref-format) ; Format, that can print a reference
  146. (defvar org-index--columns nil) ; Columns of index-table
  147. (defvar org-index--special-columns nil) ; Columns with flags
  148. (defvar org-index--buffer) ; Buffer of index table
  149. (defvar org-index--point) ; Position at start of headline of index table
  150. (defvar org-index--below-hline) ; Position of first cell in first line below hline
  151. (defvar org-index--headings) ; Headlines of index-table as a string
  152. ;; Variables to hold context and state
  153. (defvar org-index--last-action nil) ; Last action performed by org-index
  154. (defvar org-index--text-to-yank nil) ; Text, that can be yanked after call (mostly a reference)
  155. (defvar org-index--last-ref) ; Last reference created or visited
  156. (defvar org-index--point-before nil) ; Point in buffer with index table
  157. (defvar org-index--point-saved nil) ; Saved point if we want to return
  158. (defvar org-index--silent nil) ; t, if user should not be queried
  159. (defvar org-index--preferred-command) ; command, that is presented first
  160. (defvar org-index--active-region) ; Active region, initially. I.e. what has been marked
  161. (defvar org-index--below-cursor) ; Word below cursor
  162. (defvar org-index--within-node) ; True, if we are within node of the index table
  163. (defvar org-index--active-window-index nil) ; Active window with index table (if any)
  164. (defvar org-index--occur-follow-mode nil) ; True, if follow mode in occur-buffer is on
  165. (setq org-index--commands '(occur head ref link leave put enter goto help + reorder fill sort update multi-occur highlight unhighlight missing statistics)) ; list of commands available
  166. (defun org-index (&optional ARG)
  167. "Mark and find your favorite things and org-locations easily:
  168. Create and update a lookup table of references and links. Often
  169. used entries bubble to the top; entering some keywords narrows
  170. down to matching entries only, so that the right one can be
  171. spotted easily.
  172. References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
  173. which are created by this package; they are well suited to be used
  174. outside of org. Links are normal org-mode links.
  175. This is version 2.4.3 of org-index.
  176. The function `org-index' operates on a dedicated table, the index
  177. table, which lives within its own Org-mode node. The table and
  178. its node will be created, when you first invoke org-index.
  179. Each line in the index table contains:
  180. - A reference (e.g. \"R237\")
  181. - An optional link to another location in org
  182. - A number, counting, how often each reference has been
  183. used. This number is updated automatically and the table can
  184. be sorted after it, so that most frequently used references
  185. appear at the top of the table and can be spotted easily.
  186. - The creation date of the line
  187. - Date and time of last access. This column can alternatively be
  188. used to sort the table.
  189. - A column for your own comments
  190. The index table is found through the id of the containing
  191. node; this id is stored within the variable `org-index-id'.
  192. The function `org-index' is the only interactive function of this
  193. package and its main entry point; it offers several commands to
  194. create, find and look up line within the index table.
  195. Commands known:
  196. occur: Incremental search, that shows matching lines from the
  197. index table, updated after every keystroke. You may enter a
  198. list of words seperated by space or comma (\",\"), to select
  199. lines that contain all of the given words.
  200. You may also read the note at the end of this help on saving
  201. the keystroke RET with this frequent default command.
  202. head: If invoked outside the index table, ask for a reference
  203. number and search for an entry, which either has this
  204. reference contained in its heading or within its property
  205. org-index-ref. If invoked from within the index table dont
  206. ask; rather use the reference or link from the current line.
  207. ref: Create a new reference, copy any previously selected text.
  208. If already within index table, fill in ref-column.
  209. link: Create a new line in index table with a link to the
  210. current node. Do not populate the ref column; this can later
  211. be populated by calling the \"fill\" command from within the
  212. index table.
  213. leave: Leave the index table. If the last command has been
  214. \"ref\", the new reference is copied and ready to yank. This
  215. \"org-mark-ring-goto\" and can be called several times in
  216. succession. If you invoke org-index with a prefix argument,
  217. this command \"leave\" is executed without further questions.
  218. put: Put the reference, that was created last, as the value of
  219. property org-index-ref into the current node. That way it can
  220. be found by a later call to \"head\".
  221. enter: Just enter the node with the index table.
  222. goto: Enter index table and go to a specific reference.
  223. help: Show this text.
  224. +: Show all commands including the less frequently used ones
  225. given below. If \"+\" is followd by enough letters of such a
  226. command (e.g. \"+fi\"), then this command (e.g. \"fill\") is
  227. invoked directly.
  228. reorder: Temporarily reorder the index table, e.g. by count,
  229. reference or last access.
  230. fill: If either ref or link is missing in current line of index
  231. table, fill in the missing value.
  232. sort: Sort a set of lines (either from the active region or the
  233. whole buffer) by references found in each line.
  234. update: For the given reference, update the line in the
  235. index table, i.e. increment its count.
  236. multi-occur: Apply emacs standard multi-occur operation on all
  237. org-mode buffers to search for the given reference.
  238. highlight: Highlight references in active region or buffer.
  239. unhighlight: Remove those highlights.
  240. missing : Search for missing reference numbers (which do not
  241. appear in the reference table). If requested, add additional
  242. lines for them, so that the command \"ref\" is able to reuse
  243. them.
  244. statistics : Show some statistics (e.g. minimum and maximum
  245. reference) about index table.
  246. Two ways to save keystrokes:
  247. When prompting for a command, org-index puts the most likely
  248. one (e.g. \"occur\" or \"ref\") in front of the list, so that
  249. you may just type RET.
  250. If this first command in the list of commands needs additional
  251. input (like e.g. \"occur\"), you may supply this input right
  252. away, although you are still beeing prompted for the command. So,
  253. to do an occur for the string \"foo\", you can just enter \"foo\"
  254. RET, without even typing \"occur\".
  255. Another way to save keystrokes applies if you want to choose a
  256. command, that requrires a reference number and would normally
  257. prompt for it: In that case you may just enter enough characters
  258. from your command, so that it appears first in the list of
  259. matches; then immediately enter the number of the reference you
  260. are searching for. So the input \"h237\" would execute the
  261. command \"head\" for reference \"237\".
  262. "
  263. (interactive "P")
  264. (let ((org-index--silent nil) ; t, if user can be asked
  265. link-id ; link of starting node, if required
  266. what ; what to do
  267. search ; what to search for
  268. guarded-search ; with guard against additional digits
  269. search-ref ; search, if search is a reference
  270. search-link ; search, if search is a link
  271. what-adjusted ; true, if we had to adjust what
  272. what-input ; Input on what question (need not necessary be "what")
  273. reorder-once ; column to use for single time sorting
  274. kill-new-text ; text that will be appended to kill ring
  275. message-text ; text that will be issued as an explanation
  276. initial-ref-or-link ; initial position in index table
  277. )
  278. ;;
  279. ;; Initialize and parse
  280. ;;
  281. ;; creates index table, if necessary
  282. (org-index--verify-id)
  283. ;; store context information
  284. (org-index--retrieve-context)
  285. ;; Get configuration of index table
  286. (org-index--parse-table)
  287. ;;
  288. ;; Find out, what we are supposed to do
  289. ;;
  290. (if ARG
  291. (if (equal ARG '(4))
  292. (setq what 'leave)
  293. (if (and (symbolp ARG)
  294. (memq ARG org-index--commands))
  295. (setq what ARG)
  296. (error "Unknown command '%s' passed as argument, valid choices are a prefix argument or any of these symbols: %s"
  297. ARG (mapconcat 'symbol-name org-index--commands ","))))
  298. (let ((r (org-index--read-what what))) ; query user if not from argument
  299. (setq what (nth 0 r))
  300. (setq what-input (nth 1 r))
  301. (setq reorder-once (nth 2 r))))
  302. ;;
  303. ;; Get search, if required
  304. ;;
  305. ;; These actions need a search string:
  306. (when (memq what '(goto occur head update))
  307. ;; Maybe we've got a search string from the arguments
  308. (setq search (org-index--get-or-read-search search what what-input))
  309. (when search
  310. (when (string-match org-index--ref-regex search)
  311. (setq search-ref search)
  312. (setq guarded-search (org-index--make-guarded-search search)))
  313. (when (string-match "^[a-fA-F0-9]\\{8\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{12\\}$" search)
  314. (setq search-link search))))
  315. ;;
  316. ;; Do some sanity checking before really starting
  317. ;;
  318. ;; Correct requested action, if nothing to search
  319. (when (and (not search)
  320. (memq what '(search head)))
  321. (setq what 'enter)
  322. (setq what-adjusted t))
  323. ;; Check for invalid combinations of arguments; try to be helpful
  324. (when (and (memq what '(head goto))
  325. (not search-ref)
  326. (not search-link))
  327. (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))
  328. ;;
  329. ;; Sort and enter table
  330. ;;
  331. ;; Get link if required before moving in
  332. (if (eq what 'link)
  333. (let ((org-id-link-to-org-use-id t))
  334. (setq link-id (org-id-get-create))))
  335. ;; Save initial ref or link for later return
  336. (if (and org-index--within-node
  337. (org-at-table-p))
  338. (setq initial-ref-or-link
  339. (or (org-index--get-field :ref)
  340. (org-index--get-field :link))))
  341. ;; These commands enter index table only temporarily
  342. (when (memq what '(occur multi-occur statistics))
  343. (set-buffer org-index--buffer)
  344. (goto-char org-index--point)
  345. ;; Sort and align
  346. (org-index--sort reorder-once)
  347. (org-index--align))
  348. ;; These commands will leave user in index table after they are finished
  349. (when (memq what '(enter ref link goto missing))
  350. ;; Support orgmode-standard of going back (buffer and position)
  351. (org-mark-ring-push)
  352. (org-pop-to-buffer-same-window org-index--buffer)
  353. (goto-char org-index--point)
  354. (show-subtree)
  355. (org-show-context)
  356. ;; Sort and align
  357. (org-index--sort reorder-once)
  358. (org-index--align)
  359. ;; Remember position for leave
  360. (if org-index--point-before
  361. (setq org-index--point-saved org-index--point-before)))
  362. ;; prepare to return to initial position in index table
  363. (when initial-ref-or-link
  364. (while (and (org-at-table-p)
  365. (not (or
  366. (string= initial-ref-or-link (org-index--get-field :ref))
  367. (string= initial-ref-or-link (org-index--get-field :link)))))
  368. (forward-line))
  369. ;; did not find ref, go back to top
  370. (if (not (org-at-table-p)) (goto-char org-index--point)))
  371. ;;
  372. ;; Actually do, what is requested
  373. ;;
  374. (cond
  375. ((eq what 'help)
  376. ;; bring up help-buffer for this function
  377. (describe-function 'org-index))
  378. ((eq what 'multi-occur)
  379. ;; Position point in index buffer on reference to search for
  380. (goto-char org-index--below-hline)
  381. (let (found (initial (point)))
  382. (while (and (not found)
  383. (forward-line)
  384. (org-at-table-p))
  385. (save-excursion
  386. (setq found (string= search
  387. (org-index--get-field :ref)))))
  388. (if found
  389. (org-index--update-line nil)
  390. (goto-char initial)))
  391. ;; Construct list of all org-buffers
  392. (let (buff org-buffers)
  393. (dolist (buff (buffer-list))
  394. (set-buffer buff)
  395. (if (string= major-mode "org-mode")
  396. (setq org-buffers (cons buff org-buffers))))
  397. ;; Do multi-occur
  398. (multi-occur org-buffers guarded-search)
  399. ;; Present results
  400. (if (get-buffer "*Occur*")
  401. (progn
  402. (setq message-text (format "multi-occur for '%s'" search))
  403. (other-window 1)
  404. (toggle-truncate-lines 1))
  405. (setq message-text (format "Did not find '%s'" search)))))
  406. ((eq what 'head)
  407. (let (link)
  408. (if (and org-index--within-node
  409. (org-at-table-p))
  410. (setq link (org-index--get-field :link))))
  411. (setq message-text (org-index--do-head search-ref search-link)))
  412. ((eq what 'leave)
  413. (setq kill-new-text org-index--text-to-yank)
  414. (setq org-index--text-to-yank nil)
  415. ;; If "leave" has been called two times in succession, make
  416. ;; org-mark-ring-goto believe it has been called two times too
  417. (if (eq org-index--last-action 'leave)
  418. (let ((this-command nil) (last-command nil))
  419. (org-mark-ring-goto 1))
  420. (org-mark-ring-goto))
  421. ;; Return to saved position in index buffer
  422. (when org-index--point-saved
  423. ;; buffer displayed in window need to set point there first
  424. (if (eq (window-buffer org-index--active-window-index)
  425. org-index--buffer)
  426. (set-window-point org-index--active-window-index (marker-position org-index--point-saved)))
  427. ;; set position in buffer in any case and second
  428. (with-current-buffer org-index--buffer
  429. (goto-char org-index--point-saved)))
  430. (setq org-index--point-saved nil))
  431. ((eq what 'goto)
  432. ;; Go downward in table to requested reference
  433. (let (found (initial (point)))
  434. (goto-char org-index--below-hline)
  435. (while (and (not found)
  436. (forward-line)
  437. (org-at-table-p))
  438. (save-excursion
  439. (setq found
  440. (string= search
  441. (org-index--get-field
  442. (if search-link :link :ref))))))
  443. (if found
  444. (progn
  445. (setq message-text (format "Found '%s'" search))
  446. (org-index--update-line nil)
  447. (org-table-goto-column (org-index--column-num :ref))
  448. (if (looking-back " ") (backward-char))
  449. ;; remember string to copy
  450. (setq org-index--text-to-yank
  451. (org-trim (org-table-get-field (org-index--column-num :copy)))))
  452. (setq message-text (format "Did not find '%s'" search))
  453. (goto-char initial)
  454. (forward-line)
  455. (setq what 'missed))))
  456. ((eq what 'occur)
  457. (org-index--do-occur what-input))
  458. ((memq what '(ref link))
  459. (let (new)
  460. ;; add a new row (or reuse existing one)
  461. (setq new (org-index--do-new-line (eq what 'ref)))
  462. ;; fill special columns with standard values
  463. (when (eq what 'ref)
  464. (org-table-goto-column (org-index--column-num :ref))
  465. (insert new)
  466. (setq org-index--last-ref new))
  467. (when (eq what 'link)
  468. (org-table-goto-column (org-index--column-num :link))
  469. (insert link-id))
  470. (org-index--align)
  471. ;; goto point-field or copy-field or first empty one or first field
  472. (if (org-index--special-column :point)
  473. (org-table-goto-column (org-index--column-num (org-index--special-column :point)))
  474. (if (org-index--special-column :copy)
  475. (org-table-goto-column (org-index--column-num (org-index--special-column :copy)))
  476. (unless (catch 'empty
  477. (dotimes (col org-index--numcols)
  478. (org-table-goto-column (+ col 1))
  479. (if (string= (org-trim (org-table-get-field)) "")
  480. (throw 'empty t))))
  481. ;; none found, goto first
  482. (org-table-goto-column 1))))
  483. (if org-index--active-region (setq kill-new-text org-index--active-region))
  484. (if (eq what 'ref)
  485. (setq message-text (format "Adding a new row with ref '%s'" new))
  486. (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
  487. ((eq what 'put)
  488. ;; put latest reference into property
  489. (if org-index--last-ref
  490. (progn
  491. (org-entry-put (point) "org-index-ref" org-index--last-ref)
  492. (message "Reference '%s' has been stored in property org-index-ref" org-index--last-ref))
  493. (setq org-index--last-ref
  494. (read-from-minibuffer "Reference to be stored in this node: "))
  495. (unless org-index--last-ref
  496. (message "No reference has been given."))
  497. ))
  498. ((eq what 'enter)
  499. ;; simply go into table
  500. (goto-char org-index--below-hline)
  501. (show-subtree)
  502. (recenter)
  503. (if what-adjusted
  504. (setq message-text "Nothing to search for; at index table")
  505. (setq message-text "At index table")))
  506. ((eq what 'fill)
  507. ;; check, if within index table
  508. (unless (and org-index--within-node
  509. (org-at-table-p))
  510. (error "Not within index table"))
  511. ;; applies to missing refs and missing links alike
  512. (let ((ref (org-index--get-field :ref))
  513. (link (org-index--get-field :link)))
  514. (if (and (not ref)
  515. (not link))
  516. ;; have already checked this during parse, check here anyway
  517. (error "Columns ref and link are both empty in this line"))
  518. ;; fill in new ref
  519. (if (not ref)
  520. (progn
  521. (setq kill-new-text (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail))
  522. (org-index--get-field :ref kill-new-text)
  523. ;; remember for org-mark-ring-goto
  524. (setq org-index--text-to-yank kill-new-text)
  525. (org-id-goto link)
  526. (setq message-text "Filled field of index table with new reference"))
  527. ;; fill in new link
  528. (if (not link)
  529. (progn
  530. (setq guarded-search (org-index--make-guarded-search ref))
  531. (message (format "Scanning headlines for '%s' ..." ref))
  532. (let ((search (concat ".*" guarded-search))
  533. link)
  534. (if (catch 'found
  535. (org-map-entries
  536. (lambda ()
  537. (when (looking-at search)
  538. (setq link (org-id-get-create))
  539. (throw 'found t)))
  540. nil 'agenda)
  541. nil)
  542. (progn
  543. (org-index--get-field :link link)
  544. (setq message-text "Inserted link"))
  545. (setq message-text (format "Did not find reference '%s'" ref)))))
  546. ;; nothing is missing
  547. (setq message-text "Columns ref and link are already filled; nothing to do")))))
  548. ((eq what 'sort)
  549. ;; sort lines according to contained reference
  550. (let (begin end where)
  551. (catch 'aborted
  552. ;; either active region or whole buffer
  553. (if (and transient-mark-mode
  554. mark-active)
  555. ;; sort only region
  556. (progn
  557. (setq begin (region-beginning))
  558. (setq end (region-end))
  559. (setq where "region"))
  560. ;; sort whole buffer
  561. (setq begin (point-min))
  562. (setq end (point-max))
  563. (setq where "whole buffer")
  564. ;; make sure
  565. (unless (y-or-n-p "Sort whole buffer ")
  566. (setq message-text "Sort aborted")
  567. (throw 'aborted nil)))
  568. (save-excursion
  569. (save-restriction
  570. (goto-char (point-min))
  571. (narrow-to-region begin end)
  572. (sort-subr nil 'forward-line 'end-of-line
  573. (lambda ()
  574. (if (looking-at (concat ".*"
  575. (org-index--make-guarded-search org-index--ref-regex 'dont-quote)))
  576. (string-to-number (match-string 1))
  577. 0))))
  578. (highlight-regexp org-index--ref-regex 'isearch)
  579. (setq message-text (format "Sorted %s from character %d to %d, %d lines"
  580. where begin end
  581. (count-lines begin end)))))))
  582. ((eq what 'update)
  583. ;; simply update line in index table
  584. (save-excursion
  585. (let ((ref-or-link (if search-link "link" "reference")))
  586. (beginning-of-line)
  587. (if (org-index--update-line search)
  588. (setq message-text (format "Updated %s '%s'" ref-or-link search))
  589. (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
  590. ((memq what '(highlight unhighlight))
  591. (let ((where "buffer"))
  592. (save-excursion
  593. (save-restriction
  594. (when (and transient-mark-mode
  595. mark-active)
  596. (narrow-to-region (region-beginning) (region-end))
  597. (setq where "region"))
  598. (if (eq what 'highlight)
  599. (progn
  600. (highlight-regexp org-index--ref-regex 'isearch)
  601. (setq message-text (format "Highlighted references in %s" where)))
  602. (unhighlight-regexp org-index--ref-regex)
  603. (setq message-text (format "Removed highlights for references in %s" where)))))))
  604. ((memq what '(missing statistics))
  605. (setq message-text (org-index--do-statistics what)))
  606. (t (error "This is a bug: unmatched case '%s'" what)))
  607. ;; remember what we have done for next time
  608. (setq org-index--last-action what)
  609. ;; tell, what we have done and what can be yanked
  610. (if kill-new-text (setq kill-new-text
  611. (substring-no-properties kill-new-text)))
  612. (if (string= kill-new-text "") (setq kill-new-text nil))
  613. (let ((m (concat
  614. message-text
  615. (if (and message-text kill-new-text)
  616. " and r"
  617. (if kill-new-text "R" ""))
  618. (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
  619. (unless (string= m "") (message m)))
  620. (if kill-new-text (kill-new kill-new-text))))
  621. (defun org-index-new-line (&rest keys-values)
  622. "Create a new line within the index table, returning its reference.
  623. The function takes a varying number of arguments pairs; each pair
  624. is a symbol for an existing column heading followed by its value.
  625. their values.
  626. Example:
  627. (org-index-new-line :ref t :x1 \"foo\" :link \"7f480c3e\")
  628. Passing \":ref t\" will make the function create a new reference within the new line.
  629. "
  630. (let ((org-index--silent t))
  631. (save-excursion
  632. (org-index--retrieve-context)
  633. (with-current-buffer org-index--buffer
  634. (goto-char org-index--point)
  635. (org-index--parse-table)
  636. ;; check arguments early
  637. (let ((kvs keys-values)
  638. k v)
  639. (while kvs
  640. (setq k (car kvs))
  641. (setq v (cadr kvs))
  642. (if (eq k :ref)
  643. (unless (memq v '(t nil))
  644. (error "Argument :ref accepts only t or nil"))
  645. (if (or (not (symbolp k))
  646. (symbolp v))
  647. (error "Arguments must be alternation of key and value")))
  648. (unless (> (org-index--column-num k) 0)
  649. (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
  650. (setq kvs (cddr kvs))))
  651. (if (and (not (plist-get keys-values :ref))
  652. (not (stringp (plist-get keys-values :link))))
  653. (error "Need a link when not creating a ref"))
  654. (let (new)
  655. ;; create new line
  656. (setq new (org-index--do-new-line (plist-get keys-values :ref)))
  657. (plist-put keys-values :ref (or new ""))
  658. ;; fill columns
  659. (let ((kvs keys-values)
  660. k v n)
  661. (while kvs
  662. (setq k (car kvs))
  663. (setq v (cadr kvs))
  664. (setq n (org-index--column-num k))
  665. (org-table-goto-column n)
  666. (insert v)
  667. (setq kvs (cddr kvs))))
  668. (org-index--sort)
  669. new)))))
  670. (defun org-index-get-line (what value)
  671. "Retrieve an existing line within the index table by ref or
  672. link and return its contents as a property list.
  673. The function `plist-get' may be used to retrieve specific values.
  674. Example:
  675. (plist-get (org-index-get-line \"12\") :count)
  676. retrieves the value of the count-column for reference 12.
  677. "
  678. (interactive)
  679. (let ((org-index--silent t)
  680. found)
  681. ;; check arguments
  682. (unless (memq what '(:ref :link))
  683. (error "Argument what can only be :ref or :link"))
  684. (save-excursion
  685. (org-index--retrieve-context)
  686. (with-current-buffer org-index--buffer
  687. (goto-char org-index--point)
  688. (org-index--parse-table)
  689. (goto-char org-index--below-hline)
  690. (while (and (not found)
  691. (org-at-table-p))
  692. (when (string= (org-index--get-field what)
  693. value)
  694. (mapc (lambda (x)
  695. (if (and (numberp (cdr x))
  696. (> (cdr x) 0))
  697. (setq found (cons (car x) (cons (or (org-index--get-field (car x)) "") found)))
  698. )) (reverse org-index--columns)))
  699. (forward-line))
  700. found))))
  701. (defun org-index--read-what (what)
  702. "Find out, what we are supposed to do"
  703. (let (commands ; currently active set of selectable commands
  704. trailing-digits ; any digits, that are are appended to what-input
  705. reorder-once ; Column to use for single time sorting
  706. what-input) ; Input on what question (need not necessary be "what")
  707. ;; Set preferred action, that will be the default choice
  708. (setq org-index--preferred-command
  709. (if org-index--within-node
  710. (if (memq org-index--last-action '(ref link))
  711. 'leave
  712. 'goto)
  713. (if org-index--active-region
  714. 'ref
  715. (if (and org-index--below-cursor (string-match org-index--ref-regex org-index--below-cursor))
  716. 'occur
  717. nil))))
  718. ;; Ask user, what to do
  719. (if what
  720. (setq what-input (symbol-name what))
  721. ;; subset of most common commands for initial selection, ie. up to first plus
  722. (setq commands (copy-list org-index--commands))
  723. (let ((c commands))
  724. (while (and c (not (eq (car c) '+)))
  725. (setq c (cdr c)))
  726. (setcdr c nil))
  727. (while (let (completions starts-with-plus is-only-plus)
  728. (setq what-input
  729. (org-completing-read
  730. "Please choose: "
  731. (mapcar 'symbol-name
  732. ;; Construct unique list of commands with
  733. ;; preferred one at front
  734. (delq nil (delete-dups
  735. (append
  736. (list org-index--preferred-command)
  737. (copy-list commands)))))
  738. nil nil))
  739. ;; if input ends in digits, save them away and do completions on head of input
  740. ;; this allows input like "h224" to be accepted
  741. (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)
  742. ;; remember digits
  743. (setq trailing-digits (string-to-number (match-string 2 what-input)))
  744. ;; and use non-digits-part to find match
  745. (setq what-input (match-string 1 what-input)))
  746. ;; if input starts with "+", any command (not only some) may follow
  747. ;; this allows input like "+sort" to be accepted
  748. (when (and (> (length what-input) 0)
  749. (string= (substring what-input 0 1) "+"))
  750. ;; make all commands available for selection
  751. (setq commands (copy-list org-index--commands))
  752. (setq what-input (substring what-input 1))
  753. (setq starts-with-plus (> (length what-input) 0))
  754. (setq is-only-plus (not starts-with-plus)))
  755. ;; get list of possible completions for what-input; i.e.
  756. ;; all commands, that start with what-input
  757. (setq completions (delq nil (mapcar
  758. (lambda (x)
  759. (let ((where (search what-input (symbol-name x))))
  760. (if (and where
  761. (= where 0))
  762. x
  763. nil))) commands)))
  764. ;; if input starts with "+" and not just "+"
  765. (when starts-with-plus
  766. ;; use first completion, if unambigously
  767. (if (= (length completions) 1)
  768. (setq what-input (symbol-name (car completions)))
  769. (if completions
  770. (error "Input \"+%s\" matches multiple commands: %s"
  771. what-input
  772. (mapconcat 'symbol-name completions ", "))
  773. (error "Input \"+%s\" matches no commands" what-input))))
  774. ;; if input ends in digits, use first completion, even if ambigous
  775. ;; this allows input like "h224" to be accepted
  776. (when (and trailing-digits completions)
  777. ;; use first match as input, even if ambigously
  778. (setq org-index--preferred-command (first completions))
  779. (setq what-input (number-to-string trailing-digits)))
  780. ;; convert to symbol
  781. (setq what (intern what-input))
  782. (if is-only-plus (setq what '+))
  783. ;; user is not required to input one of the commands; if
  784. ;; not, take the first one and use the original input for
  785. ;; next question
  786. (if (memq what commands)
  787. ;; input matched one element of list, dont need original
  788. ;; input any more
  789. (setq what-input nil)
  790. ;; what-input will be used for next question, use first
  791. ;; command for what
  792. (setq what (or org-index--preferred-command
  793. (first commands)))
  794. ;; remove any trailing dot, that user might have added to
  795. ;; disambiguate his input
  796. (if (and (> (length what-input) 0)
  797. (equal (substring what-input -1) "."))
  798. ;; but do this only, if dot was really necessary to
  799. ;; disambiguate
  800. (let ((shortened-what-input (substring what-input 0 -1)))
  801. (unless (test-completion shortened-what-input
  802. (mapcar 'symbol-name
  803. commands))
  804. (setq what-input shortened-what-input)))))
  805. ;; ask for reorder in loop, because we have to ask for
  806. ;; what right again
  807. (if (eq what 'reorder)
  808. (setq reorder-once
  809. (intern
  810. (org-icompleting-read
  811. "Please choose column to reorder index table once: "
  812. (mapcar 'symbol-name
  813. (append '(:ref :count :first :last)
  814. (delq nil (mapcar (lambda (x) (if (> (cdr (assoc x org-index--columns)) 0) x nil))
  815. '(:x1 :x2 :x3)))))
  816. nil t))))
  817. ;; maybe ask initial question again
  818. (memq what '(reorder +)))))
  819. (list what what-input reorder-once)))
  820. (defun org-index--get-or-read-search (search what what-input)
  821. "Get search string, maybe read from user"
  822. (let (search-from-table
  823. search-from-cursor)
  824. (unless search
  825. ;; Search string can come from several sources:
  826. ;; From link or ref columns of table
  827. (when (and org-index--within-node
  828. (org-at-table-p))
  829. (setq search-from-table (or (org-index--get-field :link)
  830. (org-index--get-field :ref))))
  831. ;; From string below cursor
  832. (when (and (not org-index--within-node)
  833. org-index--below-cursor
  834. (string-match (concat "\\(" org-index--ref-regex "\\)")
  835. org-index--below-cursor))
  836. (setq search-from-cursor (match-string 1 org-index--below-cursor)))
  837. ;; Depending on requested action, get search from one of the sources above
  838. (cond ((eq what 'goto)
  839. (setq search (or what-input search-from-cursor)))
  840. ((memq what '(head occur))
  841. (setq search (or what-input search-from-table search-from-cursor)))))
  842. ;; If we still do not have a search string, ask user explicitly
  843. (unless search
  844. (if org-index--silent (error "Need to specify search, if silence is required"))
  845. (unless (eq what 'occur)
  846. (if what-input
  847. (setq search what-input)
  848. (setq search (read-from-minibuffer
  849. (cond ((eq what 'head)
  850. "Text or reference number to search for: ")
  851. ((eq what 'goto)
  852. "Reference number to search for, or enter \".\" for id of current node: ")
  853. ((eq what 'update)
  854. "Reference number to update: ")))))
  855. (if (string-match "^\\s *[0-9]+\\s *$" search)
  856. (setq search (format "%s%s%s" org-index--head search org-index--tail)))))
  857. ;; Clean up and examine search string
  858. (when search
  859. (setq search (org-trim search))
  860. (if (string= search "") (setq search nil))
  861. (when search
  862. (if (string-match "^[0-9]+$" search)
  863. (setq search (concat org-index--head search org-index--tail)))))
  864. ;; Check for special case
  865. (when (and (memq what '(head goto))
  866. (string= search "."))
  867. (setq search (org-id-get)))
  868. search))
  869. (defun org-index--verify-id ()
  870. ;; Check id
  871. (unless org-index-id
  872. (org-index--create-new-index
  873. t
  874. (format "No index table has been created yet." org-index-id)))
  875. ;; Find node
  876. (let (marker)
  877. (setq marker (org-id-find org-index-id 'marker))
  878. (unless marker (org-index--create-new-index
  879. t
  880. (format "Cannot find node with id \"%s\"" org-index-id)))
  881. ; Try again with new node
  882. (setq marker (org-id-find org-index-id 'marker))
  883. (unless marker (error "Could not create node"))
  884. (setq org-index--buffer (marker-buffer marker)
  885. org-index--point (marker-position marker))
  886. (move-marker marker nil)))
  887. (defun org-index--retrieve-context ()
  888. ;; Get the content of the active region or the word under cursor
  889. (setq org-index--active-region
  890. (if (and transient-mark-mode mark-active)
  891. (buffer-substring (region-beginning) (region-end))
  892. nil))
  893. (setq org-index--below-cursor (thing-at-point 'symbol))
  894. ;; Find out, if we are within favable or not
  895. (setq org-index--within-node (string= (org-id-get) org-index-id))
  896. ;; Check and remember, if active window contains buffer with index table
  897. (if (eq (window-buffer) org-index--buffer)
  898. (setq org-index--active-window-index (selected-window)))
  899. ;; get current position in index-buffer
  900. (with-current-buffer org-index--buffer
  901. (setq org-index--point-before
  902. (if (string= (org-id-get) org-index-id)
  903. nil
  904. (point-marker)))))
  905. (defun org-index--parse-table ()
  906. (let (ref-field
  907. link-field
  908. initial-point
  909. end-of-heading)
  910. (with-current-buffer org-index--buffer
  911. (setq org-index--maxref 0)
  912. (setq initial-point (point))
  913. (org-index--go-below-hline)
  914. (setq org-index--below-hline (point))
  915. (beginning-of-line)
  916. (setq end-of-heading (point))
  917. (while (org-at-table-p) (forward-line -1))
  918. (forward-line)
  919. (setq org-index--headings (buffer-substring (point) end-of-heading))
  920. (goto-char org-index--below-hline)
  921. ;; count columns
  922. (org-table-goto-column 100)
  923. (setq org-index--numcols (- (org-table-current-column) 1))
  924. ;; get contents of columns
  925. (forward-line -2)
  926. (unless (org-at-table-p)
  927. (org-index--create-new-index
  928. nil
  929. "Index table starts with a hline"))
  930. ;; check for optional line consisting solely of width specifications
  931. (beginning-of-line)
  932. (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
  933. (forward-line -1))
  934. (org-table-goto-column 1)
  935. (org-index--parse-headings)
  936. ;; Go beyond end of table
  937. (while (org-at-table-p) (forward-line 1))
  938. ;; Retrieve any decorations around the number within the first nonempty ref-field
  939. (goto-char org-index--below-hline)
  940. (while (and (org-at-table-p)
  941. (not (setq ref-field (org-index--get-field :ref))))
  942. (forward-line))
  943. ;; Some Checking
  944. (unless ref-field
  945. (org-index--create-new-index
  946. nil
  947. "Reference column is empty"))
  948. (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
  949. (org-index--create-new-index
  950. nil
  951. (format "First reference in index table ('%s') does not contain a number" ref-field)))
  952. ;; These are the decorations used within the first ref of index
  953. (setq org-index--head (match-string 1 ref-field))
  954. (setq org-index--tail (match-string 3 ref-field))
  955. (setq org-index--ref-regex (concat (regexp-quote org-index--head)
  956. "\\([0-9]+\\)"
  957. (regexp-quote org-index--tail)))
  958. (setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
  959. ;; Go through table to find maximum number and do some checking
  960. (let ((ref 0))
  961. (while (org-at-table-p)
  962. (setq ref-field (org-index--get-field :ref))
  963. (setq link-field (org-index--get-field :link))
  964. (when (and (not ref-field)
  965. (not link-field))
  966. (org-pop-to-buffer-same-window org-index--buffer)
  967. (org-reveal)
  968. (error "Columns ref and link are both empty in this line"))
  969. (if ref-field
  970. (if (string-match org-index--ref-regex ref-field)
  971. ;; grab number
  972. (setq ref (string-to-number (match-string 1 ref-field)))
  973. (org-pop-to-buffer-same-window org-index--buffer)
  974. (org-reveal)
  975. (error "Column ref does not contain a number")))
  976. ;; check, if higher ref
  977. (if (> ref org-index--maxref) (setq org-index--maxref ref))
  978. ;; check if ref is ment for reuse
  979. (if (string= (org-index--get-field :count) ":reuse:")
  980. (setq org-index--has-reuse t))
  981. (forward-line 1)))
  982. ;; go back to initial position
  983. (goto-char initial-point))))
  984. (defun org-index--sort (&optional sort-column)
  985. (unless sort-column (setq sort-column (org-index--special-column :sort)))
  986. (let (top
  987. bottom
  988. ref-field
  989. count-field
  990. count-special)
  991. (unless buffer-read-only
  992. ;; get boundaries of table
  993. (goto-char org-index--below-hline)
  994. (forward-line 0)
  995. (setq top (point))
  996. (while (org-at-table-p) (forward-line))
  997. ;; Kill all empty rows at bottom
  998. (while (progn
  999. (forward-line -1)
  1000. (org-table-goto-column 1)
  1001. (and
  1002. (not (org-index--get-field :ref))
  1003. (not (org-index--get-field :link))))
  1004. (org-table-kill-row))
  1005. (forward-line 1)
  1006. (setq bottom (point))
  1007. (save-restriction
  1008. (narrow-to-region top bottom)
  1009. (goto-char top)
  1010. (sort-subr t
  1011. 'forward-line
  1012. 'end-of-line
  1013. (lambda ()
  1014. (let (ref
  1015. (ref-field (or (org-index--get-field :ref) ""))
  1016. (count-field (or (org-index--get-field :count) ""))
  1017. (count-special 0))
  1018. ;; get reference with leading zeroes, so it can be
  1019. ;; sorted as text
  1020. (string-match org-index--ref-regex ref-field)
  1021. (setq ref (format
  1022. "%06d"
  1023. (string-to-number
  1024. (or (match-string 1 ref-field)
  1025. "0"))))
  1026. ;; find out, if special token in count-column
  1027. (setq count-special (format "%d"
  1028. (- 2
  1029. (length (member count-field '(":missing:" ":reuse:"))))))
  1030. ;; Construct different sort-keys according to
  1031. ;; requested sort column; prepend count-special to
  1032. ;; sort special entries at bottom of table, append ref
  1033. ;; as a secondary sort key
  1034. (cond
  1035. ((eq sort-column :count)
  1036. (concat count-special
  1037. (format
  1038. "%08d"
  1039. (string-to-number (or (org-index--get-field :count)
  1040. "")))
  1041. ref))
  1042. ((eq sort-column :ref)
  1043. (concat count-special
  1044. ref))
  1045. ((memq sort-column '(:last :x1 :x2 :x3))
  1046. (concat count-special
  1047. (org-index--get-field sort-column)
  1048. " "
  1049. ref))
  1050. (t (error "This is a bug: unmatched case '%s'" sort-column)))))
  1051. nil 'string<))
  1052. ;; sorting has moved point below hline
  1053. (org-index--go-below-hline)
  1054. (setq org-index--below-hline (point)))))
  1055. (defun org-index--go-below-hline ()
  1056. (goto-char org-index--point)
  1057. ;; go to heading of node
  1058. (while (not (org-at-heading-p)) (forward-line -1))
  1059. (forward-line 1)
  1060. ;; go to table within node, but make sure we do not get into another node
  1061. (while (and (not (org-at-heading-p))
  1062. (not (org-at-table-p))
  1063. (not (eq (point) (point-max))))
  1064. (forward-line 1))
  1065. ;; check, if there really is a table
  1066. (unless (org-at-table-p)
  1067. (org-index--create-new-index
  1068. t
  1069. (format "Cannot find index table within node %s" org-index-id)))
  1070. ;; go to first hline
  1071. (while (and (not (org-at-table-hline-p))
  1072. (org-at-table-p))
  1073. (forward-line 1))
  1074. ;; and check
  1075. (unless (org-at-table-hline-p)
  1076. (org-index--create-new-index
  1077. nil
  1078. "Cannot find hline within index table"))
  1079. (forward-line 1)
  1080. (org-table-goto-column 1))
  1081. (defun org-index--align ()
  1082. (unless buffer-read-only (org-table-align))
  1083. (org-index--go-below-hline)
  1084. (setq org-index--below-hline (point)))
  1085. (defun org-index--parse-headings ()
  1086. ;; Associate names of special columns with column-numbers
  1087. (setq org-index--columns (copy-tree '((:ref . 0) (:link . 0) (:first . 0) (:last . 0)
  1088. (:count . 0) (:x1 . 0) (:x2 . 0) (:x3 . 0))))
  1089. ;; Associate names of special columns with names of columns
  1090. (setq org-index--special-columns (copy-tree '((:sort . nil) (:copy . nil) (:point . nil))))
  1091. ;; For each column
  1092. (dotimes (col org-index--numcols)
  1093. (let* (field-flags ;; raw heading, consisting of file name and maybe
  1094. ;; flags (seperated by ";")
  1095. field ;; field name only
  1096. field-symbol ;; and as a symbol
  1097. flags ;; flags from field-flags
  1098. found)
  1099. ;; parse field-flags into field and flags
  1100. (setq field-flags (org-trim (org-table-get-field (+ col 1))))
  1101. (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
  1102. (progn
  1103. (setq field (downcase (or (match-string 1 field-flags) "")))
  1104. ;; get flags as list of characters
  1105. (setq flags (mapcar 'string-to-char
  1106. (split-string
  1107. (downcase (match-string 2 field-flags))
  1108. "" t))))
  1109. ;; no flags
  1110. (setq field field-flags))
  1111. (unless (string= field "") (setq field-symbol (intern (concat ":" (downcase field)))))
  1112. ;; aliases for backward compatability
  1113. (if (eq field-symbol :last-accessed) (setq field-symbol :last))
  1114. (if (eq field-symbol :created) (setq field-symbol :first))
  1115. (if (and field-symbol
  1116. (not (assoc field-symbol org-index--columns)))
  1117. (error "Column %s is not a valid heading" (symbol-name field-symbol)))
  1118. ;; Check, that no flags appear twice
  1119. (mapc (lambda (x)
  1120. (when (memq (car x) flags)
  1121. (if (cdr (assoc (cdr x) org-index--columns))
  1122. (org-index--create-new-index
  1123. nil
  1124. (format "More than one heading is marked with flag '%c'" (car x))))))
  1125. '((?s . sort)
  1126. (?c . copy)))
  1127. ;; Process flags
  1128. (if (memq ?s flags)
  1129. (setcdr (assoc :sort org-index--special-columns) (or field-symbol (+ col 1))))
  1130. (if (memq ?c flags)
  1131. (setcdr (assoc :copy org-index--special-columns) (or field-symbol (+ col 1))))
  1132. (if (memq ?p flags)
  1133. (setcdr (assoc :point org-index--special-columns) (or field-symbol (+ col 1))))
  1134. ;; Store columns in alist
  1135. (setq found (assoc field-symbol org-index--columns))
  1136. (when found
  1137. (if (> (cdr found) 0)
  1138. (org-index--create-new-index
  1139. nil
  1140. (format "'%s' appears two times as column heading" (downcase field))))
  1141. (setcdr found (+ col 1)))))
  1142. ;; check if all necessary informations have been specified
  1143. (mapc (lambda (col)
  1144. (unless (> (cdr (assoc col org-index--columns)) 0)
  1145. (org-index--create-new-index
  1146. nil
  1147. (format "column '%s' has not been set" col))))
  1148. (list :ref :link :count :first :last))
  1149. ;; use count as a default sort-column
  1150. (unless (cdr (assoc :sort org-index--special-columns))
  1151. (setcdr (assoc :sort org-index--special-columns) :count)))
  1152. (defun org-index--create-new-index (create-new-index reason)
  1153. "Create a new empty index table with detailed explanation."
  1154. (let (prompt buffer-name title firstref id)
  1155. ;; cannot proceed without querying user
  1156. (if org-index--silent (error "No valid index: %s" reason))
  1157. (setq prompt
  1158. (if create-new-index
  1159. (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")
  1160. (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before trying again. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))
  1161. (unless (y-or-n-p prompt)
  1162. (error "Cannot proceed without a valid index table: %s" reason))
  1163. (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil))
  1164. (setq title (read-from-minibuffer "Please enter the title of the index node: "))
  1165. (while (progn
  1166. (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
  1167. (let (desc)
  1168. (unless (equal '(95 119) (sort (delete-dups (mapcar (lambda (x) (char-syntax x)) (concat "-1" firstref))) '<))
  1169. (setq desc "Contains other characters than those allowed in symbols"))
  1170. (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
  1171. ;; firstref not okay, report details
  1172. (setq desc
  1173. (cond ((string= firstref "") "is empty")
  1174. ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
  1175. ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
  1176. ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")
  1177. )))
  1178. (if desc
  1179. (progn
  1180. (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again" firstref desc))
  1181. t)
  1182. nil))))
  1183. (with-current-buffer buffer-name
  1184. (goto-char (point-max))
  1185. (insert (format "\n\n* %s %s\n" firstref title))
  1186. (insert "\n\n Below you find your initial index table, which will grow over time.\n"
  1187. " Following that your may read its detailed explanation, which will help you,\n"
  1188. " to adjust org-index to your needs. This however is optional reading and not\n"
  1189. " required to start using org-index.\n")
  1190. (setq id (org-id-get-create))
  1191. (insert (format "
  1192. | | | | | | comment |
  1193. | ref | link | first | count;s | last | ;c |
  1194. | | <4> | | | | |
  1195. |-----+------+-------+---------+------+---------|
  1196. | %s | %s | %s | | | %s |
  1197. "
  1198. firstref
  1199. id
  1200. (with-temp-buffer (org-insert-time-stamp nil nil t))
  1201. "This node"))
  1202. (insert "
  1203. Detailed explanation:
  1204. The index table above has three lines of headings above the first
  1205. hline:
  1206. - The first one is ignored by org-index, and you can use it to
  1207. give meaningful names to columns. In the table above only one
  1208. column has a name (\"comment\"). This line is optional.
  1209. - The second line is the most important one, because it
  1210. contains the configuration information for org-index; please
  1211. read further below for its format.
  1212. - The third line is again optional; it may only specify the
  1213. widths of the individual columns (e.g. <4>).
  1214. The columns get their meaning by the second line of headings;
  1215. specifically by one of the keywords (e.g. \"ref\") or a flag
  1216. seperated by a semicolon (e.g. \";s\").
  1217. The keywords and flags are:
  1218. - ref: This contains the reference, which consists of a decorated
  1219. number, which is incremented for each new line. References are
  1220. meant to be used in org-mode headlines or outside of org,
  1221. e.g. within folder names.
  1222. - link: org-mode link pointing to the matching location within org.
  1223. - first: When has this line been first accessed (i.e. created) ?
  1224. - count: How many times has this line been accessed ? The
  1225. trailing flag \"s\" makes the table beeing sorted after this
  1226. column this column, so that often used entries appear at the
  1227. top of the table.
  1228. - last: When has this line been accessed last ?
  1229. - The last column above has no keyword, only the flag \"c\",
  1230. which makes its content beeing copied under certain
  1231. conditions. It is typically used for comments.
  1232. The sequence of columns does not matter. You may reorder them any
  1233. way you like. Columns are found by their name, which appears in
  1234. the second line of headings.
  1235. You can add further columns or even remove the last column. All
  1236. other columns are required.
  1237. Finally: This node needs not be a top level node; its name is
  1238. completely at you choice; it is found through its ID only.
  1239. ")
  1240. (while (not (org-at-table-p)) (forward-line -1))
  1241. (unless buffer-read-only (org-table-align))
  1242. (while (not (org-at-heading-p)) (forward-line -1))
  1243. ;; present results to user
  1244. (if create-new-index
  1245. (progn
  1246. ;; Only show the new index
  1247. (org-pop-to-buffer-same-window buffer-name)
  1248. (delete-other-windows)
  1249. (org-id-goto id)
  1250. (org-show-context)
  1251. (show-subtree)
  1252. (recenter 1)
  1253. (setq org-index-id id)
  1254. (if (y-or-n-p "This is your new index table. It is already set for this emacs session. Do you want to save its id to make it available for future emacs sessions too ? ")
  1255. (progn
  1256. (customize-save-variable 'org-index-id id)
  1257. (error "Saved org-index-id '%s' to %s" id custom-file))
  1258. (let (sq)
  1259. (setq sq (format "(setq org-index-id \"%s\")" id))
  1260. (kill-new sq)
  1261. (error "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))))
  1262. ;; we had an error with the existing index table, so present old
  1263. ;; and new one together
  1264. ;; show existing index
  1265. (org-pop-to-buffer-same-window org-index--buffer)
  1266. (goto-char org-index--point)
  1267. (org-show-context)
  1268. (show-subtree)
  1269. (recenter 1)
  1270. (delete-other-windows)
  1271. ;; show new index
  1272. (select-window (split-window-vertically))
  1273. (org-pop-to-buffer-same-window buffer-name)
  1274. (org-id-goto id)
  1275. (org-show-context)
  1276. (show-subtree)
  1277. (recenter 1)
  1278. (error "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)))))
  1279. (defun org-index--update-line (ref-or-link)
  1280. (let ((newcount 0)
  1281. initial)
  1282. (with-current-buffer org-index--buffer
  1283. (unless buffer-read-only
  1284. ;; search reference or link, if given (or assume, that we are already positioned right)
  1285. (when ref-or-link
  1286. (setq initial (point))
  1287. (goto-char org-index--below-hline)
  1288. (while (and (org-at-table-p)
  1289. (not (or (string= ref-or-link (org-index--get-field :ref))
  1290. (string= ref-or-link (org-index--get-field :link)))))
  1291. (forward-line)))
  1292. (if (not (org-at-table-p))
  1293. (error "Did not find reference or link '%s'" ref-or-link)
  1294. (org-index--update-current-line))
  1295. (if initial (goto-char initial))))))
  1296. (defun org-index--update-current-line ()
  1297. (let (newcount (count-field (org-index--get-field :count)))
  1298. ;; update count field only if number or empty; leave :missing: and :reuse: as is
  1299. (when (or (not count-field)
  1300. (string-match "^[0-9]+$" count-field))
  1301. (setq newcount (+ 1 (string-to-number (or count-field "0"))))
  1302. (org-index--get-field :count
  1303. (number-to-string newcount)))
  1304. ;; update timestamp
  1305. (org-table-goto-column (org-index--column-num :last))
  1306. (org-table-blank-field)
  1307. (org-insert-time-stamp nil t t)))
  1308. (defun org-index--get-field (key &optional value)
  1309. (let (field)
  1310. (save-excursion
  1311. (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
  1312. (if (string= field "") (setq field nil))
  1313. (org-no-properties field))))
  1314. (defun org-index--column-num (key)
  1315. (if (numberp key)
  1316. key
  1317. (cdr (assoc key org-index--columns))))
  1318. (defun org-index--special-column (key)
  1319. (cdr (assoc key org-index--special-columns)))
  1320. (defun org-index--make-guarded-search (ref &optional dont-quote)
  1321. (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
  1322. (defun org-index--do-statistics (what)
  1323. (let ((total 0)
  1324. missing
  1325. ref-field
  1326. ref
  1327. min
  1328. max
  1329. message-text)
  1330. ;; start with list of all references
  1331. (setq missing (mapcar (lambda (x) (format "%s%d%s" org-index--head x org-index--tail))
  1332. (number-sequence 1 org-index--maxref)))
  1333. ;; go through table and remove all refs, that we see
  1334. (goto-char org-index--below-hline)
  1335. (while (org-at-table-p)
  1336. ;; get ref-field and number
  1337. (setq ref-field (org-index--get-field :ref))
  1338. (if (and ref-field
  1339. (string-match org-index--ref-regex ref-field))
  1340. (setq ref (string-to-number (match-string 1 ref-field))))
  1341. ;; remove existing refs from list
  1342. (if ref-field (setq missing (delete ref-field missing)))
  1343. ;; record min and max
  1344. (if (or (not min) (< ref min)) (setq min ref))
  1345. (if (or (not max) (> ref max)) (setq max ref))
  1346. ;; count
  1347. (setq total (1+ total))
  1348. (forward-line))
  1349. ;; insert them, if requested
  1350. (forward-line -1)
  1351. (if (eq what 'statistics)
  1352. (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
  1353. total
  1354. (format org-index--ref-format min)
  1355. (format org-index--ref-format max)
  1356. (length missing)))
  1357. (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table"
  1358. (length missing)))
  1359. (let (type)
  1360. (setq type (org-icompleting-read
  1361. "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
  1362. (mapc (lambda (x)
  1363. (let (org-table-may-need-update) (org-table-insert-row t))
  1364. (org-index--get-field :ref x)
  1365. (org-index--get-field :count (format ":%s:" type)))
  1366. missing)
  1367. (org-index--align)
  1368. (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
  1369. (setq message-text (format "%d missing references." (length missing)))))
  1370. message-text))
  1371. (defun org-index--do-head (ref link &optional other)
  1372. (if ref (setq org-index--last-ref ref))
  1373. (let (message-text)
  1374. ;; Use link if available
  1375. (if link
  1376. (progn
  1377. (org-index--update-line link)
  1378. (org-id-goto link)
  1379. (org-reveal)
  1380. (setq message-text "Followed link"))
  1381. (message (format "Scanning headlines for '%s' ..." ref))
  1382. (org-index--update-line ref)
  1383. (let ((search (concat ".*" (org-index--make-guarded-search ref)))
  1384. (org-trust-scanner-tags t)
  1385. buffer point)
  1386. (if (catch 'found
  1387. (progn
  1388. ;; loop over all headlines, stop on first match
  1389. (org-map-entries
  1390. (lambda ()
  1391. (when (or (looking-at search)
  1392. (eq ref (org-entry-get (point) "org-index-ref")))
  1393. ;; If this is not an inlinetask ...
  1394. (when (< (org-element-property :level (org-element-at-point))
  1395. org-inlinetask-min-level)
  1396. ;; ... remember location and bail out
  1397. (setq buffer (current-buffer))
  1398. (setq point (point))
  1399. (throw 'found t))))
  1400. nil 'agenda)
  1401. nil))
  1402. (progn
  1403. (setq message-text (format "Found '%s'" (or ref link)))
  1404. (if other
  1405. (progn
  1406. (pop-to-buffer buffer)
  1407. (goto-char point)
  1408. (org-reveal t)
  1409. (recenter)
  1410. (pop-to-buffer "*org-index-occur*"))
  1411. (org-pop-to-buffer-same-window buffer)
  1412. (goto-char point)
  1413. (org-reveal t)
  1414. (recenter)))
  1415. (setq message-text (format "Did not find '%s'" (or ref link))))))
  1416. message-text))
  1417. (defun org-index--do-occur (initial-search)
  1418. (let ((occur-buffer-name "*org-index-occur*")
  1419. (word "") ; last word to search for growing and shrinking on keystrokes
  1420. (prompt "Search for: ")
  1421. (hint "")
  1422. (key-help "<up>, <down> move. <return> finds node, <S-return> goes to table, <M-return> updates count. TAB finds in other window.\n")
  1423. words ; list of other words that must match too
  1424. occur-buffer
  1425. lines-to-show ; number of lines to show in window
  1426. start-of-lines ; position, where lines begin
  1427. start-of-help ; start of displayed help (if any)
  1428. left-off-at ; stack of last positions in index table
  1429. after-inserted ; in occur-buffer
  1430. at-end ; in occur-buffer
  1431. lines-visible ; in occur-buffer
  1432. below-hline-bol ; below-hline and at bol
  1433. exit-gracefully ; true if normal exit
  1434. in-c-backspace ; true while processing C-backspace
  1435. show-headings ; true, if headings should be shown
  1436. fun-on-ret ; function to be executed, if return is pressed
  1437. fun-on-s-ret ; shift
  1438. fun-on-m-ret ; shift
  1439. fun-on-tab ; function to be executed, if letter TAB is pressed
  1440. ret from to key)
  1441. ;; clear buffer
  1442. (if (get-buffer "*org-index-occur*")
  1443. (kill-buffer occur-buffer-name))
  1444. (setq occur-buffer (get-buffer-create "*org-index-occur*"))
  1445. ;; install keyboard-shortcuts within occur-buffer
  1446. (with-current-buffer occur-buffer
  1447. (let ((keymap (make-sparse-keymap)))
  1448. (set-keymap-parent keymap org-mode-map)
  1449. (setq fun-on-ret (lambda () (interactive) (org-index--occur-find-heading nil)))
  1450. (define-key keymap [return] fun-on-ret)
  1451. (setq fun-on-s-ret (lambda () (interactive)
  1452. (when (org-at-table-p)
  1453. (org-table-goto-column (org-index--column-num :ref))
  1454. (org-index 'goto))))
  1455. (define-key keymap [S-return] fun-on-s-ret)
  1456. (setq fun-on-m-ret (lambda () (interactive)
  1457. (when (org-at-table-p)
  1458. (org-index--update-current-line)
  1459. (org-table-align)
  1460. (org-table-goto-column (org-index--column-num :count))
  1461. (message (format "New count is %s" (org-trim (org-table-get-field))))
  1462. (org-index--update-line (org-index--get-field :ref)))))
  1463. (define-key keymap [M-return] fun-on-m-ret)
  1464. (setq fun-on-tab (lambda () (interactive)
  1465. (org-index--occur-find-heading t)
  1466. (setq org-index--occur-follow-mode (not org-index--occur-follow-mode))))
  1467. (define-key keymap [tab] fun-on-tab)
  1468. (define-key keymap [(control ?i)] fun-on-tab)
  1469. (define-key keymap [up] (lambda () (interactive)
  1470. (forward-line -1)
  1471. (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
  1472. (define-key keymap [down] (lambda () (interactive)
  1473. (forward-line 1)
  1474. (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
  1475. (use-local-map keymap)))
  1476. (with-current-buffer org-index--buffer
  1477. (let ((initial (point)))
  1478. (goto-char org-index--below-hline)
  1479. (forward-line 0)
  1480. (setq below-hline-bol (point))
  1481. (goto-char initial)))
  1482. (org-pop-to-buffer-same-window occur-buffer)
  1483. (toggle-truncate-lines 1)
  1484. (unwind-protect ; to reset cursor-shape even in case of errors
  1485. (progn
  1486. ;; fill in header
  1487. (erase-buffer)
  1488. (insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
  1489. (setq start-of-lines (point-marker))
  1490. (setq start-of-help start-of-lines)
  1491. (setq cursor-type 'hollow)
  1492. ;; get window size of occur-buffer as number of lines to be searched
  1493. (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
  1494. ;; fill initially
  1495. (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
  1496. (when (nth 0 ret)
  1497. (insert (nth 1 ret))
  1498. (setq left-off-at (cons (nth 0 ret) nil))
  1499. (setq after-inserted (cons (point) nil)))
  1500. ;; read keys
  1501. (while
  1502. (progn
  1503. (goto-char start-of-lines)
  1504. (setq lines-visible 0)
  1505. ;; use initial-search (if present) to simulate keyboard input
  1506. (if (and initial-search
  1507. (> (length initial-search) 0))
  1508. (progn
  1509. (setq key (string-to-char (substring initial-search 0 1)))
  1510. (if (length initial-search)
  1511. (setq initial-search (substring initial-search 1))))
  1512. (if in-c-backspace
  1513. (setq key 'backspace)
  1514. (let ((search-text (mapconcat 'identity (reverse (cons word words)) ",")))
  1515. (setq key (read-key
  1516. (format "%s%s%s%s"
  1517. prompt
  1518. search-text
  1519. (if (string= search-text "") "" " ")
  1520. hint))))
  1521. (setq hint "")
  1522. (setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return 'S-return ?\C-i 'TAB)))))
  1523. (not exit-gracefully))
  1524. (cond
  1525. ((eq key 'C-backspace)
  1526. (setq in-c-backspace t))
  1527. ((member key (list 'backspace 'deletechar ?\C-?)) ; erase last char
  1528. (if (= (length word) 0)
  1529. ;; nothing more to delete from current word; try next
  1530. (progn
  1531. (setq word (car words))
  1532. (setq words (cdr words))
  1533. (setq in-c-backspace nil))
  1534. ;; unhighlight longer match
  1535. (let ((case-fold-search t))
  1536. (unhighlight-regexp (regexp-quote word)))
  1537. ;; some chars are left; shorten word
  1538. (setq word (substring word 0 -1))
  1539. (when (= (length word) 0) ; when nothing left, use next word from list
  1540. (setq word (car words))
  1541. (setq words (cdr words))
  1542. (setq in-c-backspace nil))
  1543. ;; remove everything, that has been added for char just deleted
  1544. (when (cdr after-inserted)
  1545. (setq after-inserted (cdr after-inserted))
  1546. (goto-char (car after-inserted))
  1547. (delete-region (point) (point-max)))
  1548. ;; back up last position in index table too
  1549. (when (cdr left-off-at)
  1550. (setq left-off-at (cdr left-off-at)))
  1551. ;; go through buffer and check, if any invisible line should now be shown
  1552. (goto-char start-of-lines)
  1553. (while (< (point) (point-max))
  1554. (if (outline-invisible-p)
  1555. (progn
  1556. (setq from (line-beginning-position)
  1557. to (line-beginning-position 2))
  1558. ;; check for matches
  1559. (when (org-index--test-words (cons word words) (buffer-substring from to))
  1560. (when (<= lines-visible lines-to-show) ; show, if more lines required
  1561. (outline-flag-region from to nil)
  1562. (incf lines-visible))))
  1563. ;; already visible, just count
  1564. (incf lines-visible))
  1565. (forward-line 1))
  1566. ;; highlight shorter word
  1567. (unless (= (length word) 0)
  1568. (let ((case-fold-search t))
  1569. (highlight-regexp (regexp-quote word) 'isearch)))))
  1570. ((member key (list ?\s ?,)) ; space or comma: enter an additional search word
  1571. ;; push current word and clear, no need to change display
  1572. (setq words (cons word words))
  1573. (setq word ""))
  1574. ((eq key ??) ; question mark: toggle display of headlines and help
  1575. (setq show-headings (not show-headings))
  1576. (goto-char start-of-lines)
  1577. (if show-headings
  1578. (progn
  1579. (forward-line -1)
  1580. ; (kill-line)
  1581. (setq start-of-help (point-marker))
  1582. (insert "Normal keys add to search word, SPACE or COMMA start new word, BACKSPACE and C-BACKSPACE erase char or word. Every other key ends search: <C-return> completes list of matches. ")
  1583. (insert key-help)
  1584. (goto-char start-of-help)
  1585. (fill-paragraph)
  1586. (goto-char start-of-lines)
  1587. (insert org-index--headings))
  1588. (delete-region start-of-help start-of-lines)
  1589. (insert "\n\n"))
  1590. (setq start-of-lines (point-marker)))
  1591. ((and (integerp key)
  1592. (aref printable-chars key)) ; any printable char: add to current search word
  1593. ;; unhighlight short word
  1594. (unless (= (length word) 0)
  1595. (let ((case-fold-search t))
  1596. (unhighlight-regexp (regexp-quote word))))
  1597. ;; add to word
  1598. (setq word (concat word (char-to-string key)))
  1599. ;; hide lines, that do not match longer word any more
  1600. (while (< (point) (point-max))
  1601. (unless (outline-invisible-p)
  1602. (setq from (line-beginning-position)
  1603. to (line-beginning-position 2))
  1604. ;; check for matches
  1605. (if (org-index--test-words (list word) (buffer-substring from to))
  1606. (incf lines-visible) ; count as visible
  1607. (outline-flag-region from to t))) ; hide
  1608. (forward-line 1))
  1609. ;; duplicate top of stacks; eventually overwritten below
  1610. (setq left-off-at (cons (car left-off-at) left-off-at))
  1611. (setq after-inserted (cons (car after-inserted) after-inserted))
  1612. ;; get new lines from index table
  1613. (when (< lines-visible lines-to-show)
  1614. (setq ret (org-index--get-matching-lines (cons word words)
  1615. (- lines-to-show lines-visible)
  1616. (car left-off-at)))
  1617. (when (nth 0 ret)
  1618. (insert (nth 1 ret))
  1619. (setq at-end (nth 2 ret))
  1620. (setcar left-off-at (nth 0 ret))
  1621. (setcar after-inserted (point))))
  1622. ;; highlight longer word
  1623. (let ((case-fold-search t))
  1624. (highlight-regexp (regexp-quote word) 'isearch)))
  1625. (t ; non-printable chars
  1626. (setq hint (format "(cannot search for key '%s', use %s to quit)"
  1627. (if (symbolp key)
  1628. key
  1629. (key-description (char-to-string key)))
  1630. (substitute-command-keys "\\[keyboard-quit]"))))))
  1631. ;; search is done collect and brush up results
  1632. ;; remove any lines, that are still invisible
  1633. (goto-char start-of-lines)
  1634. (while (< (point) (point-max))
  1635. (if (outline-invisible-p)
  1636. (delete-region (line-beginning-position) (line-beginning-position 2))
  1637. (forward-line 1)))
  1638. ;; get all the rest
  1639. (when (eq key 'C-return)
  1640. (message "Getting all matches ...")
  1641. (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
  1642. (message "done.")
  1643. (insert (nth 1 ret))))
  1644. ;; postprocessing even for non graceful exit
  1645. (setq cursor-type t)
  1646. ;; replace previous heading
  1647. (let ((numlines (count-lines (point) start-of-lines)))
  1648. (goto-char start-of-lines)
  1649. (delete-region (point-min) (point))
  1650. (insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
  1651. (if (or at-end (eq key 'C-return))
  1652. " showing all %d matches. "
  1653. " showing only some matches. ")
  1654. key-help)
  1655. numlines))
  1656. (insert "\n")
  1657. (setq start-of-lines (point-marker))
  1658. (goto-char (point-min))
  1659. (fill-paragraph)
  1660. (goto-char start-of-lines)
  1661. (if show-headings (insert "\n\n" org-index--headings)))
  1662. (forward-line))
  1663. ;; perform action according to last char
  1664. (forward-line -1)
  1665. (cond
  1666. ((member key (list 'RET ?\C-m))
  1667. (funcall fun-on-ret))
  1668. ((member key (list 'TAB ?\C-i))
  1669. (funcall fun-on-tab))
  1670. ((eq key 'up)
  1671. (forward-line -1))
  1672. ((eq key 'down)
  1673. (forward-line 1))
  1674. ((eq key 'M-return)
  1675. (funcall fun-on-m-ret))
  1676. ((eq key 'S-return)
  1677. (funcall fun-on-s-ret)))))
  1678. (defun org-index--occur-find-heading (x)
  1679. "helper for keymap of occur"
  1680. (interactive)
  1681. (save-excursion
  1682. (let ((ref (org-index--get-field :ref))
  1683. (link (org-index--get-field :link)))
  1684. (message (org-index--do-head ref link x)))))
  1685. (defun org-index--do-new-line (create-ref)
  1686. "Do the common work for org-index-new-line and org-index"
  1687. (let (new)
  1688. (when create-ref
  1689. ;; go through table to find first entry to be reused
  1690. (when org-index--has-reuse
  1691. (goto-char org-index--below-hline)
  1692. ;; go through table
  1693. (while (and (org-at-table-p)
  1694. (not new))
  1695. (when (string=
  1696. (org-index--get-field :count)
  1697. ":reuse:")
  1698. (setq new (org-index--get-field :ref))
  1699. (if new (org-table-kill-row)))
  1700. (forward-line)))
  1701. ;; no ref to reuse; construct new reference
  1702. (unless new
  1703. (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
  1704. ;; remember for org-mark-ring-goto
  1705. (setq org-index--text-to-yank new))
  1706. ;; insert ref or link as very first row
  1707. (goto-char org-index--below-hline)
  1708. (org-table-insert-row)
  1709. ;; insert some of the standard values
  1710. (org-table-goto-column (org-index--column-num :first))
  1711. (org-insert-time-stamp nil nil t)
  1712. (org-table-goto-column (org-index--column-num :count))
  1713. (insert "1")
  1714. new))
  1715. (defun org-index--get-matching-lines (words numlines start-from)
  1716. (let ((numfound 0)
  1717. pos
  1718. initial line lines at-end)
  1719. (with-current-buffer org-index--buffer
  1720. ;; remember initial pos and start at requested
  1721. (setq initial (point))
  1722. (goto-char start-from)
  1723. ;; loop over buffer until we have found enough lines
  1724. (while (and (or (< numfound numlines)
  1725. (= numlines 0))
  1726. (org-at-table-p))
  1727. ;; check each word
  1728. (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
  1729. (when (org-index--test-words words line)
  1730. (setq lines (concat lines line))
  1731. (incf numfound))
  1732. (forward-line 1)
  1733. (setq pos (point)))
  1734. (setq at-end (not (org-at-table-p)))
  1735. ;; return to initial position
  1736. (goto-char initial))
  1737. (unless lines (setq lines ""))
  1738. (list pos lines at-end)))
  1739. (defun org-index--test-words (words line)
  1740. (let ((found-all t))
  1741. (setq line (downcase line))
  1742. (catch 'not-found
  1743. (dolist (w words)
  1744. (or (search w line)
  1745. (throw 'not-found nil)))
  1746. t)))
  1747. (defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
  1748. "Make text from org-index available for yank."
  1749. (when org-index--text-to-yank
  1750. (kill-new org-index--text-to-yank)
  1751. (message (format "Ready to yank '%s'" org-index--text-to-yank))
  1752. (setq org-index--text-to-yank nil)))
  1753. (provide 'org-index)
  1754. ;; Local Variables:
  1755. ;; fill-column: 75
  1756. ;; comment-column: 50
  1757. ;; End:
  1758. ;;; org-index.el ends here