12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703 |
- (require 'org-table)
- (require 'cl)
- (defvar org-favtable--version "2.2.0")
- (defvar org-favtable--preferred-command nil)
- (defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics)
- "List of commands known to org-favtable:
- Commands known:
- occur: If you supply a keyword (text): Apply emacs standard
- occur operation on the table of favorites; ask for a
- string (keyword) to select lines. Occur will only show you
- lines which contain the given keyword, so you can easily find
- the right one. You may supply a list of words seperated by
- comma (\",\"), to select lines that contain any or all of the
- given words.
- If you supply a reference number: Apply emacs standard
- multi-occur operation all org-mode buffers to search for a
- specific reference.
- You may also read the note at the end of this help on saving
- the keystroke RET to accept this frequent default command.
- head: If invoked outside the table of favorites, ask for a
- reference number and search for a heading containing it. If
- invoked within favtable dont ask; rather use the reference or
- link from the current line.
- ref: Create a new reference, copy any previously selected text.
- If already within reftable, fill in ref-column.
- link: Create a new line in reftable with a link to the current node.
- Do not populate the ref column; this can later be populated by
- calling the \"fill\" command from within the reftable.
- leave: Leave the table of favorites. If the last command has
- been \"ref\", the new reference is copied and ready to yank.
- This \"org-mark-ring-goto\" and can be called several times
- in succession.
- enter: Just enter the node with the table of favorites.
- goto: Search for a specific reference within the table of
- favorites.
- help: Show this list of commands.
- +: Show all commands including the less frequently used ones
- given below. If \"+\" is followd by enough letters of such a
- command (e.g. \"+fi\"), then this command is invoked
- directly.
- reorder: Temporarily reorder the table of favorites, e.g. by
- count, reference or last access.
- fill: If either ref or link is missing, fill it.
- sort: Sort a set of lines (either the active region or the
- whole buffer) by the references found in each line.
- update: For the given reference, update the line in the
- favtable.
- highlight: Highlight references in region or buffer.
- unhighlight: Remove highlights.
- missing : Search for missing reference numbers (which do not
- appear in the reference table). If requested, add additional
- lines for them, so that the command \"new\" is able to reuse
- them.
- statistics : Show some statistics (e.g. minimum and maximum
- reference) about favtable.
- Two ways to save keystrokes:
- When prompting for a command, org-favtable puts the most likely
- one (e.g. \"occur\" or \"ref\") at the front of the list, so that
- you may just type RET.
- If this command needs additional input (like e.g. \"occur\"), you
- may supply this input right away, although you are still beeing
- prompted for the command. So do an occur for the string \"foo\",
- you can just enter \"foo\" without even entering \"occur\".
- Another way to save keystrokes applies if you want to choose a
- command, that requrires a reference number (and would normally
- prompt for it): In that case you may just enter enough characters
- from your command, so that it appears first in the list of
- matches; then immediately enter the number of the reference you
- are searching for. So the input \"h237\" would execute the
- command \"head\" for reference \"237\" right away.
- ")
- (defvar org-favtable--commands-some '(occur head ref link leave enter goto + help))
- (defvar org-favtable--columns nil)
- (defvar org-favtable-id nil
- "Id of the Org-mode node, which contains the favorite table.
- Read below, on how to set up things. See the help options
- \"usage\" and \"commands\" for normal usage after setup.
- Setup requires two steps:
- - Adjust your .emacs initialization file
- - Create a suitable org-mode node
- Here are the lines, you need to add to your .emacs:
- (require 'org-favtable)
- ;; Good enough to start, but later you should probably
- ;; change this id, as will be explained below
- (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\")
- ;; Optionally assign a key. Pick your own favorite.
- (global-set-key (kbd \"C-+\") 'org-favtable)
- Do not forget to restart emacs to make these lines effective.
- As a second step you need to create the org-mode node, where your
- reference numbers and links will be stored. It may look like
- this:
- * org-favtable
- :PROPERTIES:
- :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4
- :END:
- | | | Comment, description, details | | | |
- | ref | link | ;c | count;s | created | last-accessed |
- | | <4> | <30> | | | |
- |-----+------+--------------------------------+---------+---------+---------------|
- | R1 | | My first reference | | | |
- You may just copy this node into one of your org-files. Many
- things however can or should be adjusted:
- - The node needs not be a top level node.
- - Its name is completely at you choice. The node is found
- through its ID.
- - There are three lines of headings above the first hline. The
- first one is ignored by org-favtable, and you can use them to
- give meaningful names to columns; the second line contains
- configuration information for org-favtable; please read
- further below for its format. The third line is optional and
- may contain width-informations (e.g. <30>) only.
- - The sequence of columns does not matter. You may reorder them
- any way you like; e.g. make the comment-column the last
- columns within the table. Columns ar found by their name,
- which appears in the second heading-line.
- - You can add further columns or even remove the
- \"Comment\"-column. All other columns from the
- example (e.g. \"ref\", \"link\", \"count\", \"created\" and
- \"last-accessed\") are required.
- - Your references need not start at \"R1\"; However, having an
- initial row is required (it serves as a template for subsequent
- references).
- - Your reference need not have the form \"R1\"; you may just as
- well choose any text, that contains a single number,
- e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The
- function `org-favtable' will inspect your first reference and
- create all subsequent references in the same way.
- - You may want to change the ID-Property of the node above and
- create a new one, which is unique (and not just a copy of
- mine). You need to change it in the lines copied to your .emacs
- too. However, this is not strictly required to make things
- work, so you may do this later, after trying out this package.
- Optionally you may tweak the second header line to adjust
- `org-favtable' a bit. In the example above it looks like this
- (with spaces collapsed):
- | ref | link | ;c | count;s | created | last-accessed |
- The different fields have different meanings:
- - ref : This denotes the column which contains you references
- - link : Column for org-mode links, which can be used to access
- locations within your files.
- - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column
- as the one beeing copied on command \"leave\". In the example
- above, it is also the comment-column.
- - count;s : this is the column which counts, how many time this
- line has been accessed (which is the key-feature of this
- package). The flag \"s\" stands for \"sort\", so the table is
- sorted after this column. You may also sort after columns
- \"ref\" or \"last-accessed\".
- - created : Date when this line was created.
- - last-accessed : Date and time, when this line was last accessed.
- After this two-step setup process you may invoke `org-favtable'
- to create a new favorite. Read the help option \"usage\" for
- instructions on normal usage, read the help option \"commands\"
- for help on single commands.
- ")
- (defvar org-favtable--text-to-yank nil)
- (defvar org-favtable--last-action nil)
- (defvar org-favtable--occur-buffer nil)
- (defvar org-favtable--ref-regex nil)
- (defvar org-favtable--ref-format nil)
- (defun org-favtable (&optional what search search-is-link)
- "Mark and find your favorite items and org-locations easily:
- Create and update a lookup table of your favorite references and
- links. Often used entries automatically bubble to the top of the
- table; entering some keywords narrows it to just the matching
- entries; that way the right one can be picked easily.
- References are essentially small numbers (e.g. \"R237\" or
- \"-455-\"), as created by this package; links are normal org-mode
- links. Within org-favtable, both are denoted as favorites.
- Read below for a detailed description of this function. See the
- help option \"setup\" or read the documentation of
- `org-favtable-id' for setup instructions.
- The function `org-favtable' operates on a dedicated table (called
- the table or favorites or favtable, for short) within a special
- Org-mode node. The node has to be created as part of your initial
- setup. Each line of the favorite table contains:
- - A reference (optional)
- - A link (optional)
- - A number; counting, how often each reference has been
- used. This number is updated automatically and the table can
- be sorted according to it, so that most frequently used
- references appear at the top of the table and can be spotted
- easily.
- - Its respective creation date
- - Date and time of last access. This column can alternatively be
- used to sort the table.
- To be useful, your table of favorites should probably contain a
- column with comments too, which allows lines to be selected by
- keywords.
- The table of favorites is found through the id of the containing
- node; this id should be stored within `org-favtable-id' (see there
- for details).
- The function `org-favtable' is the only interactive function of
- this package and its sole entry point; it offers several commands
- to create, find and look up these favorites (references and
- links). All of them are explained within org-favtable's help.
- Finally, org-favtable can also be invoked from elisp; the two
- optional arguments accepted are:
- search : string to search for
- what : symbol of the command to invoke
- search-is-link : t, if argument search is actually a link
- An example would be:
- (org-favtable \"237\" 'head) ;; find heading with ref 237
- "
- (interactive "P")
- (let (within-node
- result-is-visible
- ref-node-buffer-and-point
- below-cursor
- active-region
- link-id
- guarded-search
- search-is-ref
- commands
- what-adjusted
- what-input
- reorder-once
- parts
-
- head
- maxref
- tail
- ref-regex
- has-reuse
- numcols
- kill-new-text
- message-text
-
- initial-ref-or-link
- )
-
-
-
-
- (if (and transient-mark-mode
- mark-active)
- (setq active-region (buffer-substring (region-beginning) (region-end))))
- (setq below-cursor (thing-at-point 'symbol))
-
- (setq within-node (string= (org-id-get) org-favtable-id))
-
- (mapc (lambda (x) (with-current-buffer (window-buffer x)
- (when (or
- (string= (org-id-get) org-favtable-id)
- (eq (window-buffer x)
- org-favtable--occur-buffer))
- (setq result-is-visible t))))
- (window-list))
-
-
-
-
- (if (and within-node
- (org-at-table-p))
- (setq initial-ref-or-link
- (or (org-favtable--get-field 'ref)
- (org-favtable--get-field 'link))))
-
- (setq ref-node-buffer-and-point (org-favtable--id-find))
- (unless ref-node-buffer-and-point
- (org-favtable--report-setup-error
- (format "Cannot find node with id \"%s\"" org-favtable-id)))
-
- (let ((error-message
- (catch 'content-error
- (with-current-buffer (car ref-node-buffer-and-point)
- (save-excursion
- (unless (string= (org-id-get) org-favtable-id)
- (goto-char (cdr ref-node-buffer-and-point)))
-
- (setq parts (org-favtable--parse-and-adjust-table)))
- nil))))
- (when error-message
- (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
- (org-reveal)
- (error error-message)))
-
- (setq head (nth 0 parts))
- (setq maxref (nth 1 parts))
- (setq tail (nth 2 parts))
- (setq numcols (nth 3 parts))
- (setq ref-regex (nth 4 parts))
- (setq has-reuse (nth 5 parts))
- (setq org-favtable--ref-regex ref-regex)
- (setq org-favtable--ref-format (concat head "%d" tail))
-
-
-
- (if (equal what '(4)) (setq what 'leave))
-
- (setq org-favtable--preferred-command
- (if within-node
- (if (memq org-favtable--last-action '(ref link))
- 'leave
- 'occur)
- (if active-region
- 'ref
- (if (and below-cursor (string-match ref-regex below-cursor))
- 'occur
- nil))))
-
- (unless what
- (setq commands (copy-list org-favtable--commands-some))
- (while (progn
- (setq what-input
- (org-icompleting-read
- "Please choose: "
- (mapcar 'symbol-name
-
-
- (delq nil (delete-dups
- (append
- (list org-favtable--preferred-command)
- commands))))
- nil nil))
-
-
- (when (string= (substring what-input 0 1) "+")
-
- (setq commands (copy-list org-favtable--commands))
- (unless (string= what-input "+")
-
- (setq what-input (substring what-input 1))
- (let ((completions
-
- (all-completions what-input (mapcar 'symbol-name commands))))
-
- (if (= (length completions) 1)
- (setq what-input (car completions))))))
-
-
- (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input)
-
- (setq org-favtable--preferred-command
- (intern (first (all-completions (match-string 1 what-input)
- (mapcar 'symbol-name commands)))))
-
- (setq what-input (format org-favtable--ref-format
- (string-to-number (match-string 2 what-input)))))
- (setq what (intern what-input))
-
-
-
- (if (memq what commands)
-
-
- (setq what-input nil)
-
-
- (setq what (or org-favtable--preferred-command
- (first commands)))
-
-
- (if (equal (substring what-input -1) ".")
-
-
- (let ((shortened-what-input (substring what-input 0 -1)))
- (unless (test-completion shortened-what-input
- (mapcar 'symbol-name
- commands))
- (setq what-input shortened-what-input)))))
-
-
- (if (eq what 'reorder)
- (setq reorder-once
- (intern
- (org-icompleting-read
- "Please choose column to reorder reftable once: "
- (mapcar 'symbol-name '(ref count last-accessed))
- nil t))))
-
- (memq what '(reorder +)))))
-
-
-
-
- (when (memq what '(goto occur head update))
-
- (unless search
- (let (search-from-table
- search-from-cursor)
-
-
- (when within-node
- (setq search-from-table (org-favtable--get-field 'ref)))
-
- (when (and (not within-node)
- below-cursor
- (string-match (concat "\\(" ref-regex "\\)")
- below-cursor))
- (setq search-from-cursor (match-string 1 below-cursor)))
-
- (cond ((eq what 'goto)
- (setq search (or what-input search-from-cursor)))
- ((memq what '(head occur))
- (setq search (or what-input search-from-table search-from-cursor))))))
-
- (unless search
- (if what-input
- (setq search what-input)
- (setq search (read-from-minibuffer
- (cond ((memq what '(occur head))
- "Text or reference number to search for: ")
- ((eq what 'goto)
- "Reference number to search for, or enter \".\" for id of current node: ")
- ((eq what 'update)
- "Reference number to update: ")))))
- (if (string-match "^\\s *[0-9]+\\s *$" search)
- (setq search (format "%s%s%s" head (org-trim search) tail))))
-
- (if search (setq search (org-trim search)))
- (if (string= search "") (setq search nil))
- (setq search-is-ref (string-match ref-regex search))
-
- (when (and (memq what '(head goto))
- (string= search "."))
- (setq search (org-id-get))
- (setq search-is-link t))
- (when search-is-ref
- (setq guarded-search (org-favtable--make-guarded-search search)))
-
-
-
-
- (when (and (not search)
- (memq what '(search occur head)))
- (setq what 'enter)
- (setq what-adjusted t))
-
- (if (and (string-match ref-regex search)
- (eq what 'occur))
- (setq what 'multi-occur))
-
- (when (and (memq what '(head goto))
- (not search-is-link)
- (not search-is-ref))
- (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)))
-
-
-
-
- (if (eq what 'link)
- (setq link-id (org-id-get-create)))
-
- (when (memq what '(enter ref link goto occur multi-occur missing statistics))
-
- (org-mark-ring-push)
-
- (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
- (goto-char (cdr ref-node-buffer-and-point))
- (show-subtree)
- (org-show-context)
-
- (org-favtable--sort-table reorder-once))
-
-
- (when initial-ref-or-link
- (while (and (org-at-table-p)
- (not (or
- (string= initial-ref-or-link (org-favtable--get-field 'ref))
- (string= initial-ref-or-link (org-favtable--get-field 'link)))))
- (forward-line))
-
- (if (not (org-at-table-p)) (goto-char top)))
-
-
-
- (cond
- ((eq what 'help)
- (let ((help-what
-
- (intern
- (concat
- "help-"
- (org-icompleting-read
- "Help on: "
- (mapcar 'symbol-name '(commands usage setup version example))
- nil t)))))
-
- (cond ((eq help-what 'help-commands)
- (org-favtable--show-help 'org-favtable--commands))
- ((eq help-what 'help-usage)
- (org-favtable--show-help 'org-favtable))
- ((eq help-what 'help-setup)
- (org-favtable--show-help 'org-favtable-id))
- ((eq help-what 'help-version)
- (org-favtable-version)))))
- ((eq what 'multi-occur)
-
- (org-favtable--goto-top)
- (let (found (initial (point)))
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found (string= search
- (org-favtable--get-field 'ref)))))
- (if found
- (org-favtable--update-line nil)
- (goto-char initial)))
-
- (let (buff org-buffers)
- (dolist (buff (buffer-list))
- (set-buffer buff)
- (if (string= major-mode "org-mode")
- (setq org-buffers (cons buff org-buffers))))
-
- (multi-occur org-buffers guarded-search)
- (if (get-buffer "*Occur*")
- (progn
- (setq message-text (format "multi-occur for '%s'" search))
- (setq org-favtable--occur-buffer (get-buffer "*Occur*"))
- (other-window 1)
- (toggle-truncate-lines 1))
- (setq message-text (format "Did not find '%s'" search)))))
- ((eq what 'head)
- (let (link)
-
-
- (if search-is-link
- (setq link (org-trim search))
- (if (and within-node
- (org-at-table-p))
- (setq link (org-favtable--get-field 'link))))
-
- (if (and link
- (not (string= link "")))
- (progn
- (org-id-goto link)
- (org-favtable--update-line search)
- (setq message-text "Followed link"))
- (message (format "Scanning headlines for '%s' ..." search))
- (let (buffer point)
- (if (catch 'found
- (progn
-
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
-
- (setq buffer (current-buffer))
- (setq point (point))
- (throw 'found t)))
- nil 'agenda)
- nil))
- (progn
- (org-favtable--update-line search)
- (setq message-text (format "Found '%s'" search))
- (org-pop-to-buffer-same-window buffer)
- (goto-char point)
- (org-reveal))
- (setq message-text (format "Did not find '%s'" search)))))))
- ((eq what 'leave)
- (when result-is-visible
-
- (if (and (string= (buffer-name) "*Occur*")
- (eq org-favtable--last-action 'occur))
- (occur-mode-goto-occurrence)))
- (setq kill-new-text org-favtable--text-to-yank)
- (setq org-favtable--text-to-yank nil)
-
-
- (if (eq org-favtable--last-action 'leave)
- (let ((this-command nil) (last-command nil))
- (org-mark-ring-goto 1))
- (org-mark-ring-goto 0)))
- ((eq what 'goto)
-
- (let (found (initial (point)))
- (org-favtable--goto-top)
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found
- (string= search
- (org-favtable--get-field
- (if search-is-link 'link 'ref))))))
- (if found
- (progn
- (setq message-text (format "Found '%s'" search))
- (org-favtable--update-line nil)
- (org-table-goto-column (org-favtable--column-num 'ref))
- (if (looking-back " ") (backward-char))
-
- (setq org-favtable--text-to-yank
- (org-trim (org-table-get-field (org-favtable--column-num 'copy)))))
- (setq message-text (format "Did not find '%s'" search))
- (goto-char initial)
- (forward-line)
- (setq what 'missed))))
- ((eq what 'occur)
-
- (let (search-regexp
- all-or-any
- (search-words (split-string search "," t)))
- (if (< (length search-words) 2)
-
- (setq search-regexp search)
-
- (setq search-regexp
- (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|"))
- (setq all-or-any
- (intern
- (org-icompleting-read
- "Two or more words have been specified; show lines, that match: " '("all" "any")))))
- (save-restriction
- (org-narrow-to-subtree)
- (occur search-regexp)
- (widen)
- (if (get-buffer "*Occur*")
- (with-current-buffer "*Occur*"
-
- (let ((keymap (make-sparse-keymap)))
- (set-keymap-parent keymap occur-mode-map)
- (define-key keymap (kbd "RET")
- (lambda () (interactive)
- (org-favtable--occur-helper 'head)))
- (define-key keymap (kbd "<C-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'multi-occur)))
- (define-key keymap (kbd "<M-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'goto)))
- (define-key keymap (kbd "<C-M-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'update)))
- (use-local-map keymap))
-
- (other-window 1)
- (toggle-truncate-lines 1)
- (let ((inhibit-read-only t))
-
- (insert (substitute-command-keys
- "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"))
- (forward-line 1)
-
- (when (eq all-or-any 'all)
- (mapc (lambda (x) (keep-lines x)) search-words))
-
- (when all-or-any
- (forward-line -1)
- (kill-line)
- (let ((count (- (count-lines (point) (point-max)) 1)))
- (insert (format "%d %s for %s of %s"
- count
- (if (= count 1) "match" "matches")
- all-or-any
- search)))
- (forward-line)
- (beginning-of-line))
-
-
-
-
- (save-excursion
- (while (not (eq (point) (point-max)))
- (let ((beg (line-beginning-position))
- (end (line-end-position))
- pos ref link)
-
- (setq pos (get-text-property (point) 'occur-target))
- (when pos
-
- (with-current-buffer (marker-buffer pos)
- (goto-char pos)
- (setq ref (org-favtable--get-field 'ref))
- (setq link (org-favtable--get-field 'link))))
-
- (put-text-property beg end 'org-favtable--ref ref)
- (put-text-property beg end 'org-favtable--link link))
- (forward-line))))
- (setq message-text
- (format "Occur for '%s'" search)))
- (setq message-text
- (format "Did not find any matches for '%s'" search))))))
- ((memq what '(ref link))
-
- (let (new)
- (when (eq what 'ref)
-
- (when has-reuse
- (org-favtable--goto-top)
-
- (while (and (org-at-table-p)
- (not new))
- (when (string=
- (org-favtable--get-field 'count)
- ":reuse:")
- (setq new (org-favtable--get-field 'ref))
- (if new (org-table-kill-row)))
- (forward-line)))
-
- (unless new
- (setq new (format "%s%d%s" head (1+ maxref) tail)))
-
- (setq org-favtable--text-to-yank new))
-
- (org-favtable--goto-top)
- (org-table-insert-row)
-
- (when (eq what 'ref)
- (org-table-goto-column (org-favtable--column-num 'ref))
- (insert new))
- (when (eq what 'link)
- (org-table-goto-column (org-favtable--column-num 'link))
- (insert link-id))
- (org-table-goto-column (org-favtable--column-num 'created))
- (org-insert-time-stamp nil nil t)
-
- (unless (catch 'empty
- (dotimes (col numcols)
- (org-table-goto-column (+ col 1))
- (if (string= (org-trim (org-table-get-field)) "")
- (throw 'empty t))))
-
- (org-table-goto-column 1))
- (org-table-align)
- (if active-region (setq kill-new-text active-region))
- (if (eq what 'ref)
- (setq message-text (format "Adding a new row with ref '%s'" new))
- (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
- ((eq what 'enter)
-
- (org-favtable--goto-top)
- (show-subtree)
- (recenter)
- (if what-adjusted
- (setq message-text "Nothing to search for; at favtable")
- (setq message-text "At favtable")))
- ((eq what 'fill)
-
- (unless (and within-node
- (org-at-table-p))
- (error "Not within table of favorites"))
-
- (let ((ref (org-favtable--get-field 'ref))
- (link (org-favtable--get-field 'link)))
- (if (and (not ref)
- (not link))
-
- (error "Columns ref and link are both empty in this line"))
-
- (if (not ref)
- (progn
- (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail))
- (org-favtable--get-field 'ref kill-new-text)
-
- (setq org-favtable--text-to-yank kill-new-text)
- (org-id-goto link)
- (setq message-text "Filled reftable field with new reference"))
-
- (if (not link)
- (progn
- (setq guarded-search (org-favtable--make-guarded-search ref))
- (message (format "Scanning headlines for '%s' ..." ref))
- (let (link)
- (if (catch 'found
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
- (setq link (org-id-get-create))
- (throw 'found t)))
- nil 'agenda)
- nil)
- (progn
- (org-favtable--get-field 'link link)
- (setq message-text "Inserted link"))
- (setq message-text (format "Did not find reference '%s'" ref)))))
-
- (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do")))))
- ((eq what 'sort)
-
- (let (begin end where)
- (catch 'aborted
-
- (if (and transient-mark-mode
- mark-active)
-
- (progn
- (setq begin (region-beginning))
- (setq end (region-end))
- (setq where "region"))
-
- (setq begin (point-min))
- (setq end (point-max))
- (setq where "whole buffer")
-
- (unless (y-or-n-p "Sort whole buffer ")
- (setq message-text "Sort aborted")
- (throw 'aborted nil)))
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region begin end)
- (sort-subr nil 'forward-line 'end-of-line
- (lambda ()
- (if (looking-at (concat ".*"
- (org-favtable--make-guarded-search ref-regex 'dont-quote)))
- (string-to-number (match-string 1))
- 0))))
- (highlight-regexp ref-regex)
- (setq message-text (format "Sorted %s from character %d to %d, %d lines"
- where begin end
- (count-lines begin end)))))))
- ((eq what 'update)
-
- (save-excursion
- (let ((ref-or-link (if search-is-link "link" "reference")))
- (beginning-of-line)
- (if (org-favtable--update-line search)
- (setq message-text (format "Updated %s '%s'" ref-or-link search))
- (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
- ((eq what 'parse)
-
- )
- ((memq what '(highlight unhighlight))
- (let ((where "buffer"))
- (save-excursion
- (save-restriction
- (when (and transient-mark-mode
- mark-active)
- (narrow-to-region (region-beginning) (region-end))
- (setq where "region"))
- (if (eq what 'highlight)
- (progn
- (highlight-regexp ref-regex)
- (setq message-text (format "Highlighted references in %s" where)))
- (unhighlight-regexp ref-regex)
- (setq message-text (format "Removed highlights for references in %s" where)))))))
- ((memq what '(missing statistics))
- (org-favtable--goto-top)
- (let (missing
- ref-field
- ref
- min
- max
- (total 0))
-
- (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail))
- (number-sequence 1 maxref)))
-
- (while (and (forward-line)
- (org-at-table-p))
-
- (setq ref-field (org-favtable--get-field 'ref))
- (if (and ref-field
- (string-match ref-regex ref-field))
- (setq ref (string-to-number (match-string 1 ref-field))))
-
- (if ref-field (setq missing (delete ref-field missing)))
-
- (if (or (not min) (< ref min)) (setq min ref))
- (if (or (not max) (> ref max)) (setq max ref))
-
- (setq total (1+ total)))
-
- (forward-line -1)
- (if (eq what 'statistics)
- (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
- total
- (format org-favtable--format min)
- (format org-favtable--format max)
- (length missing)))
- (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites"
- (length missing)))
- (let (type)
- (setq type (org-icompleting-read
- "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
- (mapc (lambda (x)
- (let (org-table-may-need-update) (org-table-insert-row t))
- (org-favtable--get-field 'ref x)
- (org-favtable--get-field 'count (format ":%s:" type)))
- missing)
- (org-table-align)
- (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
- (setq message-text (format "%d missing references." (length missing)))))))
- (t (error "This is a bug: unmatched case '%s'" what)))
-
- (setq org-favtable--last-action what)
-
- (if kill-new-text (setq kill-new-text
- (substring-no-properties kill-new-text)))
- (if (string= kill-new-text "") (setq kill-new-text nil))
- (let ((m (concat
- message-text
- (if (and message-text kill-new-text)
- " and r"
- (if kill-new-text "R" ""))
- (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
- (unless (string= m "") (message m)))
- (if kill-new-text (kill-new kill-new-text))))
- (defun org-favtable--parse-and-adjust-table ()
- (let ((maxref 0)
- top
- bottom
- ref-field
- link-field
- parts
- numcols
- head
- tail
- ref-regex
- has-reuse
- initial-point)
- (setq initial-point (point))
- (org-favtable--goto-top)
- (setq top (point))
- (goto-char top)
-
- (org-table-goto-column 100)
- (setq numcols (- (org-table-current-column) 1))
-
- (forward-line -2)
- (unless (org-at-table-p)
- (org-favtable--report-setup-error
- "Table of favorites starts with a hline" t))
-
- (beginning-of-line)
- (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
- (forward-line -1))
- (org-table-goto-column 1)
- (setq org-favtable--columns (org-favtable--parse-headings numcols))
-
- (while (org-at-table-p) (forward-line 1))
-
- (while (progn
- (forward-line -1)
- (org-table-goto-column 1)
- (and
- (not (org-favtable--get-field 'ref))
- (not (org-favtable--get-field 'link))))
- (org-table-kill-row))
- (forward-line)
- (setq bottom (point))
- (forward-line -1)
-
- (goto-char top)
- (while (and (org-at-table-p)
- (not (setq ref-field (org-favtable--get-field 'ref))))
- (forward-line))
-
- (unless ref-field
- (org-favtable--report-setup-error
- "No line of reference column contains a number" t))
- (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
- (org-favtable--report-setup-error
- (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t))
-
- (setq head (match-string 1 ref-field))
- (setq tail (match-string 3 ref-field))
- (setq ref-regex (concat (regexp-quote head)
- "\\([0-9]+\\)"
- (regexp-quote tail)))
-
- (let ((ref 0))
- (while (org-at-table-p)
- (setq ref-field (org-favtable--get-field 'ref))
- (setq link-field (org-favtable--get-field 'link))
- (if (and (not ref-field)
- (not link-field))
- (throw 'content-error "Columns ref and link are both empty in this line"))
- (if ref-field
- (if (string-match ref-regex ref-field)
-
- (setq ref (string-to-number (match-string 1 ref-field)))
- (throw 'content-error "Column ref does not contain a number")))
-
- (if (> ref maxref) (setq maxref ref))
-
- (if (string= (org-favtable--get-field 'count) ":reuse:")
- (setq has-reuse 1))
- (forward-line 1)))
-
- (setq parts (list head maxref tail numcols ref-regex has-reuse))
-
- (goto-char top)
- parts))
- (defun org-favtable--sort-table (sort-column)
- (unless sort-column (setq sort-column (org-favtable--column-num 'sort)))
- (let (top
- bottom
- ref-field
- count-field
- count-special)
-
- (org-favtable--goto-top)
- (forward-line 0)
- (setq top (point))
- (while (org-at-table-p) (forward-line))
- (setq bottom (point))
- (save-restriction
- (narrow-to-region top bottom)
- (goto-char top)
- (sort-subr t
- 'forward-line
- 'end-of-line
- (lambda ()
- (let (ref
- (ref-field (or (org-favtable--get-field 'ref) ""))
- (count-field (or (org-favtable--get-field 'count) ""))
- (count-special 0))
-
-
- (string-match org-favtable--ref-regex ref-field)
- (setq ref (format
- "%06d"
- (string-to-number
- (or (match-string 1 ref-field)
- "0"))))
-
- (setq count-special (format "%d"
- (- 2
- (length (member count-field '(":missing:" ":reuse:"))))))
-
-
-
-
- (cond
- ((eq sort-column 'count)
- (concat count-special
- (format
- "%08d"
- (string-to-number (or (org-favtable--get-field 'count)
- "")))
- ref))
- ((eq sort-column 'last-accessed)
- (concat count-special
- (org-favtable--get-field 'last-accessed)
- " "
- ref))
- ((eq sort-column 'ref)
- (concat count-special
- ref))
- (t (error "This is a bug: unmatched case '%s'" sort-column)))))
- nil 'string<)))
-
- (org-table-align))
- (defun org-favtable--goto-top ()
-
- (while (not (org-at-heading-p)) (forward-line -1))
- (forward-line 1)
-
- (while (and (not (org-at-heading-p))
- (not (org-at-table-p))
- (not (eq (point) (point-max))))
- (forward-line 1))
-
- (unless (org-at-table-p)
- (org-favtable--report-setup-error
- (format "Cannot find favtable within node %s" org-favtable-id) t))
-
- (while (and (not (org-at-table-hline-p))
- (org-at-table-p))
- (forward-line 1))
-
- (unless (org-at-table-hline-p)
- (org-favtable--report-setup-error
- "Cannot find hline within table of favorites" t))
- (forward-line 1)
- (org-table-goto-column 1))
- (defun org-favtable--id-find ()
- "Find org-favtable-id"
- (let ((marker (org-id-find org-favtable-id 'marker))
- marker-and-buffer)
- (if marker
- (progn
- (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker)))
- (move-marker marker nil)
- marker-and-buffer)
- nil)))
- (defun org-favtable--parse-headings (numcols)
- (let (columns)
-
- (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0)
- (count . 0) (sort . nil) (copy . nil))))
-
- (dotimes (col numcols)
- (let* (field-flags
-
- field
- field-symbol
- flags
- found)
-
- (setq field-flags (org-trim (org-table-get-field (+ col 1))))
- (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
- (progn
- (setq field (downcase (or (match-string 1 field-flags) "")))
-
- (setq flags (mapcar 'string-to-char
- (split-string
- (downcase (match-string 2 field-flags))
- "" t))))
-
- (setq field field-flags))
- (unless (string= field "") (setq field-symbol (intern (downcase field))))
-
- (mapc (lambda (x)
- (when (memq (car x) flags)
- (if (cdr (assoc (cdr x) columns))
- (org-favtable--report-setup-error
- (format "More than one heading is marked with flag '%c'" (car x)) t))))
- '((?s . sort)
- (?c . copy)))
-
- (if (memq ?s flags)
- (setcdr (assoc 'sort columns) field-symbol))
- (if (memq ?c flags)
- (setcdr (assoc 'copy columns) (+ col 1)))
-
- (setq found (assoc field-symbol columns))
- (when found
- (if (> (cdr found) 0)
- (org-favtable--report-setup-error
- (format "'%s' appears two times as column heading" (downcase field)) t))
- (setcdr found (+ col 1)))))
-
- (mapc (lambda (col)
- (unless (> (cdr (assoc col columns)) 0)
- (org-favtable--report-setup-error
- (format "column '%s' has not been set" col) t)))
- '(ref link count created last-accessed))
-
- (unless (cdr (assoc 'sort columns))
- (setcdr (assoc 'sort columns) 'ref))
- columns))
- (defun org-favtable--report-setup-error (text &optional switch-to-node)
- (when switch-to-node
- (org-id-goto org-favtable-id)
- (delete-other-windows))
- (when (y-or-n-p (concat
- text
- ";\n"
- "the correct setup is explained in the documentation of 'org-favtable-id'.\n"
- "Do you want to read it ? "))
- (org-favtable--show-help 'org-favtable-id))
- (error "")
- (setq org-favtable--last-action 'leave))
- (defun org-favtable--show-help (function-or-variable)
- (let ((isfun (functionp function-or-variable)))
-
- (if isfun
- (describe-function function-or-variable)
- (describe-variable function-or-variable))
-
- (pop-to-buffer "*Help*")
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (progn
- (kill-line 1)
- (not (looking-at
- (if isfun
- "("
- "Documentation:")))))
- (kill-line (if isfun 2 3))
- (goto-char (point-max))
- (kill-line -2)
- (goto-char (point-min)))))
- (defun org-favtable--update-line (ref-or-link)
- (let (initial
- found
- count-field
- (ref-node-buffer-and-point (org-favtable--id-find)))
- (with-current-buffer (car ref-node-buffer-and-point)
-
- (when ref-or-link
- (setq initial (point))
- (goto-char (cdr ref-node-buffer-and-point))
- (org-favtable--goto-top)
- (while (and (org-at-table-p)
- (not (or (string= ref-or-link (org-favtable--get-field 'ref))
- (string= ref-or-link (org-favtable--get-field 'link)))))
- (forward-line)))
- (if (not (org-at-table-p))
- (error "Did not find reference or link '%s'" ref-or-link)
- (setq count-field (org-favtable--get-field 'count))
-
- (if (or (not count-field)
- (string-match "^[0-9]+$" count-field))
- (org-favtable--get-field 'count
- (number-to-string
- (+ 1 (string-to-number (or count-field "0"))))))
-
- (org-table-goto-column (org-favtable--column-num 'last-accessed))
- (org-table-blank-field)
- (org-insert-time-stamp nil t t)
- (setq found t))
- (if initial (goto-char initial))
- found)))
- (defun org-favtable--occur-helper (action)
- (let ((line-beg (line-beginning-position))
- key search link ref)
-
- (setq ref (get-text-property line-beg 'org-favtable--ref))
- (if (string= ref "") (setq ref nil))
- (setq link (get-text-property line-beg 'org-favtable--link))
- (if (string= link "") (setq link nil))
- (org-favtable action
- (or link ref)
- (if link t nil))))
- (defun org-favtable--get-field (key &optional value)
- (let (field)
- (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value)))
- (if (string= field "") (setq field nil))
- field))
- (defun org-favtable--column-num (key)
- (cdr (assoc key org-favtable--columns)))
- (defun org-favtable-version ()
- "Show version of org-favtable" (interactive)
- (message "org-favtable %s" org-favtable--version))
- (defun org-favtable--make-guarded-search (ref &optional dont-quote)
- (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b"))
- (defun org-favtable-get-ref-regex-format ()
- "return cons-cell with regular expression and format for references"
- (unless org-favtable--ref-regex
- (org-favtable 'parse))
- (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format))
- (defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate)
- "Make text from the favtable available for yank."
- (when org-favtable--text-to-yank
- (kill-new org-favtable--text-to-yank)
- (message (format "Ready to yank '%s'" org-favtable--text-to-yank))
- (setq org-favtable--text-to-yank nil)))
- (provide 'org-favtable)
|