org-favtable.el 62 KB

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