org-favtable.el 62 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701
  1. ;;; org-favtable.el --- Lookup table of favorite references and links
  2. ;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
  3. ;; Author: Marc-Oliver Ihm <org-favtable@ferntreffer.de>
  4. ;; Keywords: hypermedia, matching
  5. ;; Requires: org
  6. ;; Download: http://orgmode.org/worg/code/elisp/org-favtable.el
  7. ;; Version: 2.2.0
  8. ;; This file is not part of GNU Emacs.
  9. ;;; License:
  10. ;; This program is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 3, or (at your option)
  13. ;; any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  22. ;;; Commentary:
  23. ;; Purpose:
  24. ;;
  25. ;; Mark and find your favorite things and locations in org easily: Create
  26. ;; and update a lookup table of your references and links. Often used
  27. ;; entries bubble to the top and entering some keywords displays only the
  28. ;; matching entries. That way the right entry one can be picked 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 of org. Links are just normal org-mode links.
  33. ;;
  34. ;;
  35. ;; Setup:
  36. ;;
  37. ;; - Add these lines to your .emacs:
  38. ;;
  39. ;; (require 'org-favtable)
  40. ;; ;; Good enough to start, but later you should probably
  41. ;; ;; change this id, as will be explained below
  42. ;; (setq org-favtable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4")
  43. ;; ;; Optionally assign a key. Pick your own favorite.
  44. ;; (global-set-key (kbd "C-+") 'org-favtable)
  45. ;;
  46. ;; - Just invoke `org-favtable', which will explain how to complete your
  47. ;; setup by creating the necessary table of favorites.
  48. ;;
  49. ;;
  50. ;; Further reading:
  51. ;;
  52. ;; Invoke `org-favtable' and pick one of its help options. You may also
  53. ;; read the documentation of `org-favtable-id' for setup instructions, of
  54. ;; `org-favtable' for regular usage and of `org-favtable--commands' for a
  55. ;; list of available commands.
  56. ;;
  57. ;;; Change Log:
  58. ;; [2013-02-28 Th] Version 2.2.0:
  59. ;; - Allowed shortcuts like "h237" for command "head" with argument "237"
  60. ;; - Integrated with org-mark-ring-goto
  61. ;;
  62. ;; [2013-01-25 Fr] Version 2.1.0:
  63. ;; - Added full support for links
  64. ;; - New commands "missing" and "statistics"
  65. ;; - Renamed the package from "org-reftable" to "org-favtable"
  66. ;; - Additional columns are required (e.g. "link"). Error messages will
  67. ;; guide you
  68. ;;
  69. ;; [2012-12-07 Fr] Version 2.0.0:
  70. ;; - The format of the table of favorites has changed ! You need to bring
  71. ;; your existing table into the new format by hand (which however is
  72. ;; easy and explained below)
  73. ;; - Reference table can be sorted after usage count or date of last access
  74. ;; - Ask user explicitly, which command to invoke
  75. ;; - Renamed the package from "org-refer-by-number" to "org-reftable"
  76. ;; [2012-09-22 Sa] Version 1.5.0:
  77. ;; - New command "sort" to sort a buffer or region by reference number
  78. ;; - New commands "highlight" and "unhighlight" to mark references
  79. ;; [2012-07-13 Fr] Version 1.4.0:
  80. ;; - New command "head" to find a headline with a reference number
  81. ;; [2012-04-28 Sa] Version 1.3.0:
  82. ;; - New commands occur and multi-occur
  83. ;; - All commands can now be invoked explicitly
  84. ;; - New documentation
  85. ;; - Many bugfixes
  86. ;; [2011-12-10 Sa] Version 1.2.0:
  87. ;; - Fixed a bug, which lead to a loss of newly created reference numbers
  88. ;; - Introduced single and double prefix arguments
  89. ;; - Started this Change Log
  90. ;;; Code:
  91. (require 'org-table)
  92. (require 'cl)
  93. (defvar org-favtable--version "2.2.0")
  94. (defvar org-favtable--preferred-command nil)
  95. (defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics)
  96. "List of commands known to org-favtable:
  97. Commands known:
  98. occur: If you supply a keyword (text): Apply emacs standard
  99. occur operation on the table of favorites; ask for a
  100. string (keyword) to select lines. Occur will only show you
  101. lines which contain the given keyword, so you can easily find
  102. the right one. You may supply a list of words seperated by
  103. comma (\",\"), to select lines that contain any or all of the
  104. given words.
  105. If you supply a reference number: Apply emacs standard
  106. multi-occur operation all org-mode buffers to search for a
  107. specific reference.
  108. You may also read the note at the end of this help on saving
  109. the keystroke RET to accept this frequent default command.
  110. head: If invoked outside the table of favorites, ask for a
  111. reference number and search for a heading containing it. If
  112. invoked within favtable dont ask; rather use the reference or
  113. link from the current line.
  114. ref: Create a new reference, copy any previously selected text.
  115. If already within reftable, fill in ref-column.
  116. link: Create a new line in reftable with a link to the current node.
  117. Do not populate the ref column; this can later be populated by
  118. calling the \"fill\" command from within the reftable.
  119. leave: Leave the table of favorites. If the last command has
  120. been \"ref\", the new reference is copied and ready to yank.
  121. This \"org-mark-ring-goto\" and can be called several times
  122. in succession.
  123. enter: Just enter the node with the table of favorites.
  124. goto: Search for a specific reference within the table of
  125. favorites.
  126. help: Show this list of commands.
  127. +: Show all commands including the less frequently used ones
  128. given below. If \"+\" is followd by enough letters of such a
  129. command (e.g. \"+fi\"), then this command is invoked
  130. directly.
  131. reorder: Temporarily reorder the table of favorites, e.g. by
  132. count, reference or last access.
  133. fill: If either ref or link is missing, fill it.
  134. sort: Sort a set of lines (either the active region or the
  135. whole buffer) by the references found in each line.
  136. update: For the given reference, update the line in the
  137. favtable.
  138. highlight: Highlight references in region or buffer.
  139. unhighlight: Remove highlights.
  140. missing : Search for missing reference numbers (which do not
  141. appear in the reference table). If requested, add additional
  142. lines for them, so that the command \"new\" is able to reuse
  143. them.
  144. statistics : Show some statistics (e.g. minimum and maximum
  145. reference) about favtable.
  146. Two ways to save keystrokes:
  147. When prompting for a command, org-favtable puts the most likely
  148. one (e.g. \"occur\" or \"ref\") at the front of the list, so that
  149. you may just type RET.
  150. If this command needs additional input (like e.g. \"occur\"), you
  151. may supply this input right away, although you are still beeing
  152. prompted for the command. So do an occur for the string \"foo\",
  153. you can just enter \"foo\" without even entering \"occur\".
  154. Another way to save keystrokes applies if you want to choose a
  155. command, that requrires a reference number (and would normally
  156. prompt for it): In that case you may just enter enough characters
  157. from your command, so that it appears first in the list of
  158. matches; then immediately enter the number of the reference you
  159. are searching for. So the input \"h237\" would execute the
  160. command \"head\" for reference \"237\" right away.
  161. ")
  162. (defvar org-favtable--commands-some '(occur head ref link leave enter goto + help))
  163. (defvar org-favtable--columns nil)
  164. (defvar org-favtable-id nil
  165. "Id of the Org-mode node, which contains the favorite table.
  166. Read below, on how to set up things. See the help options
  167. \"usage\" and \"commands\" for normal usage after setup.
  168. Setup requires two steps:
  169. - Adjust your .emacs initialization file
  170. - Create a suitable org-mode node
  171. Here are the lines, you need to add to your .emacs:
  172. (require 'org-favtable)
  173. ;; Good enough to start, but later you should probably
  174. ;; change this id, as will be explained below
  175. (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\")
  176. ;; Optionally assign a key. Pick your own favorite.
  177. (global-set-key (kbd \"C-+\") 'org-favtable)
  178. Do not forget to restart emacs to make these lines effective.
  179. As a second step you need to create the org-mode node, where your
  180. reference numbers and links will be stored. It may look like
  181. this:
  182. * org-favtable
  183. :PROPERTIES:
  184. :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4
  185. :END:
  186. | | | Comment, description, details | | | |
  187. | ref | link | ;c | count;s | created | last-accessed |
  188. | | <4> | <30> | | | |
  189. |-----+------+--------------------------------+---------+---------+---------------|
  190. | R1 | | My first reference | | | |
  191. You may just copy this node into one of your org-files. Many
  192. things however can or should be adjusted:
  193. - The node needs not be a top level node.
  194. - Its name is completely at you choice. The node is found
  195. through its ID.
  196. - There are three lines of headings above the first hline. The
  197. first one is ignored by org-favtable, and you can use them to
  198. give meaningful names to columns; the second line contains
  199. configuration information for org-favtable; please read
  200. further below for its format. The third line is optional and
  201. may contain width-informations (e.g. <30>) only.
  202. - The sequence of columns does not matter. You may reorder them
  203. any way you like; e.g. make the comment-column the last
  204. columns within the table. Columns ar found by their name,
  205. which appears in the second heading-line.
  206. - You can add further columns or even remove the
  207. \"Comment\"-column. All other columns from the
  208. example (e.g. \"ref\", \"link\", \"count\", \"created\" and
  209. \"last-accessed\") are required.
  210. - Your references need not start at \"R1\"; However, having an
  211. initial row is required (it serves as a template for subsequent
  212. references).
  213. - Your reference need not have the form \"R1\"; you may just as
  214. well choose any text, that contains a single number,
  215. e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The
  216. function `org-favtable' will inspect your first reference and
  217. create all subsequent references in the same way.
  218. - You may want to change the ID-Property of the node above and
  219. create a new one, which is unique (and not just a copy of
  220. mine). You need to change it in the lines copied to your .emacs
  221. too. However, this is not strictly required to make things
  222. work, so you may do this later, after trying out this package.
  223. Optionally you may tweak the second header line to adjust
  224. `org-favtable' a bit. In the example above it looks like this
  225. (with spaces collapsed):
  226. | ref | link | ;c | count;s | created | last-accessed |
  227. The different fields have different meanings:
  228. - ref : This denotes the column which contains you references
  229. - link : Column for org-mode links, which can be used to access
  230. locations within your files.
  231. - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column
  232. as the one beeing copied on command \"leave\". In the example
  233. above, it is also the comment-column.
  234. - count;s : this is the column which counts, how many time this
  235. line has been accessed (which is the key-feature of this
  236. package). The flag \"s\" stands for \"sort\", so the table is
  237. sorted after this column. You may also sort after columns
  238. \"ref\" or \"last-accessed\".
  239. - created : Date when this line was created.
  240. - last-accessed : Date and time, when this line was last accessed.
  241. After this two-step setup process you may invoke `org-favtable'
  242. to create a new favorite. Read the help option \"usage\" for
  243. instructions on normal usage, read the help option \"commands\"
  244. for help on single commands.
  245. ")
  246. (defvar org-favtable--text-to-yank nil)
  247. (defvar org-favtable--last-action nil)
  248. (defvar org-favtable--occur-buffer nil)
  249. (defvar org-favtable--ref-regex nil)
  250. (defvar org-favtable--ref-format nil)
  251. (defun org-favtable (&optional what search search-is-link)
  252. "Mark and find your favorite items and org-locations easily:
  253. Create and update a lookup table of your favorite references and
  254. links. Often used entries automatically bubble to the top of the
  255. table; entering some keywords narrows it to just the matching
  256. entries; that way the right one can be picked easily.
  257. References are essentially small numbers (e.g. \"R237\" or
  258. \"-455-\"), as created by this package; links are normal org-mode
  259. links. Within org-favtable, both are denoted as favorites.
  260. Read below for a detailed description of this function. See the
  261. help option \"setup\" or read the documentation of
  262. `org-favtable-id' for setup instructions.
  263. The function `org-favtable' operates on a dedicated table (called
  264. the table or favorites or favtable, for short) within a special
  265. Org-mode node. The node has to be created as part of your initial
  266. setup. Each line of the favorite table contains:
  267. - A reference (optional)
  268. - A link (optional)
  269. - A number; counting, how often each reference has been
  270. used. This number is updated automatically and the table can
  271. be sorted according to it, so that most frequently used
  272. references appear at the top of the table and can be spotted
  273. easily.
  274. - Its respective creation date
  275. - Date and time of last access. This column can alternatively be
  276. used to sort the table.
  277. To be useful, your table of favorites should probably contain a
  278. column with comments too, which allows lines to be selected by
  279. keywords.
  280. The table of favorites is found through the id of the containing
  281. node; this id should be stored within `org-favtable-id' (see there
  282. for details).
  283. The function `org-favtable' is the only interactive function of
  284. this package and its sole entry point; it offers several commands
  285. to create, find and look up these favorites (references and
  286. links). All of them are explained within org-favtable's help.
  287. Finally, org-favtable can also be invoked from elisp; the two
  288. optional arguments accepted are:
  289. search : string to search for
  290. what : symbol of the command to invoke
  291. search-is-link : t, if argument search is actually a link
  292. An example would be:
  293. (org-favtable \"237\" 'head) ;; find heading with ref 237
  294. "
  295. (interactive "P")
  296. (let (within-node ; True, if we are within node with favtable
  297. result-is-visible ; True, if node or occur is visible in any window
  298. ref-node-buffer-and-point ; cons with buffer and point of favorites node
  299. below-cursor ; word below cursor
  300. active-region ; active region (if any)
  301. link-id ; link of starting node, if required
  302. guarded-search ; with guard against additional digits
  303. search-is-ref ; true, if search is a reference
  304. commands ; currently active set of selectable commands
  305. what-adjusted ; True, if we had to adjust what
  306. what-input ; Input on what question (need not necessary be "what")
  307. reorder-once ; Column to use for single time sorting
  308. parts ; Parts of a typical reference number (which
  309. ; need not be a plain number); these are:
  310. head ; Any header before number (e.g. "R")
  311. maxref ; Maximum number from reference table (e.g. "153")
  312. tail ; Tail after number (e.g. "}" or "")
  313. ref-regex ; Regular expression to match a reference
  314. has-reuse ; True, if table contains a line for reuse
  315. numcols ; Number of columns in favtable
  316. kill-new-text ; Text that will be appended to kill ring
  317. message-text ; Text that will be issued as an explanation,
  318. ; what we have done
  319. initial-ref-or-link ; Initial position in reftable
  320. )
  321. ;;
  322. ;; Examine current buffer and location, before turning to favtable
  323. ;;
  324. ;; Get the content of the active region or the word under cursor
  325. (if (and transient-mark-mode
  326. mark-active)
  327. (setq active-region (buffer-substring (region-beginning) (region-end))))
  328. (setq below-cursor (thing-at-point 'symbol))
  329. ;; Find out, if we are within favable or not
  330. (setq within-node (string= (org-id-get) org-favtable-id))
  331. ;; Find out, if point in any window is within node with favtable
  332. (mapc (lambda (x) (with-current-buffer (window-buffer x)
  333. (when (or
  334. (string= (org-id-get) org-favtable-id)
  335. (eq (window-buffer x)
  336. org-favtable--occur-buffer))
  337. (setq result-is-visible t))))
  338. (window-list))
  339. ;;
  340. ;; Get decoration of references and highest reference from favtable
  341. ;;
  342. ;; Save initial ref or link
  343. (if (and within-node
  344. (org-at-table-p))
  345. (setq initial-ref-or-link
  346. (or (org-favtable--get-field 'ref)
  347. (org-favtable--get-field 'link))))
  348. ;; Find node
  349. (setq ref-node-buffer-and-point (org-favtable--id-find))
  350. (unless ref-node-buffer-and-point
  351. (org-favtable--report-setup-error
  352. (format "Cannot find node with id \"%s\"" org-favtable-id)))
  353. ;; Get configuration of reftable; catch errors
  354. (let ((error-message
  355. (catch 'content-error
  356. (with-current-buffer (car ref-node-buffer-and-point)
  357. (save-excursion
  358. (unless (string= (org-id-get) org-favtable-id)
  359. (goto-char (cdr ref-node-buffer-and-point)))
  360. ;; parse table while still within buffer
  361. (setq parts (org-favtable--parse-and-adjust-table)))
  362. nil))))
  363. (when error-message
  364. (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
  365. (org-reveal)
  366. (error error-message)))
  367. ;; Give names to parts of configuration
  368. (setq head (nth 0 parts))
  369. (setq maxref (nth 1 parts))
  370. (setq tail (nth 2 parts))
  371. (setq numcols (nth 3 parts))
  372. (setq ref-regex (nth 4 parts))
  373. (setq has-reuse (nth 5 parts))
  374. (setq org-favtable--ref-regex ref-regex)
  375. (setq org-favtable--ref-format (concat head "%d" tail))
  376. ;;
  377. ;; Find out, what we are supposed to do
  378. ;;
  379. (if (equal what '(4)) (setq what 'leave))
  380. ;; Set preferred action, that will be the default choice
  381. (setq org-favtable--preferred-command
  382. (if within-node
  383. (if (memq org-favtable--last-action '(ref link))
  384. 'leave
  385. 'occur)
  386. (if active-region
  387. 'ref
  388. (if (and below-cursor (string-match ref-regex below-cursor))
  389. 'occur
  390. nil))))
  391. ;; Ask user, what to do
  392. (unless what
  393. (setq commands (copy-list org-favtable--commands-some))
  394. (while (progn
  395. (setq what-input
  396. (org-icompleting-read
  397. "Please choose: "
  398. (mapcar 'symbol-name
  399. ;; Construct unique list of commands with
  400. ;; preferred one at front
  401. (delq nil (delete-dups
  402. (append
  403. (list org-favtable--preferred-command)
  404. commands))))
  405. nil nil))
  406. ;; if input starts with "+", any command (not only some) may follow
  407. ;; this allows input like "+sort" to be accepted
  408. (when (string= (substring what-input 0 1) "+")
  409. ;; make all commands available for selection
  410. (setq commands (copy-list org-favtable--commands))
  411. (unless (string= what-input "+")
  412. ;; not just "+", use following string
  413. (setq what-input (substring what-input 1))
  414. (let ((completions
  415. ;; get list of possible completions for what-input
  416. (all-completions what-input (mapcar 'symbol-name commands))))
  417. ;; use it, if unambigously
  418. (if (= (length completions) 1)
  419. (setq what-input (car completions))))))
  420. ;; if input ends in digits, save them away and do completions on head of input
  421. ;; this allows input like "h224" to be accepted
  422. (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input)
  423. ;; use first match as input, even if ambigously
  424. (setq org-favtable--preferred-command
  425. (intern (first (all-completions (match-string 1 what-input)
  426. (mapcar 'symbol-name commands)))))
  427. ;; use digits as argument to commands
  428. (setq what-input (format org-favtable--ref-format
  429. (string-to-number (match-string 2 what-input)))))
  430. (setq what (intern what-input))
  431. ;; user is not required to input one of the commands; if
  432. ;; not, take the first one and use the original input for
  433. ;; next question
  434. (if (memq what commands)
  435. ;; input matched one element of list, dont need original
  436. ;; input any more
  437. (setq what-input nil)
  438. ;; what-input will be used for next question, use first
  439. ;; command for what
  440. (setq what (or org-favtable--preferred-command
  441. (first commands)))
  442. ;; remove any trailing dot, that user might have added to
  443. ;; disambiguate his input
  444. (if (equal (substring what-input -1) ".")
  445. ;; but do this only, if dot was really necessary to
  446. ;; disambiguate
  447. (let ((shortened-what-input (substring what-input 0 -1)))
  448. (unless (test-completion shortened-what-input
  449. (mapcar 'symbol-name
  450. commands))
  451. (setq what-input shortened-what-input)))))
  452. ;; ask for reorder in loop, because we have to ask for
  453. ;; what right again
  454. (if (eq what 'reorder)
  455. (setq reorder-once
  456. (intern
  457. (org-icompleting-read
  458. "Please choose column to reorder reftable once: "
  459. (mapcar 'symbol-name '(ref count last-accessed))
  460. nil t))))
  461. ;; maybe ask initial question again
  462. (memq what '(reorder +)))))
  463. ;;
  464. ;; Get search, if required
  465. ;;
  466. ;; These actions need a search string:
  467. (when (memq what '(goto occur head update))
  468. ;; Maybe we've got a search string from the arguments
  469. (unless search
  470. (let (search-from-table
  471. search-from-cursor)
  472. ;; Search string can come from several sources:
  473. ;; From ref column of table
  474. (when within-node
  475. (setq search-from-table (org-favtable--get-field 'ref)))
  476. ;; From string below cursor
  477. (when (and (not within-node)
  478. below-cursor
  479. (string-match (concat "\\(" ref-regex "\\)")
  480. below-cursor))
  481. (setq search-from-cursor (match-string 1 below-cursor)))
  482. ;; Depending on requested action, get search from one of the sources above
  483. (cond ((eq what 'goto)
  484. (setq search (or what-input search-from-cursor)))
  485. ((memq what '(head occur))
  486. (setq search (or what-input search-from-table search-from-cursor))))))
  487. ;; If we still do not have a search string, ask user explicitly
  488. (unless search
  489. (if what-input
  490. (setq search what-input)
  491. (setq search (read-from-minibuffer
  492. (cond ((memq what '(occur head))
  493. "Text or reference number to search for: ")
  494. ((eq what 'goto)
  495. "Reference number to search for, or enter \".\" for id of current node: ")
  496. ((eq what 'update)
  497. "Reference number to update: ")))))
  498. (if (string-match "^\\s *[0-9]+\\s *$" search)
  499. (setq search (format "%s%s%s" head (org-trim search) tail))))
  500. ;; Clean up and examine search string
  501. (if search (setq search (org-trim search)))
  502. (if (string= search "") (setq search nil))
  503. (setq search-is-ref (string-match ref-regex search))
  504. ;; Check for special case
  505. (when (and (memq what '(head goto))
  506. (string= search "."))
  507. (setq search (org-id-get))
  508. (setq search-is-link t))
  509. (when search-is-ref
  510. (setq guarded-search (org-favtable--make-guarded-search search)))
  511. ;;
  512. ;; Do some sanity checking before really starting
  513. ;;
  514. ;; Correct requested action, if nothing to search
  515. (when (and (not search)
  516. (memq what '(search occur head)))
  517. (setq what 'enter)
  518. (setq what-adjusted t))
  519. ;; For a proper reference as input, we do multi-occur
  520. (if (and (string-match ref-regex search)
  521. (eq what 'occur))
  522. (setq what 'multi-occur))
  523. ;; Check for invalid combinations of arguments; try to be helpful
  524. (when (and (memq what '(head goto))
  525. (not search-is-link)
  526. (not search-is-ref))
  527. (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)))
  528. ;;
  529. ;; Prepare
  530. ;;
  531. ;; Get link if required before moving in
  532. (if (eq what 'link)
  533. (setq link-id (org-id-get-create)))
  534. ;; Move into table, if outside
  535. (when (memq what '(enter ref link goto occur multi-occur missing statistics))
  536. ;; Support orgmode-standard of going back (buffer and position)
  537. (org-mark-ring-push)
  538. ;; Switch to favtable
  539. (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
  540. (goto-char (cdr ref-node-buffer-and-point))
  541. (show-subtree)
  542. (org-show-context)
  543. ;; sort favtable
  544. (org-favtable--sort-table reorder-once))
  545. ;; Goto back to initial ref, because reformatting of table above might
  546. ;; have moved point
  547. (when initial-ref-or-link
  548. (while (and (org-at-table-p)
  549. (not (or
  550. (string= initial-ref-or-link (org-favtable--get-field 'ref))
  551. (string= initial-ref-or-link (org-favtable--get-field 'link)))))
  552. (forward-line))
  553. ;; did not find ref, go back to top
  554. (if (not (org-at-table-p)) (goto-char top)))
  555. ;;
  556. ;; Actually do, what is requested
  557. ;;
  558. (cond
  559. ((eq what 'help)
  560. (let ((help-what
  561. ;; which sort of help ?
  562. (intern
  563. (concat
  564. "help-"
  565. (org-icompleting-read
  566. "Help on: "
  567. (mapcar 'symbol-name '(commands usage setup version example))
  568. nil t)))))
  569. ;; help is taken from docstring of functions or variables
  570. (cond ((eq help-what 'help-commands)
  571. (org-favtable--show-help 'org-favtable--commands))
  572. ((eq help-what 'help-usage)
  573. (org-favtable--show-help 'org-favtable))
  574. ((eq help-what 'help-setup)
  575. (org-favtable--show-help 'org-favtable-id))
  576. ((eq help-what 'help-version)
  577. (org-favtable-version)))))
  578. ((eq what 'multi-occur)
  579. ;; Conveniently position cursor on number to search for
  580. (org-favtable--goto-top)
  581. (let (found (initial (point)))
  582. (while (and (not found)
  583. (forward-line)
  584. (org-at-table-p))
  585. (save-excursion
  586. (setq found (string= search
  587. (org-favtable--get-field 'ref)))))
  588. (if found
  589. (org-favtable--update-line nil)
  590. (goto-char initial)))
  591. ;; Construct list of all org-buffers
  592. (let (buff org-buffers)
  593. (dolist (buff (buffer-list))
  594. (set-buffer buff)
  595. (if (string= major-mode "org-mode")
  596. (setq org-buffers (cons buff org-buffers))))
  597. ;; Do multi-occur
  598. (multi-occur org-buffers guarded-search)
  599. (if (get-buffer "*Occur*")
  600. (progn
  601. (setq message-text (format "multi-occur for '%s'" search))
  602. (setq org-favtable--occur-buffer (get-buffer "*Occur*"))
  603. (other-window 1)
  604. (toggle-truncate-lines 1))
  605. (setq message-text (format "Did not find '%s'" search)))))
  606. ((eq what 'head)
  607. (let (link)
  608. ;; link either from table or passed in as argument
  609. ;; try to get link
  610. (if search-is-link
  611. (setq link (org-trim search))
  612. (if (and within-node
  613. (org-at-table-p))
  614. (setq link (org-favtable--get-field 'link))))
  615. ;; use link if available
  616. (if (and link
  617. (not (string= link "")))
  618. (progn
  619. (org-id-goto link)
  620. (org-favtable--update-line search)
  621. (setq message-text "Followed link"))
  622. (message (format "Scanning headlines for '%s' ..." search))
  623. (let (buffer point)
  624. (if (catch 'found
  625. (progn
  626. ;; loop over all headlines, stop on first match
  627. (org-map-entries
  628. (lambda ()
  629. (when (looking-at (concat ".*" guarded-search))
  630. ;; remember location and bail out
  631. (setq buffer (current-buffer))
  632. (setq point (point))
  633. (throw 'found t)))
  634. nil 'agenda)
  635. nil))
  636. (progn
  637. (org-favtable--update-line search)
  638. (setq message-text (format "Found '%s'" search))
  639. (org-pop-to-buffer-same-window buffer)
  640. (goto-char point)
  641. (org-reveal))
  642. (setq message-text (format "Did not find '%s'" search)))))))
  643. ((eq what 'leave)
  644. (when result-is-visible
  645. ;; If we are within the occur-buffer, switch over to get current line
  646. (if (and (string= (buffer-name) "*Occur*")
  647. (eq org-favtable--last-action 'occur))
  648. (occur-mode-goto-occurrence)))
  649. (setq kill-new-text org-favtable--text-to-yank)
  650. (setq org-favtable--text-to-yank nil)
  651. ;; If "leave" has been called two times in succession, make
  652. ;; org-mark-ring-goto believe it has been called two times too
  653. (if (eq org-favtable--last-action 'leave)
  654. (let ((this-command nil) (last-command nil))
  655. (org-mark-ring-goto 1))
  656. (org-mark-ring-goto 0)))
  657. ((eq what 'goto)
  658. ;; Go downward in table to requested reference
  659. (let (found (initial (point)))
  660. (org-favtable--goto-top)
  661. (while (and (not found)
  662. (forward-line)
  663. (org-at-table-p))
  664. (save-excursion
  665. (setq found
  666. (string= search
  667. (org-favtable--get-field
  668. (if search-is-link 'link 'ref))))))
  669. (if found
  670. (progn
  671. (setq message-text (format "Found '%s'" search))
  672. (org-favtable--update-line nil)
  673. (org-table-goto-column (org-favtable--column-num 'ref))
  674. (if (looking-back " ") (backward-char))
  675. ;; remember string to copy
  676. (setq org-favtable--text-to-yank
  677. (org-trim (org-table-get-field (org-favtable--column-num 'copy)))))
  678. (setq message-text (format "Did not find '%s'" search))
  679. (goto-char initial)
  680. (forward-line)
  681. (setq what 'missed))))
  682. ((eq what 'occur)
  683. ;; search for string: occur
  684. (let (search-regexp
  685. all-or-any
  686. (search-words (split-string search "," t)))
  687. (if (< (length search-words) 2)
  688. ;; only one word to search; use it as is
  689. (setq search-regexp search)
  690. ;; construct regexp to match any of the words (maybe throw out some matches later)
  691. (setq search-regexp
  692. (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|"))
  693. (setq all-or-any
  694. (intern
  695. (org-icompleting-read
  696. "Two or more words have been specified; show lines, that match: " '("all" "any")))))
  697. (save-restriction
  698. (org-narrow-to-subtree)
  699. (occur search-regexp)
  700. (widen)
  701. (if (get-buffer "*Occur*")
  702. (with-current-buffer "*Occur*"
  703. ;; install helpful keyboard-shortcuts within occur-buffer
  704. (let ((keymap (make-sparse-keymap)))
  705. (set-keymap-parent keymap occur-mode-map)
  706. (define-key keymap (kbd "RET")
  707. (lambda () (interactive)
  708. (org-favtable--occur-helper 'head)))
  709. (define-key keymap (kbd "<C-return>")
  710. (lambda () (interactive)
  711. (org-favtable--occur-helper 'multi-occur)))
  712. (define-key keymap (kbd "<M-return>")
  713. (lambda () (interactive)
  714. (org-favtable--occur-helper 'goto)))
  715. (define-key keymap (kbd "<C-M-return>")
  716. (lambda () (interactive)
  717. (org-favtable--occur-helper 'update)))
  718. (use-local-map keymap))
  719. ;; Brush up occur buffer
  720. (other-window 1)
  721. (toggle-truncate-lines 1)
  722. (let ((inhibit-read-only t))
  723. ;; insert some help text
  724. (insert (substitute-command-keys
  725. "Type RET to find heading, C-RET for multi-occur, M-RET to go to occurence and C-M-RET to update line in reftable.\n\n"))
  726. (forward-line 1)
  727. ;; when matching all of multiple words, remove all lines that do not match one of the words
  728. (when (eq all-or-any 'all)
  729. (mapc (lambda (x) (keep-lines x)) search-words))
  730. ;; replace description from occur
  731. (when all-or-any
  732. (forward-line -1)
  733. (kill-line)
  734. (let ((count (- (count-lines (point) (point-max)) 1)))
  735. (insert (format "%d %s for %s of %s"
  736. count
  737. (if (= count 1) "match" "matches")
  738. all-or-any
  739. search)))
  740. (forward-line)
  741. (beginning-of-line))
  742. ;; Record link or reference for each line in
  743. ;; occur-buffer, that is linked into reftable. Because if
  744. ;; we later realign the reftable and then reuse the occur
  745. ;; buffer, the original links might point nowehere.
  746. (save-excursion
  747. (while (not (eq (point) (point-max)))
  748. (let ((beg (line-beginning-position))
  749. (end (line-end-position))
  750. pos ref link)
  751. ;; occur has saved the position into a special property
  752. (setq pos (get-text-property (point) 'occur-target))
  753. (when pos
  754. ;; but this property might soon point nowhere; so retrieve ref-or-link instead
  755. (with-current-buffer (marker-buffer pos)
  756. (goto-char pos)
  757. (setq ref (org-favtable--get-field 'ref))
  758. (setq link (org-favtable--get-field 'link))))
  759. ;; save as text property
  760. (put-text-property beg end 'org-favtable--ref ref)
  761. (put-text-property beg end 'org-favtable--link link))
  762. (forward-line))))
  763. (setq message-text
  764. (format "Occur for '%s'" search)))
  765. (setq message-text
  766. (format "Did not find any matches for '%s'" search))))))
  767. ((memq what '(ref link))
  768. ;; add a new row (or reuse existing one)
  769. (let (new)
  770. (when (eq what 'ref)
  771. ;; go through table to find first entry to be reused
  772. (when has-reuse
  773. (org-favtable--goto-top)
  774. ;; go through table
  775. (while (and (org-at-table-p)
  776. (not new))
  777. (when (string=
  778. (org-favtable--get-field 'count)
  779. ":reuse:")
  780. (setq new (org-favtable--get-field 'ref))
  781. (if new (org-table-kill-row)))
  782. (forward-line)))
  783. ;; no ref to reuse; construct new reference
  784. (unless new
  785. (setq new (format "%s%d%s" head (1+ maxref) tail)))
  786. ;; remember for org-mark-ring-goto
  787. (setq org-favtable--text-to-yank new))
  788. ;; insert ref or link as very first row
  789. (org-favtable--goto-top)
  790. (org-table-insert-row)
  791. ;; fill special columns with standard values
  792. (when (eq what 'ref)
  793. (org-table-goto-column (org-favtable--column-num 'ref))
  794. (insert new))
  795. (when (eq what 'link)
  796. (org-table-goto-column (org-favtable--column-num 'link))
  797. (insert link-id))
  798. (org-table-goto-column (org-favtable--column-num 'created))
  799. (org-insert-time-stamp nil nil t)
  800. ;; goto first empty field
  801. (unless (catch 'empty
  802. (dotimes (col numcols)
  803. (org-table-goto-column (+ col 1))
  804. (if (string= (org-trim (org-table-get-field)) "")
  805. (throw 'empty t))))
  806. ;; none found, goto first
  807. (org-table-goto-column 1))
  808. (org-table-align)
  809. (if active-region (setq kill-new-text active-region))
  810. (if (eq what 'ref)
  811. (setq message-text (format "Adding a new row with ref '%s'" new))
  812. (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
  813. ((eq what 'enter)
  814. ;; simply go into table
  815. (org-favtable--goto-top)
  816. (show-subtree)
  817. (recenter)
  818. (if what-adjusted
  819. (setq message-text "Nothing to search for; at favtable")
  820. (setq message-text "At favtable")))
  821. ((eq what 'fill)
  822. ;; check, if within reftable
  823. (unless (and within-node
  824. (org-at-table-p))
  825. (error "Not within table of favorites"))
  826. ;; applies to missing refs and missing links alike
  827. (let ((ref (org-favtable--get-field 'ref))
  828. (link (org-favtable--get-field 'link)))
  829. (if (and (not ref)
  830. (not link))
  831. ;; have already checked this during parse, check here anyway
  832. (error "Columns ref and link are both empty in this line"))
  833. ;; fill in new ref
  834. (if (not ref)
  835. (progn
  836. (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail))
  837. (org-favtable--get-field 'ref kill-new-text)
  838. ;; remember for org-mark-ring-goto
  839. (setq org-favtable--text-to-yank kill-new-text)
  840. (org-id-goto link)
  841. (setq message-text "Filled reftable field with new reference"))
  842. ;; fill in new link
  843. (if (not link)
  844. (progn
  845. (setq guarded-search (org-favtable--make-guarded-search ref))
  846. (message (format "Scanning headlines for '%s' ..." ref))
  847. (let (link)
  848. (if (catch 'found
  849. (org-map-entries
  850. (lambda ()
  851. (when (looking-at (concat ".*" guarded-search))
  852. (setq link (org-id-get-create))
  853. (throw 'found t)))
  854. nil 'agenda)
  855. nil)
  856. (progn
  857. (org-favtable--get-field 'link link)
  858. (setq message-text "Inserted link"))
  859. (setq message-text (format "Did not find reference '%s'" ref)))))
  860. ;; nothing is missing
  861. (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do")))))
  862. ((eq what 'sort)
  863. ;; sort lines according to contained reference
  864. (let (begin end where)
  865. (catch 'aborted
  866. ;; either active region or whole buffer
  867. (if (and transient-mark-mode
  868. mark-active)
  869. ;; sort only region
  870. (progn
  871. (setq begin (region-beginning))
  872. (setq end (region-end))
  873. (setq where "region"))
  874. ;; sort whole buffer
  875. (setq begin (point-min))
  876. (setq end (point-max))
  877. (setq where "whole buffer")
  878. ;; make sure
  879. (unless (y-or-n-p "Sort whole buffer ")
  880. (setq message-text "Sort aborted")
  881. (throw 'aborted nil)))
  882. (save-excursion
  883. (save-restriction
  884. (goto-char (point-min))
  885. (narrow-to-region begin end)
  886. (sort-subr nil 'forward-line 'end-of-line
  887. (lambda ()
  888. (if (looking-at (concat ".*"
  889. (org-favtable--make-guarded-search ref-regex 'dont-quote)))
  890. (string-to-number (match-string 1))
  891. 0))))
  892. (highlight-regexp ref-regex)
  893. (setq message-text (format "Sorted %s from character %d to %d, %d lines"
  894. where begin end
  895. (count-lines begin end)))))))
  896. ((eq what 'update)
  897. ;; simply update line in reftable
  898. (save-excursion
  899. (let ((ref-or-link (if search-is-link "link" "reference")))
  900. (beginning-of-line)
  901. (if (org-favtable--update-line search)
  902. (setq message-text (format "Updated %s '%s'" ref-or-link search))
  903. (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
  904. ((eq what 'parse)
  905. ;; Just parse the reftable, which is already done, so nothing to do
  906. )
  907. ((memq what '(highlight unhighlight))
  908. (let ((where "buffer"))
  909. (save-excursion
  910. (save-restriction
  911. (when (and transient-mark-mode
  912. mark-active)
  913. (narrow-to-region (region-beginning) (region-end))
  914. (setq where "region"))
  915. (if (eq what 'highlight)
  916. (progn
  917. (highlight-regexp ref-regex)
  918. (setq message-text (format "Highlighted references in %s" where)))
  919. (unhighlight-regexp ref-regex)
  920. (setq message-text (format "Removed highlights for references in %s" where)))))))
  921. ((memq what '(missing statistics))
  922. (org-favtable--goto-top)
  923. (let (missing
  924. ref-field
  925. ref
  926. min
  927. max
  928. (total 0))
  929. ;; start with list of all references
  930. (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail))
  931. (number-sequence 1 maxref)))
  932. ;; go through table and remove all refs, that we see
  933. (while (and (forward-line)
  934. (org-at-table-p))
  935. ;; get ref-field and number
  936. (setq ref-field (org-favtable--get-field 'ref))
  937. (if (and ref-field
  938. (string-match ref-regex ref-field))
  939. (setq ref (string-to-number (match-string 1 ref-field))))
  940. ;; remove existing refs from list
  941. (if ref-field (setq missing (delete ref-field missing)))
  942. ;; record min and max
  943. (if (or (not min) (< ref min)) (setq min ref))
  944. (if (or (not max) (> ref max)) (setq max ref))
  945. ;; count
  946. (setq total (1+ total)))
  947. ;; insert them, if requested
  948. (forward-line -1)
  949. (if (eq what 'statistics)
  950. (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
  951. total
  952. (format org-favtable--format min)
  953. (format org-favtable--format max)
  954. (length missing)))
  955. (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites"
  956. (length missing)))
  957. (let (type)
  958. (setq type (org-icompleting-read
  959. "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
  960. (mapc (lambda (x)
  961. (let (org-table-may-need-update) (org-table-insert-row t))
  962. (org-favtable--get-field 'ref x)
  963. (org-favtable--get-field 'count (format ":%s:" type)))
  964. missing)
  965. (org-table-align)
  966. (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
  967. (setq message-text (format "%d missing references." (length missing)))))))
  968. (t (error "This is a bug: unmatched case '%s'" what)))
  969. ;; remember what we have done for next time
  970. (setq org-favtable--last-action what)
  971. ;; tell, what we have done and what can be yanked
  972. (if kill-new-text (setq kill-new-text
  973. (substring-no-properties kill-new-text)))
  974. (if (string= kill-new-text "") (setq kill-new-text nil))
  975. (let ((m (concat
  976. message-text
  977. (if (and message-text kill-new-text)
  978. " and r"
  979. (if kill-new-text "R" ""))
  980. (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
  981. (unless (string= m "") (message m)))
  982. (if kill-new-text (kill-new kill-new-text))))
  983. (defun org-favtable--parse-and-adjust-table ()
  984. (let ((maxref 0)
  985. top
  986. bottom
  987. ref-field
  988. link-field
  989. parts
  990. numcols
  991. head
  992. tail
  993. ref-regex
  994. has-reuse
  995. initial-point)
  996. (setq initial-point (point))
  997. (org-favtable--goto-top)
  998. (setq top (point))
  999. (goto-char top)
  1000. ;; count columns
  1001. (org-table-goto-column 100)
  1002. (setq numcols (- (org-table-current-column) 1))
  1003. ;; get contents of columns
  1004. (forward-line -2)
  1005. (unless (org-at-table-p)
  1006. (org-favtable--report-setup-error
  1007. "Table of favorites starts with a hline" t))
  1008. ;; check for optional line consisting solely of width specifications
  1009. (beginning-of-line)
  1010. (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
  1011. (forward-line -1))
  1012. (org-table-goto-column 1)
  1013. (setq org-favtable--columns (org-favtable--parse-headings numcols))
  1014. ;; Go beyond end of table
  1015. (while (org-at-table-p) (forward-line 1))
  1016. ;; Kill all empty rows at bottom
  1017. (while (progn
  1018. (forward-line -1)
  1019. (org-table-goto-column 1)
  1020. (and
  1021. (not (org-favtable--get-field 'ref))
  1022. (not (org-favtable--get-field 'link))))
  1023. (org-table-kill-row))
  1024. (forward-line)
  1025. (setq bottom (point))
  1026. (forward-line -1)
  1027. ;; Retrieve any decorations around the number within the first nonempty ref-field
  1028. (goto-char top)
  1029. (while (and (org-at-table-p)
  1030. (not (setq ref-field (org-favtable--get-field 'ref))))
  1031. (forward-line))
  1032. ;; Some Checking
  1033. (unless ref-field
  1034. (org-favtable--report-setup-error
  1035. "No line of reference column contains a number" t))
  1036. (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
  1037. (org-favtable--report-setup-error
  1038. (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t))
  1039. ;; These are the decorations used within the first ref of favtable
  1040. (setq head (match-string 1 ref-field))
  1041. (setq tail (match-string 3 ref-field))
  1042. (setq ref-regex (concat (regexp-quote head)
  1043. "\\([0-9]+\\)"
  1044. (regexp-quote tail)))
  1045. ;; Go through table to find maximum number and do some checking
  1046. (let ((ref 0))
  1047. (while (org-at-table-p)
  1048. (setq ref-field (org-favtable--get-field 'ref))
  1049. (setq link-field (org-favtable--get-field 'link))
  1050. (if (and (not ref-field)
  1051. (not link-field))
  1052. (throw 'content-error "Columns ref and link are both empty in this line"))
  1053. (if ref-field
  1054. (if (string-match ref-regex ref-field)
  1055. ;; grab number
  1056. (setq ref (string-to-number (match-string 1 ref-field)))
  1057. (throw 'content-error "Column ref does not contain a number")))
  1058. ;; check, if higher ref
  1059. (if (> ref maxref) (setq maxref ref))
  1060. ;; check if ref is ment for reuse
  1061. (if (string= (org-favtable--get-field 'count) ":reuse:")
  1062. (setq has-reuse 1))
  1063. (forward-line 1)))
  1064. ;; sort used to be here
  1065. (setq parts (list head maxref tail numcols ref-regex has-reuse))
  1066. ;; go back to top of table
  1067. (goto-char top)
  1068. parts))
  1069. (defun org-favtable--sort-table (sort-column)
  1070. (unless sort-column (setq sort-column (org-favtable--column-num 'sort)))
  1071. (let (top
  1072. bottom
  1073. ref-field
  1074. count-field
  1075. count-special)
  1076. ;; get boundaries of table
  1077. (org-favtable--goto-top)
  1078. (forward-line 0)
  1079. (setq top (point))
  1080. (while (org-at-table-p) (forward-line))
  1081. (setq bottom (point))
  1082. (save-restriction
  1083. (narrow-to-region top bottom)
  1084. (goto-char top)
  1085. (sort-subr t
  1086. 'forward-line
  1087. 'end-of-line
  1088. (lambda ()
  1089. (let (ref
  1090. (ref-field (or (org-favtable--get-field 'ref) ""))
  1091. (count-field (or (org-favtable--get-field 'count) ""))
  1092. (count-special 0))
  1093. ;; get reference with leading zeroes, so it can be
  1094. ;; sorted as text
  1095. (string-match org-favtable--ref-regex ref-field)
  1096. (setq ref (format
  1097. "%06d"
  1098. (string-to-number
  1099. (or (match-string 1 ref-field)
  1100. "0"))))
  1101. ;; find out, if special token in count-column
  1102. (setq count-special (format "%d"
  1103. (- 2
  1104. (length (member count-field '(":missing:" ":reuse:"))))))
  1105. ;; Construct different sort-keys according to
  1106. ;; requested sort column; prepend count-special to
  1107. ;; sort special entries at bottom of table, append ref
  1108. ;; as a secondary sort key
  1109. (cond
  1110. ((eq sort-column 'count)
  1111. (concat count-special
  1112. (format
  1113. "%08d"
  1114. (string-to-number (or (org-favtable--get-field 'count)
  1115. "")))
  1116. ref))
  1117. ((eq sort-column 'last-accessed)
  1118. (concat count-special
  1119. (org-favtable--get-field 'last-accessed)
  1120. " "
  1121. ref))
  1122. ((eq sort-column 'ref)
  1123. (concat count-special
  1124. ref))
  1125. (t (error "This is a bug: unmatched case '%s'" sort-column)))))
  1126. nil 'string<)))
  1127. ;; align table
  1128. (org-table-align))
  1129. (defun org-favtable--goto-top ()
  1130. ;; go to heading of node
  1131. (while (not (org-at-heading-p)) (forward-line -1))
  1132. (forward-line 1)
  1133. ;; go to table within node, but make sure we do not get into another node
  1134. (while (and (not (org-at-heading-p))
  1135. (not (org-at-table-p))
  1136. (not (eq (point) (point-max))))
  1137. (forward-line 1))
  1138. ;; check, if there really is a table
  1139. (unless (org-at-table-p)
  1140. (org-favtable--report-setup-error
  1141. (format "Cannot find favtable within node %s" org-favtable-id) t))
  1142. ;; go to first hline
  1143. (while (and (not (org-at-table-hline-p))
  1144. (org-at-table-p))
  1145. (forward-line 1))
  1146. ;; and check
  1147. (unless (org-at-table-hline-p)
  1148. (org-favtable--report-setup-error
  1149. "Cannot find hline within table of favorites" t))
  1150. (forward-line 1)
  1151. (org-table-goto-column 1))
  1152. (defun org-favtable--id-find ()
  1153. "Find org-favtable-id"
  1154. (let ((marker (org-id-find org-favtable-id 'marker))
  1155. marker-and-buffer)
  1156. (if marker
  1157. (progn
  1158. (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker)))
  1159. (move-marker marker nil)
  1160. marker-and-buffer)
  1161. nil)))
  1162. (defun org-favtable--parse-headings (numcols)
  1163. (let (columns)
  1164. ;; Associate names of special columns with column-numbers
  1165. (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0)
  1166. (count . 0) (sort . nil) (copy . nil))))
  1167. ;; For each column
  1168. (dotimes (col numcols)
  1169. (let* (field-flags ;; raw heading, consisting of file name and maybe
  1170. ;; flags (seperated by ";")
  1171. field ;; field name only
  1172. field-symbol ;; and as a symbol
  1173. flags ;; flags from field-flags
  1174. found)
  1175. ;; parse field-flags into field and flags
  1176. (setq field-flags (org-trim (org-table-get-field (+ col 1))))
  1177. (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
  1178. (progn
  1179. (setq field (downcase (or (match-string 1 field-flags) "")))
  1180. ;; get flags as list of characters
  1181. (setq flags (mapcar 'string-to-char
  1182. (split-string
  1183. (downcase (match-string 2 field-flags))
  1184. "" t))))
  1185. ;; no flags
  1186. (setq field field-flags))
  1187. (unless (string= field "") (setq field-symbol (intern (downcase field))))
  1188. ;; Check, that no flags appear twice
  1189. (mapc (lambda (x)
  1190. (when (memq (car x) flags)
  1191. (if (cdr (assoc (cdr x) columns))
  1192. (org-favtable--report-setup-error
  1193. (format "More than one heading is marked with flag '%c'" (car x)) t))))
  1194. '((?s . sort)
  1195. (?c . copy)))
  1196. ;; Process flags
  1197. (if (memq ?s flags)
  1198. (setcdr (assoc 'sort columns) field-symbol))
  1199. (if (memq ?c flags)
  1200. (setcdr (assoc 'copy columns) (+ col 1)))
  1201. ;; Store columns in alist
  1202. (setq found (assoc field-symbol columns))
  1203. (when found
  1204. (if (> (cdr found) 0)
  1205. (org-favtable--report-setup-error
  1206. (format "'%s' appears two times as column heading" (downcase field)) t))
  1207. (setcdr found (+ col 1)))))
  1208. ;; check if all necessary informations have been specified
  1209. (mapc (lambda (col)
  1210. (unless (> (cdr (assoc col columns)) 0)
  1211. (org-favtable--report-setup-error
  1212. (format "column '%s' has not been set" col) t)))
  1213. '(ref link count created last-accessed))
  1214. ;; use ref as a default sort-column
  1215. (unless (cdr (assoc 'sort columns))
  1216. (setcdr (assoc 'sort columns) 'ref))
  1217. columns))
  1218. (defun org-favtable--report-setup-error (text &optional switch-to-node)
  1219. (when switch-to-node
  1220. (org-id-goto org-favtable-id)
  1221. (delete-other-windows))
  1222. (when (y-or-n-p (concat
  1223. text
  1224. ";\n"
  1225. "the correct setup is explained in the documentation of 'org-favtable-id'.\n"
  1226. "Do you want to read it ? "))
  1227. (org-favtable--show-help 'org-favtable-id))
  1228. (error "")
  1229. (setq org-favtable--last-action 'leave))
  1230. (defun org-favtable--show-help (function-or-variable)
  1231. (let ((isfun (functionp function-or-variable)))
  1232. ;; bring up help-buffer for function or variable
  1233. (if isfun
  1234. (describe-function function-or-variable)
  1235. (describe-variable function-or-variable))
  1236. ;; clean up help-buffer
  1237. (pop-to-buffer "*Help*")
  1238. (let ((inhibit-read-only t))
  1239. (goto-char (point-min))
  1240. (while (progn
  1241. (kill-line 1)
  1242. (not (looking-at
  1243. (if isfun
  1244. "("
  1245. "Documentation:")))))
  1246. (kill-line (if isfun 2 3))
  1247. (goto-char (point-max))
  1248. (kill-line -2)
  1249. (goto-char (point-min)))))
  1250. (defun org-favtable--update-line (ref-or-link)
  1251. (let (initial
  1252. found
  1253. count-field
  1254. (ref-node-buffer-and-point (org-favtable--id-find)))
  1255. (with-current-buffer (car ref-node-buffer-and-point)
  1256. ;; search reference or link, if given (or assume, that we are already positioned right)
  1257. (when ref-or-link
  1258. (setq initial (point))
  1259. (goto-char (cdr ref-node-buffer-and-point))
  1260. (org-favtable--goto-top)
  1261. (while (and (org-at-table-p)
  1262. (not (or (string= ref-or-link (org-favtable--get-field 'ref))
  1263. (string= ref-or-link (org-favtable--get-field 'link)))))
  1264. (forward-line)))
  1265. (if (not (org-at-table-p))
  1266. (error "Did not find reference or link '%s'" ref-or-link)
  1267. (setq count-field (org-favtable--get-field 'count))
  1268. ;; update count field only if number or empty; leave :missing: and :reuse: as is
  1269. (if (or (not count-field)
  1270. (string-match "^[0-9]+$" count-field))
  1271. (org-favtable--get-field 'count
  1272. (number-to-string
  1273. (+ 1 (string-to-number (or count-field "0"))))))
  1274. ;; update timestamp
  1275. (org-table-goto-column (org-favtable--column-num 'last-accessed))
  1276. (org-table-blank-field)
  1277. (org-insert-time-stamp nil t t)
  1278. (setq found t))
  1279. (if initial (goto-char initial))
  1280. found)))
  1281. (defun org-favtable--occur-helper (action)
  1282. (let ((line-beg (line-beginning-position))
  1283. key search link ref)
  1284. ;; extract reference or link from text property (as put there before)
  1285. (setq ref (get-text-property line-beg 'org-favtable--ref))
  1286. (if (string= ref "") (setq ref nil))
  1287. (setq link (get-text-property line-beg 'org-favtable--link))
  1288. (if (string= link "") (setq link nil))
  1289. (org-favtable action
  1290. (or link ref) ;; prefer link
  1291. (if link t nil))))
  1292. (defun org-favtable--get-field (key &optional value)
  1293. (let (field)
  1294. (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value)))
  1295. (if (string= field "") (setq field nil))
  1296. field))
  1297. (defun org-favtable--column-num (key)
  1298. (cdr (assoc key org-favtable--columns)))
  1299. (defun org-favtable-version ()
  1300. "Show version of org-favtable" (interactive)
  1301. (message "org-favtable %s" org-favtable--version))
  1302. (defun org-favtable--make-guarded-search (ref &optional dont-quote)
  1303. (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b"))
  1304. (defun org-favtable-get-ref-regex-format ()
  1305. "return cons-cell with regular expression and format for references"
  1306. (unless org-favtable--ref-regex
  1307. (org-favtable 'parse))
  1308. (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format))
  1309. (defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate)
  1310. "Make text from the favtable available for yank."
  1311. (when org-favtable--text-to-yank
  1312. (kill-new org-favtable--text-to-yank)
  1313. (message (format "Ready to yank '%s'" org-favtable--text-to-yank))
  1314. (setq org-favtable--text-to-yank nil)))
  1315. (provide 'org-favtable)
  1316. ;; Local Variables:
  1317. ;; fill-column: 75
  1318. ;; comment-column: 50
  1319. ;; End:
  1320. ;;; org-favtable.el ends here