123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217 |
- (require 'org-table)
- (require 'cl)
- (defcustom org-index-id nil
- "Id of the Org-mode node, which contains the index table."
- :group 'org
- :group 'org-index)
- (defvar org-index--maxref)
- (defvar org-index--head)
- (defvar org-index--tail)
- (defvar org-index--numcols)
- (defvar org-index--ref-regex)
- (defvar org-index--has-reuse nil)
- (defvar org-index--ref-format)
- (defvar org-index--columns nil)
- (defvar org-index--special-columns nil)
- (defvar org-index--buffer)
- (defvar org-index--point)
- (defvar org-index--below-hline)
- (defvar org-index--headings)
- (defvar org-index--last-action nil)
- (defvar org-index--text-to-yank nil)
- (defvar org-index--last-ref)
- (defvar org-index--point-before nil)
- (defvar org-index--point-saved nil)
- (defvar org-index--silent nil)
- (defvar org-index--preferred-command)
- (defvar org-index--active-region)
- (defvar org-index--below-cursor)
- (defvar org-index--within-node)
- (defvar org-index--active-window-index nil)
- (defvar org-index--occur-follow-mode nil)
- (setq org-index--commands '(occur head ref link leave put enter goto help + reorder fill sort update multi-occur highlight unhighlight missing statistics))
- (defun org-index (&optional ARG)
- "Mark and find your favorite things and org-locations easily:
- Create and update a lookup table of references and links. Often
- used entries bubble to the top; entering some keywords narrows
- down to matching entries only, so that the right one can be
- spotted easily.
- References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
- which are created by this package; they are well suited to be used
- outside of org. Links are normal org-mode links.
- This is version 2.4.3 of org-index.
- The function `org-index' operates on a dedicated table, the index
- table, which lives within its own Org-mode node. The table and
- its node will be created, when you first invoke org-index.
- Each line in the index table contains:
- - A reference (e.g. \"R237\")
- - An optional link to another location in org
- - A number, counting, how often each reference has been
- used. This number is updated automatically and the table can
- be sorted after it, so that most frequently used references
- appear at the top of the table and can be spotted easily.
- - The creation date of the line
- - Date and time of last access. This column can alternatively be
- used to sort the table.
- - A column for your own comments
- The index table is found through the id of the containing
- node; this id is stored within the variable `org-index-id'.
- The function `org-index' is the only interactive function of this
- package and its main entry point; it offers several commands to
- create, find and look up line within the index table.
- Commands known:
- occur: Incremental search, that shows matching lines from the
- index table, updated after every keystroke. You may enter a
- list of words seperated by space or comma (\",\"), to select
- lines that contain all of the given words.
- You may also read the note at the end of this help on saving
- the keystroke RET with this frequent default command.
- head: If invoked outside the index table, ask for a reference
- number and search for an entry, which either has this
- reference contained in its heading or within its property
- org-index-ref. If invoked from within the index table 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 index table, fill in ref-column.
- link: Create a new line in index table 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
- index table.
- leave: Leave the index table. 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. If you invoke org-index with a prefix argument,
- this command \"leave\" is executed without further questions.
- put: Put the reference, that was created last, as the value of
- property org-index-ref into the current node. That way it can
- be found by a later call to \"head\".
- enter: Just enter the node with the index table.
- goto: Enter index table and go to a specific reference.
- help: Show this text.
- +: 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 (e.g. \"fill\") is
- invoked directly.
- reorder: Temporarily reorder the index table, e.g. by count,
- reference or last access.
- fill: If either ref or link is missing in current line of index
- table, fill in the missing value.
- sort: Sort a set of lines (either from the active region or the
- whole buffer) by references found in each line.
- update: For the given reference, update the line in the
- index table, i.e. increment its count.
- multi-occur: Apply emacs standard multi-occur operation on all
- org-mode buffers to search for the given reference.
- highlight: Highlight references in active region or buffer.
- unhighlight: Remove those 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 \"ref\" is able to reuse
- them.
- statistics : Show some statistics (e.g. minimum and maximum
- reference) about index table.
- Two ways to save keystrokes:
- When prompting for a command, org-index puts the most likely
- one (e.g. \"occur\" or \"ref\") in front of the list, so that
- you may just type RET.
- If this first command in the list of commands needs additional
- input (like e.g. \"occur\"), you may supply this input right
- away, although you are still beeing prompted for the command. So,
- to do an occur for the string \"foo\", you can just enter \"foo\"
- RET, without even typing \"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\".
- "
- (interactive "P")
- (let ((org-index--silent nil)
- link-id
- what
- search
- guarded-search
- search-ref
- search-link
- what-adjusted
- what-input
- reorder-once
- kill-new-text
- message-text
- initial-ref-or-link
- )
-
-
-
-
- (org-index--verify-id)
-
- (org-index--retrieve-context)
-
- (org-index--parse-table)
-
-
-
- (if ARG
- (if (equal ARG '(4))
- (setq what 'leave)
- (if (and (symbolp ARG)
- (memq ARG org-index--commands))
- (setq what ARG)
- (error "Unknown command '%s' passed as argument, valid choices are a prefix argument or any of these symbols: %s"
- ARG (mapconcat 'symbol-name org-index--commands ","))))
-
- (let ((r (org-index--read-what what)))
- (setq what (nth 0 r))
- (setq what-input (nth 1 r))
- (setq reorder-once (nth 2 r))))
-
-
-
-
- (when (memq what '(goto occur head update))
-
- (setq search (org-index--get-or-read-search search what what-input))
-
- (when search
- (when (string-match org-index--ref-regex search)
- (setq search-ref search)
- (setq guarded-search (org-index--make-guarded-search search)))
- (when (string-match "^[a-fA-F0-9]\\{8\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{12\\}$" search)
- (setq search-link search))))
-
-
-
-
-
-
- (when (and (not search)
- (memq what '(search head)))
- (setq what 'enter)
- (setq what-adjusted t))
-
-
- (when (and (memq what '(head goto))
- (not search-ref)
- (not search-link))
- (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))
-
-
-
-
-
- (if (eq what 'link)
- (let ((org-id-link-to-org-use-id t))
- (setq link-id (org-id-get-create))))
-
- (if (and org-index--within-node
- (org-at-table-p))
- (setq initial-ref-or-link
- (or (org-index--get-field :ref)
- (org-index--get-field :link))))
-
- (when (memq what '(occur multi-occur statistics))
- (set-buffer org-index--buffer)
- (goto-char org-index--point)
-
-
- (org-index--sort reorder-once)
- (org-index--align))
-
- (when (memq what '(enter ref link goto missing))
-
- (org-mark-ring-push)
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (show-subtree)
- (org-show-context)
-
- (org-index--sort reorder-once)
- (org-index--align)
-
-
- (if org-index--point-before
- (setq org-index--point-saved org-index--point-before)))
-
-
- (when initial-ref-or-link
- (while (and (org-at-table-p)
- (not (or
- (string= initial-ref-or-link (org-index--get-field :ref))
- (string= initial-ref-or-link (org-index--get-field :link)))))
- (forward-line))
-
- (if (not (org-at-table-p)) (goto-char org-index--point)))
-
-
-
-
-
- (cond
- ((eq what 'help)
-
-
- (describe-function 'org-index))
- ((eq what 'multi-occur)
-
-
- (goto-char org-index--below-hline)
- (let (found (initial (point)))
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found (string= search
- (org-index--get-field :ref)))))
- (if found
- (org-index--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))
- (other-window 1)
- (toggle-truncate-lines 1))
- (setq message-text (format "Did not find '%s'" search)))))
- ((eq what 'head)
- (let (link)
- (if (and org-index--within-node
- (org-at-table-p))
- (setq link (org-index--get-field :link))))
-
- (setq message-text (org-index--do-head search-ref search-link)))
- ((eq what 'leave)
- (setq kill-new-text org-index--text-to-yank)
- (setq org-index--text-to-yank nil)
-
-
-
- (if (eq org-index--last-action 'leave)
- (let ((this-command nil) (last-command nil))
- (org-mark-ring-goto 1))
- (org-mark-ring-goto))
-
-
- (when org-index--point-saved
-
- (if (eq (window-buffer org-index--active-window-index)
- org-index--buffer)
- (set-window-point org-index--active-window-index (marker-position org-index--point-saved)))
-
- (with-current-buffer org-index--buffer
- (goto-char org-index--point-saved)))
- (setq org-index--point-saved nil))
- ((eq what 'goto)
-
- (let (found (initial (point)))
- (goto-char org-index--below-hline)
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found
- (string= search
- (org-index--get-field
- (if search-link :link :ref))))))
- (if found
- (progn
- (setq message-text (format "Found '%s'" search))
- (org-index--update-line nil)
- (org-table-goto-column (org-index--column-num :ref))
- (if (looking-back " ") (backward-char))
-
- (setq org-index--text-to-yank
- (org-trim (org-table-get-field (org-index--column-num :copy)))))
- (setq message-text (format "Did not find '%s'" search))
- (goto-char initial)
- (forward-line)
- (setq what 'missed))))
- ((eq what 'occur)
- (org-index--do-occur what-input))
- ((memq what '(ref link))
- (let (new)
-
- (setq new (org-index--do-new-line (eq what 'ref)))
-
- (when (eq what 'ref)
- (org-table-goto-column (org-index--column-num :ref))
- (insert new)
- (setq org-index--last-ref new))
- (when (eq what 'link)
- (org-table-goto-column (org-index--column-num :link))
- (insert link-id))
- (org-index--align)
-
-
- (if (org-index--special-column :point)
- (org-table-goto-column (org-index--column-num (org-index--special-column :point)))
- (if (org-index--special-column :copy)
- (org-table-goto-column (org-index--column-num (org-index--special-column :copy)))
- (unless (catch 'empty
- (dotimes (col org-index--numcols)
- (org-table-goto-column (+ col 1))
- (if (string= (org-trim (org-table-get-field)) "")
- (throw 'empty t))))
-
- (org-table-goto-column 1))))
-
- (if org-index--active-region (setq kill-new-text org-index--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 'put)
-
-
- (if org-index--last-ref
- (progn
- (org-entry-put (point) "org-index-ref" org-index--last-ref)
- (message "Reference '%s' has been stored in property org-index-ref" org-index--last-ref))
- (setq org-index--last-ref
- (read-from-minibuffer "Reference to be stored in this node: "))
- (unless org-index--last-ref
- (message "No reference has been given."))
- ))
-
- ((eq what 'enter)
-
- (goto-char org-index--below-hline)
- (show-subtree)
- (recenter)
- (if what-adjusted
- (setq message-text "Nothing to search for; at index table")
- (setq message-text "At index table")))
-
- ((eq what 'fill)
-
- (unless (and org-index--within-node
- (org-at-table-p))
- (error "Not within index table"))
-
- (let ((ref (org-index--get-field :ref))
- (link (org-index--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" org-index--head (1+ org-index--maxref) org-index--tail))
- (org-index--get-field :ref kill-new-text)
-
- (setq org-index--text-to-yank kill-new-text)
- (org-id-goto link)
- (setq message-text "Filled field of index table with new reference"))
-
- (if (not link)
- (progn
- (setq guarded-search (org-index--make-guarded-search ref))
- (message (format "Scanning headlines for '%s' ..." ref))
- (let ((search (concat ".*" guarded-search))
- link)
- (if (catch 'found
- (org-map-entries
- (lambda ()
- (when (looking-at search)
- (setq link (org-id-get-create))
- (throw 'found t)))
- nil 'agenda)
- nil)
- (progn
- (org-index--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-index--make-guarded-search org-index--ref-regex 'dont-quote)))
- (string-to-number (match-string 1))
- 0))))
- (highlight-regexp org-index--ref-regex 'isearch)
- (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-link "link" "reference")))
- (beginning-of-line)
- (if (org-index--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))))))
- ((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 org-index--ref-regex 'isearch)
- (setq message-text (format "Highlighted references in %s" where)))
- (unhighlight-regexp org-index--ref-regex)
- (setq message-text (format "Removed highlights for references in %s" where)))))))
- ((memq what '(missing statistics))
- (setq message-text (org-index--do-statistics what)))
-
-
- (t (error "This is a bug: unmatched case '%s'" what)))
-
- (setq org-index--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-index-new-line (&rest keys-values)
- "Create a new line within the index table, returning its reference.
- The function takes a varying number of arguments pairs; each pair
- is a symbol for an existing column heading followed by its value.
- their values.
- Example:
- (org-index-new-line :ref t :x1 \"foo\" :link \"7f480c3e\")
- Passing \":ref t\" will make the function create a new reference within the new line.
- "
- (let ((org-index--silent t))
- (save-excursion
- (org-index--retrieve-context)
- (with-current-buffer org-index--buffer
- (goto-char org-index--point)
- (org-index--parse-table)
-
- (let ((kvs keys-values)
- k v)
- (while kvs
- (setq k (car kvs))
- (setq v (cadr kvs))
- (if (eq k :ref)
- (unless (memq v '(t nil))
- (error "Argument :ref accepts only t or nil"))
- (if (or (not (symbolp k))
- (symbolp v))
- (error "Arguments must be alternation of key and value")))
- (unless (> (org-index--column-num k) 0)
- (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
- (setq kvs (cddr kvs))))
- (if (and (not (plist-get keys-values :ref))
- (not (stringp (plist-get keys-values :link))))
- (error "Need a link when not creating a ref"))
- (let (new)
-
- (setq new (org-index--do-new-line (plist-get keys-values :ref)))
- (plist-put keys-values :ref (or new ""))
-
- (let ((kvs keys-values)
- k v n)
- (while kvs
- (setq k (car kvs))
- (setq v (cadr kvs))
- (setq n (org-index--column-num k))
- (org-table-goto-column n)
- (insert v)
- (setq kvs (cddr kvs))))
-
- (org-index--sort)
- new)))))
- (defun org-index-get-line (what value)
- "Retrieve an existing line within the index table by ref or
- link and return its contents as a property list.
- The function `plist-get' may be used to retrieve specific values.
- Example:
- (plist-get (org-index-get-line \"12\") :count)
- retrieves the value of the count-column for reference 12.
- "
- (interactive)
- (let ((org-index--silent t)
- found)
-
- (unless (memq what '(:ref :link))
- (error "Argument what can only be :ref or :link"))
- (save-excursion
- (org-index--retrieve-context)
- (with-current-buffer org-index--buffer
- (goto-char org-index--point)
- (org-index--parse-table)
- (goto-char org-index--below-hline)
- (while (and (not found)
- (org-at-table-p))
- (when (string= (org-index--get-field what)
- value)
- (mapc (lambda (x)
- (if (and (numberp (cdr x))
- (> (cdr x) 0))
- (setq found (cons (car x) (cons (or (org-index--get-field (car x)) "") found)))
- )) (reverse org-index--columns)))
- (forward-line))
- found))))
- (defun org-index--read-what (what)
- "Find out, what we are supposed to do"
- (let (commands
- trailing-digits
- reorder-once
- what-input)
-
-
- (setq org-index--preferred-command
- (if org-index--within-node
- (if (memq org-index--last-action '(ref link))
- 'leave
- 'goto)
- (if org-index--active-region
- 'ref
- (if (and org-index--below-cursor (string-match org-index--ref-regex org-index--below-cursor))
- 'occur
- nil))))
-
-
- (if what
- (setq what-input (symbol-name what))
-
- (setq commands (copy-list org-index--commands))
- (let ((c commands))
- (while (and c (not (eq (car c) '+)))
- (setq c (cdr c)))
- (setcdr c nil))
-
- (while (let (completions starts-with-plus is-only-plus)
- (setq what-input
- (org-completing-read
- "Please choose: "
- (mapcar 'symbol-name
-
-
- (delq nil (delete-dups
- (append
- (list org-index--preferred-command)
- (copy-list commands)))))
- nil nil))
-
-
- (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)
-
- (setq trailing-digits (string-to-number (match-string 2 what-input)))
-
- (setq what-input (match-string 1 what-input)))
-
-
- (when (and (> (length what-input) 0)
- (string= (substring what-input 0 1) "+"))
-
- (setq commands (copy-list org-index--commands))
- (setq what-input (substring what-input 1))
- (setq starts-with-plus (> (length what-input) 0))
- (setq is-only-plus (not starts-with-plus)))
-
-
- (setq completions (delq nil (mapcar
- (lambda (x)
- (let ((where (search what-input (symbol-name x))))
- (if (and where
- (= where 0))
- x
- nil))) commands)))
-
- (when starts-with-plus
-
- (if (= (length completions) 1)
- (setq what-input (symbol-name (car completions)))
- (if completions
- (error "Input \"+%s\" matches multiple commands: %s"
- what-input
- (mapconcat 'symbol-name completions ", "))
- (error "Input \"+%s\" matches no commands" what-input))))
-
-
- (when (and trailing-digits completions)
-
- (setq org-index--preferred-command (first completions))
- (setq what-input (number-to-string trailing-digits)))
-
- (setq what (intern what-input))
- (if is-only-plus (setq what '+))
-
-
-
-
- (if (memq what commands)
-
-
- (setq what-input nil)
-
-
- (setq what (or org-index--preferred-command
- (first commands)))
-
-
- (if (and (> (length what-input) 0)
- (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 index table once: "
- (mapcar 'symbol-name
- (append '(:ref :count :first :last)
- (delq nil (mapcar (lambda (x) (if (> (cdr (assoc x org-index--columns)) 0) x nil))
- '(:x1 :x2 :x3)))))
- nil t))))
-
-
- (memq what '(reorder +)))))
- (list what what-input reorder-once)))
- (defun org-index--get-or-read-search (search what what-input)
- "Get search string, maybe read from user"
- (let (search-from-table
- search-from-cursor)
-
- (unless search
-
-
- (when (and org-index--within-node
- (org-at-table-p))
- (setq search-from-table (or (org-index--get-field :link)
- (org-index--get-field :ref))))
-
-
- (when (and (not org-index--within-node)
- org-index--below-cursor
- (string-match (concat "\\(" org-index--ref-regex "\\)")
- org-index--below-cursor))
- (setq search-from-cursor (match-string 1 org-index--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 org-index--silent (error "Need to specify search, if silence is required"))
- (unless (eq what 'occur)
-
- (if what-input
- (setq search what-input)
- (setq search (read-from-minibuffer
- (cond ((eq what '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" org-index--head search org-index--tail)))))
-
-
- (when search
- (setq search (org-trim search))
- (if (string= search "") (setq search nil))
- (when search
- (if (string-match "^[0-9]+$" search)
- (setq search (concat org-index--head search org-index--tail)))))
-
-
- (when (and (memq what '(head goto))
- (string= search "."))
- (setq search (org-id-get)))
-
- search))
- (defun org-index--verify-id ()
-
- (unless org-index-id
- (org-index--create-new-index
- t
- (format "No index table has been created yet." org-index-id)))
-
- (let (marker)
- (setq marker (org-id-find org-index-id 'marker))
- (unless marker (org-index--create-new-index
- t
- (format "Cannot find node with id \"%s\"" org-index-id)))
-
- (setq marker (org-id-find org-index-id 'marker))
- (unless marker (error "Could not create node"))
- (setq org-index--buffer (marker-buffer marker)
- org-index--point (marker-position marker))
- (move-marker marker nil)))
- (defun org-index--retrieve-context ()
-
- (setq org-index--active-region
- (if (and transient-mark-mode mark-active)
- (buffer-substring (region-beginning) (region-end))
- nil))
- (setq org-index--below-cursor (thing-at-point 'symbol))
-
-
- (setq org-index--within-node (string= (org-id-get) org-index-id))
-
-
- (if (eq (window-buffer) org-index--buffer)
- (setq org-index--active-window-index (selected-window)))
-
- (with-current-buffer org-index--buffer
- (setq org-index--point-before
- (if (string= (org-id-get) org-index-id)
- nil
- (point-marker)))))
- (defun org-index--parse-table ()
- (let (ref-field
- link-field
- initial-point
- end-of-heading)
- (with-current-buffer org-index--buffer
- (setq org-index--maxref 0)
- (setq initial-point (point))
- (org-index--go-below-hline)
- (setq org-index--below-hline (point))
- (beginning-of-line)
- (setq end-of-heading (point))
- (while (org-at-table-p) (forward-line -1))
- (forward-line)
- (setq org-index--headings (buffer-substring (point) end-of-heading))
- (goto-char org-index--below-hline)
-
-
-
- (org-table-goto-column 100)
- (setq org-index--numcols (- (org-table-current-column) 1))
-
-
- (forward-line -2)
- (unless (org-at-table-p)
- (org-index--create-new-index
- nil
- "Index table starts with a hline"))
-
- (beginning-of-line)
- (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
- (forward-line -1))
- (org-table-goto-column 1)
- (org-index--parse-headings)
-
-
- (while (org-at-table-p) (forward-line 1))
-
-
- (goto-char org-index--below-hline)
- (while (and (org-at-table-p)
- (not (setq ref-field (org-index--get-field :ref))))
- (forward-line))
-
- (unless ref-field
- (org-index--create-new-index
- nil
- "Reference column is empty"))
-
- (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
- (org-index--create-new-index
- nil
- (format "First reference in index table ('%s') does not contain a number" ref-field)))
-
-
- (setq org-index--head (match-string 1 ref-field))
- (setq org-index--tail (match-string 3 ref-field))
- (setq org-index--ref-regex (concat (regexp-quote org-index--head)
- "\\([0-9]+\\)"
- (regexp-quote org-index--tail)))
- (setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
-
- (let ((ref 0))
- (while (org-at-table-p)
- (setq ref-field (org-index--get-field :ref))
- (setq link-field (org-index--get-field :link))
- (when (and (not ref-field)
- (not link-field))
- (org-pop-to-buffer-same-window org-index--buffer)
- (org-reveal)
- (error "Columns ref and link are both empty in this line"))
- (if ref-field
- (if (string-match org-index--ref-regex ref-field)
-
- (setq ref (string-to-number (match-string 1 ref-field)))
- (org-pop-to-buffer-same-window org-index--buffer)
- (org-reveal)
- (error "Column ref does not contain a number")))
-
- (if (> ref org-index--maxref) (setq org-index--maxref ref))
-
- (if (string= (org-index--get-field :count) ":reuse:")
- (setq org-index--has-reuse t))
- (forward-line 1)))
-
-
- (goto-char initial-point))))
- (defun org-index--sort (&optional sort-column)
- (unless sort-column (setq sort-column (org-index--special-column :sort)))
- (let (top
- bottom
- ref-field
- count-field
- count-special)
- (unless buffer-read-only
-
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq top (point))
- (while (org-at-table-p) (forward-line))
-
-
- (while (progn
- (forward-line -1)
- (org-table-goto-column 1)
- (and
- (not (org-index--get-field :ref))
- (not (org-index--get-field :link))))
- (org-table-kill-row))
- (forward-line 1)
- (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-index--get-field :ref) ""))
- (count-field (or (org-index--get-field :count) ""))
- (count-special 0))
-
-
- (string-match org-index--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-index--get-field :count)
- "")))
- ref))
-
- ((eq sort-column :ref)
- (concat count-special
- ref))
-
- ((memq sort-column '(:last :x1 :x2 :x3))
- (concat count-special
- (org-index--get-field sort-column)
- " "
- ref))
-
- (t (error "This is a bug: unmatched case '%s'" sort-column)))))
-
- nil 'string<))
-
-
- (org-index--go-below-hline)
- (setq org-index--below-hline (point)))))
- (defun org-index--go-below-hline ()
- (goto-char org-index--point)
-
- (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-index--create-new-index
- t
- (format "Cannot find index table within node %s" org-index-id)))
-
- (while (and (not (org-at-table-hline-p))
- (org-at-table-p))
- (forward-line 1))
-
-
- (unless (org-at-table-hline-p)
- (org-index--create-new-index
- nil
- "Cannot find hline within index table"))
- (forward-line 1)
- (org-table-goto-column 1))
- (defun org-index--align ()
- (unless buffer-read-only (org-table-align))
- (org-index--go-below-hline)
- (setq org-index--below-hline (point)))
- (defun org-index--parse-headings ()
-
- (setq org-index--columns (copy-tree '((:ref . 0) (:link . 0) (:first . 0) (:last . 0)
- (:count . 0) (:x1 . 0) (:x2 . 0) (:x3 . 0))))
-
- (setq org-index--special-columns (copy-tree '((:sort . nil) (:copy . nil) (:point . nil))))
-
- (dotimes (col org-index--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 (concat ":" (downcase field)))))
-
- (if (eq field-symbol :last-accessed) (setq field-symbol :last))
- (if (eq field-symbol :created) (setq field-symbol :first))
- (if (and field-symbol
- (not (assoc field-symbol org-index--columns)))
- (error "Column %s is not a valid heading" (symbol-name field-symbol)))
-
- (mapc (lambda (x)
- (when (memq (car x) flags)
- (if (cdr (assoc (cdr x) org-index--columns))
- (org-index--create-new-index
- nil
- (format "More than one heading is marked with flag '%c'" (car x))))))
- '((?s . sort)
- (?c . copy)))
-
-
- (if (memq ?s flags)
- (setcdr (assoc :sort org-index--special-columns) (or field-symbol (+ col 1))))
- (if (memq ?c flags)
- (setcdr (assoc :copy org-index--special-columns) (or field-symbol (+ col 1))))
- (if (memq ?p flags)
- (setcdr (assoc :point org-index--special-columns) (or field-symbol (+ col 1))))
-
-
- (setq found (assoc field-symbol org-index--columns))
- (when found
- (if (> (cdr found) 0)
- (org-index--create-new-index
- nil
- (format "'%s' appears two times as column heading" (downcase field))))
- (setcdr found (+ col 1)))))
-
- (mapc (lambda (col)
- (unless (> (cdr (assoc col org-index--columns)) 0)
- (org-index--create-new-index
- nil
- (format "column '%s' has not been set" col))))
- (list :ref :link :count :first :last))
-
- (unless (cdr (assoc :sort org-index--special-columns))
- (setcdr (assoc :sort org-index--special-columns) :count)))
- (defun org-index--create-new-index (create-new-index reason)
- "Create a new empty index table with detailed explanation."
- (let (prompt buffer-name title firstref id)
-
- (if org-index--silent (error "No valid index: %s" reason))
- (setq prompt
- (if create-new-index
- (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")
- (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before trying again. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))
- (unless (y-or-n-p prompt)
- (error "Cannot proceed without a valid index table: %s" reason))
-
- (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil))
- (setq title (read-from-minibuffer "Please enter the title of the index node: "))
- (while (progn
- (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
- (let (desc)
- (unless (equal '(95 119) (sort (delete-dups (mapcar (lambda (x) (char-syntax x)) (concat "-1" firstref))) '<))
- (setq desc "Contains other characters than those allowed in symbols"))
- (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
-
- (setq desc
- (cond ((string= firstref "") "is empty")
- ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
- ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
- ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")
- )))
- (if desc
- (progn
- (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again" firstref desc))
- t)
- nil))))
- (with-current-buffer buffer-name
- (goto-char (point-max))
- (insert (format "\n\n* %s %s\n" firstref title))
- (insert "\n\n Below you find your initial index table, which will grow over time.\n"
- " Following that your may read its detailed explanation, which will help you,\n"
- " to adjust org-index to your needs. This however is optional reading and not\n"
- " required to start using org-index.\n")
- (setq id (org-id-get-create))
- (insert (format "
- | | | | | | comment |
- | ref | link | first | count;s | last | ;c |
- | | <4> | | | | |
- |-----+------+-------+---------+------+---------|
- | %s | %s | %s | | | %s |
- "
- firstref
- id
- (with-temp-buffer (org-insert-time-stamp nil nil t))
- "This node"))
- (insert "
- Detailed explanation:
- The index table above has three lines of headings above the first
- hline:
- - The first one is ignored by org-index, and you can use it to
- give meaningful names to columns. In the table above only one
- column has a name (\"comment\"). This line is optional.
- - The second line is the most important one, because it
- contains the configuration information for org-index; please
- read further below for its format.
- - The third line is again optional; it may only specify the
- widths of the individual columns (e.g. <4>).
- The columns get their meaning by the second line of headings;
- specifically by one of the keywords (e.g. \"ref\") or a flag
- seperated by a semicolon (e.g. \";s\").
- The keywords and flags are:
- - ref: This contains the reference, which consists of a decorated
- number, which is incremented for each new line. References are
- meant to be used in org-mode headlines or outside of org,
- e.g. within folder names.
- - link: org-mode link pointing to the matching location within org.
- - first: When has this line been first accessed (i.e. created) ?
- - count: How many times has this line been accessed ? The
- trailing flag \"s\" makes the table beeing sorted after this
- column this column, so that often used entries appear at the
- top of the table.
- - last: When has this line been accessed last ?
- - The last column above has no keyword, only the flag \"c\",
- which makes its content beeing copied under certain
- conditions. It is typically used for comments.
- The sequence of columns does not matter. You may reorder them any
- way you like. Columns are found by their name, which appears in
- the second line of headings.
- You can add further columns or even remove the last column. All
- other columns are required.
- Finally: This node needs not be a top level node; its name is
- completely at you choice; it is found through its ID only.
- ")
- (while (not (org-at-table-p)) (forward-line -1))
- (unless buffer-read-only (org-table-align))
- (while (not (org-at-heading-p)) (forward-line -1))
-
-
- (if create-new-index
- (progn
-
- (org-pop-to-buffer-same-window buffer-name)
- (delete-other-windows)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (setq org-index-id id)
- (if (y-or-n-p "This is your new index table. It is already set for this emacs session. Do you want to save its id to make it available for future emacs sessions too ? ")
- (progn
- (customize-save-variable 'org-index-id id)
- (error "Saved org-index-id '%s' to %s" id custom-file))
- (let (sq)
- (setq sq (format "(setq org-index-id \"%s\")" id))
- (kill-new sq)
- (error "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))))
-
-
-
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (delete-other-windows)
-
- (select-window (split-window-vertically))
- (org-pop-to-buffer-same-window buffer-name)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (error "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)))))
- (defun org-index--update-line (ref-or-link)
- (let ((newcount 0)
- initial)
- (with-current-buffer org-index--buffer
- (unless buffer-read-only
-
- (when ref-or-link
- (setq initial (point))
- (goto-char org-index--below-hline)
- (while (and (org-at-table-p)
- (not (or (string= ref-or-link (org-index--get-field :ref))
- (string= ref-or-link (org-index--get-field :link)))))
- (forward-line)))
-
- (if (not (org-at-table-p))
- (error "Did not find reference or link '%s'" ref-or-link)
- (org-index--update-current-line))
-
- (if initial (goto-char initial))))))
- (defun org-index--update-current-line ()
- (let (newcount (count-field (org-index--get-field :count)))
-
-
- (when (or (not count-field)
- (string-match "^[0-9]+$" count-field))
- (setq newcount (+ 1 (string-to-number (or count-field "0"))))
- (org-index--get-field :count
- (number-to-string newcount)))
-
-
- (org-table-goto-column (org-index--column-num :last))
- (org-table-blank-field)
- (org-insert-time-stamp nil t t)))
- (defun org-index--get-field (key &optional value)
- (let (field)
- (save-excursion
- (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
- (if (string= field "") (setq field nil))
-
- (org-no-properties field))))
- (defun org-index--column-num (key)
- (if (numberp key)
- key
- (cdr (assoc key org-index--columns))))
- (defun org-index--special-column (key)
- (cdr (assoc key org-index--special-columns)))
- (defun org-index--make-guarded-search (ref &optional dont-quote)
- (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
- (defun org-index--do-statistics (what)
- (let ((total 0)
- missing
- ref-field
- ref
- min
- max
- message-text)
-
-
- (setq missing (mapcar (lambda (x) (format "%s%d%s" org-index--head x org-index--tail))
- (number-sequence 1 org-index--maxref)))
-
- (goto-char org-index--below-hline)
- (while (org-at-table-p)
-
- (setq ref-field (org-index--get-field :ref))
- (if (and ref-field
- (string-match org-index--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))
-
- (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-index--ref-format min)
- (format org-index--ref-format max)
- (length missing)))
- (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table"
- (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-index--get-field :ref x)
- (org-index--get-field :count (format ":%s:" type)))
- missing)
- (org-index--align)
- (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
- (setq message-text (format "%d missing references." (length missing)))))
- message-text))
- (defun org-index--do-head (ref link &optional other)
-
- (if ref (setq org-index--last-ref ref))
-
- (let (message-text)
-
- (if link
- (progn
- (org-index--update-line link)
- (org-id-goto link)
- (org-reveal)
- (setq message-text "Followed link"))
-
- (message (format "Scanning headlines for '%s' ..." ref))
- (org-index--update-line ref)
- (let ((search (concat ".*" (org-index--make-guarded-search ref)))
- (org-trust-scanner-tags t)
- buffer point)
- (if (catch 'found
- (progn
-
- (org-map-entries
- (lambda ()
- (when (or (looking-at search)
- (eq ref (org-entry-get (point) "org-index-ref")))
-
- (when (< (org-element-property :level (org-element-at-point))
- org-inlinetask-min-level)
-
- (setq buffer (current-buffer))
- (setq point (point))
- (throw 'found t))))
- nil 'agenda)
- nil))
- (progn
- (setq message-text (format "Found '%s'" (or ref link)))
- (if other
- (progn
- (pop-to-buffer buffer)
- (goto-char point)
- (org-reveal t)
- (recenter)
- (pop-to-buffer "*org-index-occur*"))
- (org-pop-to-buffer-same-window buffer)
- (goto-char point)
- (org-reveal t)
- (recenter)))
- (setq message-text (format "Did not find '%s'" (or ref link))))))
- message-text))
- (defun org-index--do-occur (initial-search)
- (let ((occur-buffer-name "*org-index-occur*")
- (word "")
- (prompt "Search for: ")
- (hint "")
- (key-help "<up>, <down> move. <return> finds node, <S-return> goes to table, <M-return> updates count. TAB finds in other window.\n")
- words
- occur-buffer
- lines-to-show
- start-of-lines
- start-of-help
- left-off-at
- after-inserted
- at-end
- lines-visible
- below-hline-bol
- exit-gracefully
- in-c-backspace
- show-headings
- fun-on-ret
- fun-on-s-ret
- fun-on-m-ret
- fun-on-tab
- ret from to key)
-
-
- (if (get-buffer "*org-index-occur*")
- (kill-buffer occur-buffer-name))
- (setq occur-buffer (get-buffer-create "*org-index-occur*"))
-
- (with-current-buffer occur-buffer
- (let ((keymap (make-sparse-keymap)))
- (set-keymap-parent keymap org-mode-map)
- (setq fun-on-ret (lambda () (interactive) (org-index--occur-find-heading nil)))
- (define-key keymap [return] fun-on-ret)
- (setq fun-on-s-ret (lambda () (interactive)
- (when (org-at-table-p)
- (org-table-goto-column (org-index--column-num :ref))
- (org-index 'goto))))
- (define-key keymap [S-return] fun-on-s-ret)
- (setq fun-on-m-ret (lambda () (interactive)
- (when (org-at-table-p)
- (org-index--update-current-line)
- (org-table-align)
- (org-table-goto-column (org-index--column-num :count))
- (message (format "New count is %s" (org-trim (org-table-get-field))))
- (org-index--update-line (org-index--get-field :ref)))))
- (define-key keymap [M-return] fun-on-m-ret)
- (setq fun-on-tab (lambda () (interactive)
- (org-index--occur-find-heading t)
- (setq org-index--occur-follow-mode (not org-index--occur-follow-mode))))
- (define-key keymap [tab] fun-on-tab)
- (define-key keymap [(control ?i)] fun-on-tab)
- (define-key keymap [up] (lambda () (interactive)
- (forward-line -1)
- (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
- (define-key keymap [down] (lambda () (interactive)
- (forward-line 1)
- (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
- (use-local-map keymap)))
- (with-current-buffer org-index--buffer
- (let ((initial (point)))
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq below-hline-bol (point))
- (goto-char initial)))
- (org-pop-to-buffer-same-window occur-buffer)
- (toggle-truncate-lines 1)
- (unwind-protect
- (progn
-
-
- (erase-buffer)
- (insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
- (setq start-of-lines (point-marker))
- (setq start-of-help start-of-lines)
- (setq cursor-type 'hollow)
-
-
- (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
-
- (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
- (when (nth 0 ret)
- (insert (nth 1 ret))
- (setq left-off-at (cons (nth 0 ret) nil))
- (setq after-inserted (cons (point) nil)))
-
- (while
- (progn
- (goto-char start-of-lines)
- (setq lines-visible 0)
-
-
- (if (and initial-search
- (> (length initial-search) 0))
- (progn
- (setq key (string-to-char (substring initial-search 0 1)))
- (if (length initial-search)
- (setq initial-search (substring initial-search 1))))
- (if in-c-backspace
- (setq key 'backspace)
- (let ((search-text (mapconcat 'identity (reverse (cons word words)) ",")))
- (setq key (read-key
- (format "%s%s%s%s"
- prompt
- search-text
- (if (string= search-text "") "" " ")
- hint))))
- (setq hint "")
- (setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return 'S-return ?\C-i 'TAB)))))
-
- (not exit-gracefully))
-
- (cond
- ((eq key 'C-backspace)
- (setq in-c-backspace t))
- ((member key (list 'backspace 'deletechar ?\C-?))
- (if (= (length word) 0)
-
- (progn
- (setq word (car words))
- (setq words (cdr words))
- (setq in-c-backspace nil))
-
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word)))
-
- (setq word (substring word 0 -1))
- (when (= (length word) 0)
- (setq word (car words))
- (setq words (cdr words))
- (setq in-c-backspace nil))
-
-
- (when (cdr after-inserted)
- (setq after-inserted (cdr after-inserted))
- (goto-char (car after-inserted))
- (delete-region (point) (point-max)))
-
- (when (cdr left-off-at)
- (setq left-off-at (cdr left-off-at)))
-
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (progn
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
-
- (when (org-index--test-words (cons word words) (buffer-substring from to))
- (when (<= lines-visible lines-to-show)
- (outline-flag-region from to nil)
- (incf lines-visible))))
-
- (incf lines-visible))
- (forward-line 1))
-
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))))
- ((member key (list ?\s ?,))
-
- (setq words (cons word words))
- (setq word ""))
- ((eq key ??)
- (setq show-headings (not show-headings))
- (goto-char start-of-lines)
- (if show-headings
- (progn
- (forward-line -1)
- (setq start-of-help (point-marker))
- (insert "Normal keys add to search word, SPACE or COMMA start new word, BACKSPACE and C-BACKSPACE erase char or word. Every other key ends search: <C-return> completes list of matches. ")
- (insert key-help)
- (goto-char start-of-help)
- (fill-paragraph)
- (goto-char start-of-lines)
- (insert org-index--headings))
- (delete-region start-of-help start-of-lines)
- (insert "\n\n"))
- (setq start-of-lines (point-marker)))
- ((and (integerp key)
- (aref printable-chars key))
-
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word))))
-
- (setq word (concat word (char-to-string key)))
-
- (while (< (point) (point-max))
- (unless (outline-invisible-p)
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
-
- (if (org-index--test-words (list word) (buffer-substring from to))
- (incf lines-visible)
- (outline-flag-region from to t)))
- (forward-line 1))
-
- (setq left-off-at (cons (car left-off-at) left-off-at))
- (setq after-inserted (cons (car after-inserted) after-inserted))
-
- (when (< lines-visible lines-to-show)
- (setq ret (org-index--get-matching-lines (cons word words)
- (- lines-to-show lines-visible)
- (car left-off-at)))
- (when (nth 0 ret)
- (insert (nth 1 ret))
- (setq at-end (nth 2 ret))
- (setcar left-off-at (nth 0 ret))
- (setcar after-inserted (point))))
-
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))
- (t
- (setq hint (format "(cannot search for key '%s', use %s to quit)"
- (if (symbolp key)
- key
- (key-description (char-to-string key)))
- (substitute-command-keys "\\[keyboard-quit]"))))))
-
-
-
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (delete-region (line-beginning-position) (line-beginning-position 2))
- (forward-line 1)))
-
- (when (eq key 'C-return)
- (message "Getting all matches ...")
- (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
- (message "done.")
- (insert (nth 1 ret))))
-
-
- (setq cursor-type t)
-
- (let ((numlines (count-lines (point) start-of-lines)))
- (goto-char start-of-lines)
- (delete-region (point-min) (point))
- (insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
- (if (or at-end (eq key 'C-return))
- " showing all %d matches. "
- " showing only some matches. ")
- key-help)
- numlines))
- (insert "\n")
- (setq start-of-lines (point-marker))
- (goto-char (point-min))
- (fill-paragraph)
- (goto-char start-of-lines)
- (if show-headings (insert "\n\n" org-index--headings)))
- (forward-line))
-
-
- (forward-line -1)
- (cond
- ((member key (list 'RET ?\C-m))
- (funcall fun-on-ret))
- ((member key (list 'TAB ?\C-i))
- (funcall fun-on-tab))
- ((eq key 'up)
- (forward-line -1))
- ((eq key 'down)
- (forward-line 1))
- ((eq key 'M-return)
- (funcall fun-on-m-ret))
- ((eq key 'S-return)
- (funcall fun-on-s-ret)))))
- (defun org-index--occur-find-heading (x)
- "helper for keymap of occur"
- (interactive)
- (save-excursion
- (let ((ref (org-index--get-field :ref))
- (link (org-index--get-field :link)))
- (message (org-index--do-head ref link x)))))
- (defun org-index--do-new-line (create-ref)
- "Do the common work for org-index-new-line and org-index"
- (let (new)
- (when create-ref
-
- (when org-index--has-reuse
- (goto-char org-index--below-hline)
-
- (while (and (org-at-table-p)
- (not new))
- (when (string=
- (org-index--get-field :count)
- ":reuse:")
- (setq new (org-index--get-field :ref))
- (if new (org-table-kill-row)))
- (forward-line)))
-
-
- (unless new
- (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
-
- (setq org-index--text-to-yank new))
-
-
- (goto-char org-index--below-hline)
- (org-table-insert-row)
-
- (org-table-goto-column (org-index--column-num :first))
- (org-insert-time-stamp nil nil t)
- (org-table-goto-column (org-index--column-num :count))
- (insert "1")
- new))
- (defun org-index--get-matching-lines (words numlines start-from)
- (let ((numfound 0)
- pos
- initial line lines at-end)
-
- (with-current-buffer org-index--buffer
-
- (setq initial (point))
- (goto-char start-from)
-
-
- (while (and (or (< numfound numlines)
- (= numlines 0))
- (org-at-table-p))
-
- (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
- (when (org-index--test-words words line)
- (setq lines (concat lines line))
- (incf numfound))
- (forward-line 1)
- (setq pos (point)))
- (setq at-end (not (org-at-table-p)))
-
- (goto-char initial))
- (unless lines (setq lines ""))
- (list pos lines at-end)))
- (defun org-index--test-words (words line)
- (let ((found-all t))
- (setq line (downcase line))
- (catch 'not-found
- (dolist (w words)
- (or (search w line)
- (throw 'not-found nil)))
- t)))
- (defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
- "Make text from org-index available for yank."
- (when org-index--text-to-yank
- (kill-new org-index--text-to-yank)
- (message (format "Ready to yank '%s'" org-index--text-to-yank))
- (setq org-index--text-to-yank nil)))
- (provide 'org-index)
|