org-favtable.el 60 KB

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