├── blk-org.el ├── blk-pkg.el ├── blk.el └── readme.org /blk-org.el: -------------------------------------------------------------------------------- 1 | ;;; blk-org.el --- Add blk-type Org links and transclusion -*- lexical-binding: t; -*- 2 | 3 | ;; Author: Mahmood Sheikh 4 | ;; Keywords: lisp 5 | ;; Version: 0.0.2 6 | 7 | ;; Copyright (C) 2024 Mahmood Sheikh and Bob Weiner 8 | 9 | ;; SPDX-License-Identifier: GPL-3.0-or-later 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;; This package is for making arbitrary links across text files. 26 | 27 | ;;; Code: 28 | ;;;###autoload 29 | (defun blk-configure-org-link () 30 | "Create the blk org link type." 31 | (org-link-set-parameters "blk" 32 | :follow #'blk-org-open 33 | :export #'blk-org-export)) 34 | 35 | ;;;###autoload 36 | (defun blk-configure-org-transclusion () 37 | "Auto configure `org-transclusion' integration with blk." 38 | (add-to-list 'org-transclusion-add-functions 'blk-org-transclusion)) 39 | 40 | (defun blk-org-open (link _) 41 | "Open the file containing a block with the LINK id." 42 | (when (not (blk-open-by-id link)) 43 | (message "id %s not found" link))) 44 | 45 | (defun blk-org-export (link desc format) 46 | "Return the LINK with DESC converted into html or markdown FORMAT. 47 | If LINK is not found, just return it as is." 48 | (if (blk-find-by-id link) 49 | (let* ((linked-file (plist-get (car (blk-find-by-id link)) :filepath)) 50 | (desc (or desc link)) 51 | (linked-file-no-ext (file-name-sans-extension (org-export-file-uri linked-file)))) 52 | (cond 53 | ((eq format 'html) (format "%s" linked-file-no-ext link desc)) 54 | ((eq format 'md) (format "[%s](%s.md)" desc linked-file-no-ext)) 55 | ((eq format 'latex) (format "\\hyperref[%s]{%s}" link (or desc link))) 56 | (t link))) 57 | link)) 58 | 59 | (defun blk-org-transclusion (link plist) 60 | "Return an `org-transclusion' list for blk LINK and PLIST. 61 | Return nil if not found." 62 | (when (string= "blk" (org-element-property :type link)) 63 | (let* ((id (org-element-property :path link)) 64 | (result (ignore-errors (car (blk-find-by-id id)))) 65 | (payload '(:tc-type "org-link"))) 66 | (if result 67 | (progn 68 | ;; For now we can't work without keeping the file opened in 69 | ;; an emacs buffer (this is how org-transclusion handles 70 | ;; things) 71 | (find-file-noselect (plist-get result :filepath)) 72 | (with-current-buffer 73 | (find-buffer-visiting (plist-get result :filepath)) 74 | (goto-char (plist-get result :position)) 75 | (append payload 76 | (funcall (plist-get (plist-get result :matched-pattern) :transclusion-function) 77 | result)))) 78 | (progn (message (format "No transclusion done for this blk. Ensure it works at point %d, line %d." 79 | (point) (org-current-line))) 80 | nil))))) 81 | 82 | (defun blk-org-id-at-point (grep-data) 83 | "Get the id to the org element at point. 84 | If no id can be found, interactively select one from the results of 85 | calling grep using GREP-DATA." 86 | (let* ((elm (org-element-at-point)) 87 | ;; block-name isnt necessarily gonna be defined, may be nil when its not 88 | ;; a block we're at, or if the block we're at doesnt define a :name 89 | (block-name 90 | (or (org-element-property :name (org-element-at-point)) ;; for #+name: keyword before block 91 | (alist-get ;; for :name in #+begin_something :name... 92 | :name 93 | (org-babel-parse-header-arguments 94 | (org-element-property :parameters elm) 95 | t))))) 96 | (when elm 97 | (let* ((elm-type (org-element-type elm)) 98 | (id (cond 99 | ;; if we are at a block and it has a name, return that, otherwise return the link to the file 100 | ((and (member elm-type '(special-block latex-environment src-block)) block-name) 101 | block-name) 102 | ;; for links to files, through org-id or denote #+identifier 103 | ((or (eq elm-type 'keyword) 104 | (and (eq elm-type 'special-block) 105 | (not block-name))) 106 | (or 107 | ;; for denote 108 | (car (alist-get 109 | "IDENTIFIER" 110 | (org-collect-keywords '("identifier")) 111 | nil nil 'string=)) 112 | ;; for an org id (with or without org-roam) 113 | (org-id-get))) 114 | ;; if we are at a header, return its id (might return nil or id of file if header doesnt have id) 115 | ((eq elm-type 'headline) (org-id-get))))) 116 | id)))) 117 | 118 | (defun blk-org-transclusion-at-point (grep-data) 119 | "Function that return a DWIM org-transclusion plist. 120 | the plist returned represents an org-transclusion object which is then passed to 121 | org-transclusion to be handled for transclusion in an org buffer." 122 | (let ((elm (org-element-at-point))) 123 | (when elm 124 | (let* ((elm-type (org-element-type elm))) 125 | (cond 126 | ;; handler for custom/src org-blocks 127 | ((or (eq elm-type 'special-block) (eq elm-type 'src-block)) 128 | (list :src-content (buffer-substring (org-element-property :begin elm) 129 | (org-element-property :end elm)) 130 | :src-buf (current-buffer) 131 | :src-beg (org-element-property :begin elm) 132 | :src-end (org-element-property :end elm))) 133 | ;; handler for latex blocks identified by #+name 134 | ((eq elm-type 'latex-environment) 135 | (progn 136 | (forward-line) 137 | (blk-tex-transclusion-env-at-point grep-data))) 138 | ((and (equal elm-type 'keyword) 139 | (equal (org-element-property :key elm) "IDENTIFIER")) 140 | ;; skip over the file keywords 141 | (save-excursion 142 | (let ((no-text)) 143 | (while (and (equal (org-element-type (org-element-at-point)) 'keyword) 144 | (not no-text)) 145 | ;; check if we are at the last line 146 | (if (eq (line-number-at-pos) 147 | (line-number-at-pos (point-max))) 148 | (setq no-text t) 149 | (forward-line))) 150 | ;; file contains no text except the keywords, dont transclude 151 | (when (not no-text) 152 | (list :src-content (buffer-substring (point) 153 | (point-max)) 154 | :src-buf (current-buffer) 155 | :src-beg (point) 156 | :src-end (point-max))))))))))) 157 | 158 | (defun blk-org-named-target-value (str) 159 | "For an STR equal to <<>>, returns my-target." 160 | (substring str 3 -3)) 161 | 162 | (defalias 163 | 'blk-open-at-point 164 | 'org-open-at-point-global 165 | "A convenience alias to `org-open-at-point-global', works in any major mode.") 166 | 167 | ;; Required for blk-open-at-point to work 168 | (blk-configure-org-link) 169 | 170 | (provide 'blk-org) 171 | ;;; blk-org.el ends here 172 | -------------------------------------------------------------------------------- /blk-pkg.el: -------------------------------------------------------------------------------- 1 | (define-package 2 | "blk" 3 | "0.0.2" 4 | "Rapidly create and follow links across text files") 5 | -------------------------------------------------------------------------------- /blk.el: -------------------------------------------------------------------------------- 1 | ;;; blk.el --- Rapidly create and follow links across text files -*- lexical-binding: t; -*- 2 | 3 | ;; Author: Mahmood Sheikh 4 | ;; Keywords: lisp 5 | ;; Version: 0.0.2 6 | 7 | ;; Copyright (C) 2024 Mahmood Sheikh and Bob Weiner 8 | 9 | ;; SPDX-License-Identifier: GPL-3.0-or-later 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;; This package is for making arbitrary links across text files. 26 | 27 | ;;; Code: 28 | (require 'subr-x) 29 | (require 'cl-lib) 30 | 31 | (require 'blk-org) 32 | 33 | (defcustom blk-directories (list (expand-file-name "~/notes/") 34 | user-emacs-directory) 35 | "Blk directories within which to find files and grep them for ID's and titles.") 36 | 37 | (defcustom blk-search-recursively nil 38 | "Non-nil means to invoke greppers recursively in `blk-directories'. 39 | Default is nil; changing it may have severe consequences on speed.") 40 | 41 | (defcustom blk-enable-groups nil 42 | "Non-nil means to construct groups (or outlines) in `blk-find' during search according to 43 | the rules defined in `blk-groups'. Default is nil; changing it may have severe 44 | consequences on speed as the current method runs slowly. 45 | 46 | a quick benchmark on my machine speaks volumes: 47 | with `blk-enable-groups` set to `t` 48 | (benchmark-run (blk-list-titles)) ; => (0.577957745 2 0.31831121999999823) 49 | with `blk-enable-groups` set to `nil` 50 | (benchmark-run (blk-list-titles)) ; => (0.295143048 1 0.15662816200000407)") 51 | 52 | (defcustom blk-use-cache nil 53 | "Setting to `non-nil' means to use a memory cache. 54 | This causes blk to use a memory cache to avoid having to run grep everytime 55 | completion is required which makes the completion functionality more responsive. 56 | Caching only starts the first time completion is requested, by the function 57 | `blk-list-titles'. 58 | The interval for running the grep commands and caching the results is controlled 59 | by `blk-cache-update-interval'.") 60 | 61 | (defcustom blk-cache-update-interval 10 62 | "The interval between updates of the memory cache, in seconds. 63 | this is only meaningful when `blk-use-cache' is `non-nil'") 64 | 65 | (defvar blk-cache nil 66 | "A list that acts as a cache for the grep results, see `blk-use-cache'.") 67 | 68 | (defvar blk-cache-timer nil 69 | "A timer returned by `run-with-timer', used for the caching functionality.") 70 | 71 | (defcustom blk-treat-titles-as-ids t 72 | "Whether to enable identifying entries by their titles. 73 | 74 | Non-nil means enable this feature (e.g. you can use a link like [[blk:entry-title]]). 75 | This may have undesirable effects since two different entries can have 76 | the same title, which is why id's are useful in the first place.") 77 | 78 | (defvar blk-hist nil 79 | "History list, passed to `completing-read'") 80 | 81 | ;; rules for the "emacs grepper" 82 | (defvar blk-emacs-org-file-rule 83 | (list :shared-name 'blk-org-file-rule 84 | :title "org file" 85 | :anchor-regex "\\(#\\+title:\\|#\\+alias:\\)\s+[^\n:]+" 86 | :title-function 'blk-value-after-space 87 | :extract-id-function 'blk-org-id-at-point 88 | :glob "*.org") 89 | "Used in `blk-emacs-patterns' to match titles of org files. 90 | consult the documentation of `blk-patterns' for the keywords.") 91 | (defvar blk-emacs-org-block-rule 92 | (list :shared-name 'blk-org-block-rule 93 | :title "org block" 94 | :anchor-regex "\\(:title\\|:alias\\|:name\\|#\\+name:\\)\s+[^\n:]+" 95 | :title-function 'blk-value-after-space 96 | :extract-id-function 'blk-org-id-at-point 97 | :glob "*.org") 98 | "Used in `blk-emacs-patterns' to match titles of org blocks. 99 | consult the documentation of `blk-patterns' for the keywords.") 100 | (defvar blk-emacs-elisp-function-rule 101 | (list :title "elisp function" 102 | :glob "*.el" 103 | :anchor-regex "^(defun\s+[^\s]+" 104 | :title-function 'blk-value-after-space) 105 | "Used in `blk-emacs-patterns' to match names of elisp functions. 106 | consult the documentation of `blk-patterns' for the keywords.") 107 | (defvar blk-emacs-org-header-rule 108 | (list :shared-name 'blk-org-header-rule 109 | :title "org header" 110 | :glob "*.org" 111 | :anchor-regex "^\\*+ .*" 112 | :title-function 'blk-value-after-space 113 | :extract-id-function 'blk-org-id-at-point) 114 | "Used in `blk-emacs-patterns' to match org headings. 115 | consult the documentation of `blk-patterns' for the keywords.") 116 | (defvar blk-emacs-org-id-rule 117 | (list :glob "*.org" 118 | :anchor-regex "^:ID:\\s*.*" 119 | :src-id-function 'blk-org-id-value) 120 | "Used in `blk-emacs-patterns' to match ids of org headings or files. 121 | consult the documentation of `blk-patterns' for the keywords.") 122 | (defvar blk-emacs-org-link-rule 123 | (list :glob "*.org" 124 | :anchor-regex org-link-any-re 125 | :dest-id-function 'blk-org-link-path) 126 | "Used in `blk-emacs-patterns' to match links in org-mode files. 127 | consult the documentation of `blk-patterns' for the keywords.") 128 | (defvar blk-emacs-identifier-rule 129 | (list :shared-name 'blk-org-file-rule 130 | :glob "*.org" 131 | :anchor-regex "#\\+identifier:\s+.*" 132 | :src-id-function 'blk-value-after-colon) 133 | "Used in `blk-emacs-patterns' to match ids (similar to those inserted by denote) of org-mode files. 134 | consult the documentation of `blk-patterns' for the keywords.") 135 | (defvar blk-emacs-latex-label-rule 136 | (list :title "latex label" 137 | :glob '("*.org" "*.tex") 138 | :anchor-regex "\\\\label{[^\\{\\}]*}" 139 | :src-id-function 'blk-latex-label-id 140 | :title-function 'blk-latex-label-id 141 | :transclusion-function 'blk-tex-transclusion-env-at-point) 142 | "Used in `blk-emacs-patterns' to match latex labels 143 | consult the documentation of `blk-patterns' for the keywords.") 144 | (defvar blk-emacs-org-block-name-rule 145 | (list :shared-name 'blk-org-block-rule 146 | :title "id anchor for org named block" 147 | :glob "*.org" 148 | :anchor-regex "#\\+name:\s+.*|:name\s+[^\n:]*" 149 | :src-id-function 'blk-value-after-space-upto-colon 150 | :transclusion-function 'blk-org-transclusion-at-point) 151 | "Used in `blk-emacs-patterns' to match names of org-mode blocks 152 | consult the documentation of `blk-patterns' for the keywords.") 153 | (defvar blk-emacs-md-header-rule 154 | (list :shared-name 'blk-md-header-rule 155 | :title "markdown header" 156 | :glob "*.md" 157 | :anchor-regex "^#+ .*" 158 | :title-function 'blk-value-after-space) 159 | "Used in `blk-emacs-patterns' to match markdown headings. 160 | consult the documentation of `blk-patterns' for the keywords.") 161 | (defvar blk-emacs-org-named-target-rule 162 | (list :shared-name 'blk-org-named-target-rule 163 | :title "named target" 164 | :glob "*.org" 165 | :anchor-regex "<<<.*?>>>" 166 | :src-id-function 'blk-org-named-target-value 167 | :title-function 'blk-org-named-target-value) 168 | "Used in `blk-emacs-patterns' to match named targets. 169 | named targets are arbitrarily placed targets in the format of <<>>. 170 | consult the documentation of `blk-patterns' for the keywords.") 171 | 172 | (defcustom blk-emacs-patterns 173 | (list blk-emacs-org-file-rule 174 | blk-emacs-org-block-rule 175 | blk-emacs-elisp-function-rule 176 | blk-emacs-org-header-rule 177 | blk-emacs-org-id-rule 178 | blk-emacs-org-link-rule 179 | blk-emacs-identifier-rule 180 | blk-emacs-latex-label-rule 181 | blk-emacs-org-block-name-rule 182 | blk-emacs-md-header-rule 183 | blk-emacs-org-named-target-rule) 184 | "The pattern table for the elisp grepper; see documentation for `blk-patterns'.") 185 | 186 | ;; rules for ripgrep 187 | (defvar blk-rg-org-file-rule 188 | (list :shared-name 'blk-org-file-rule 189 | :title "org file" 190 | :glob "*.org" 191 | :anchor-regex "^(#\\+title:|#\\+alias:)\\s+[^:]+" 192 | :title-function 'blk-value-after-space 193 | :extract-id-function #'blk-org-id-at-point) 194 | "Used in `blk-rg-patterns' to match titles of org files. 195 | consult the documentation of `blk-patterns' for the keywords.") 196 | (defvar blk-rg-org-block-rule 197 | (list :shared-name 'blk-org-block-rule 198 | :title "org block" 199 | :glob "*.org" 200 | :anchor-regex "(:title|:alias|:name|#\\+name:)\\s+[^:]+" 201 | :title-function 'blk-value-after-space 202 | :extract-id-function #'blk-org-id-at-point) 203 | "Used in `blk-rg-patterns' to match titles of org blocks. 204 | consult the documentation of `blk-patterns' for the keywords.") 205 | (defvar blk-rg-elisp-function-rule 206 | (list :title "elisp function" 207 | :glob "*.el" 208 | :anchor-regex "^\\(defun\\s+\\S+" 209 | :title-function 'blk-value-after-space) 210 | "Used in `blk-rg-patterns' to match names of elisp functions. 211 | consult the documentation of `blk-patterns' for the keywords.") 212 | (defvar blk-rg-org-header-rule 213 | (list :shared-name 'blk-org-header-rule 214 | :title "org header" 215 | :glob "*.org" 216 | :anchor-regex "^\\*+\\s.*" 217 | :title-function 'blk-value-after-space 218 | :extract-id-function 'blk-org-id-at-point) 219 | "Used in `blk-rg-patterns' to match org headings. 220 | consult the documentation of `blk-patterns' for the keywords.") 221 | (defvar blk-rg-org-id-rule 222 | (list :glob "*.org" 223 | :anchor-regex "^:ID:\\s*.*" 224 | :src-id-function 'blk-org-id-value) 225 | "Used in `blk-rg-patterns' to match ids of org headings or files. 226 | consult the documentation of `blk-patterns' for the keywords.") 227 | (defvar blk-rg-org-link-rule 228 | (list :glob "*.org" 229 | :anchor-regex "\\[\\[[a-z]+:[^\\[\\]]+\\]\\]|\\[\\[[a-z]+:[^\\[\\]]+\\]\\[[^\\[\\]]+\\]\\]" 230 | :dest-id-function 'blk-org-link-path) 231 | "Used in `blk-rg-patterns' to match links in org-mode files. 232 | consult the documentation of `blk-patterns' for the keywords.") 233 | (defvar blk-rg-identifier-rule 234 | (list :shared-name 'blk-org-file-rule 235 | :glob "*.org" 236 | :anchor-regex "#\\+identifier:\\s+.*" 237 | :src-id-function 'blk-value-after-colon 238 | :transclusion-function 'blk-org-transclusion-at-point) 239 | "Used in `blk-rg-patterns' to match ids (similar to those inserted by denote.el) of org-mode files. 240 | consult the documentation of `blk-patterns' for the keywords.") 241 | (defvar blk-rg-latex-label-rule 242 | (list :title "latex label" 243 | :glob (list "*.org" "*.tex") 244 | :anchor-regex "\\\\\\\\label\\\\{[^\\\\{\\\\}]*\\\\}" 245 | :src-id-function 'blk-latex-label-id 246 | :title-function 'blk-latex-label-id 247 | :transclusion-function 'blk-tex-transclusion-env-at-point) 248 | "Used in `blk-rg-patterns' to match latex labels 249 | consult the documentation of `blk-patterns' for the keywords.") 250 | (defvar blk-rg-org-block-name-rule 251 | (list :shared-name 'blk-org-block-rule 252 | :title "id anchor for org named block" 253 | :glob "*.org" 254 | :anchor-regex "#\\+name:\\s+.*|:name\\s+[^:]*" 255 | :src-id-function 'blk-value-after-space-upto-colon 256 | :transclusion-function 'blk-org-transclusion-at-point) 257 | "Used in `blk-rg-patterns' to match names of org-mode blocks 258 | consult the documentation of `blk-patterns' for the keywords.") 259 | (defvar blk-rg-md-header-rule 260 | (list :shared-name 'blk-md-header-rule 261 | :title "markdown header" 262 | :glob "*.md" 263 | :anchor-regex "^#+\\s.*" 264 | :title-function 'blk-value-after-space) 265 | "Used in `blk-rg-patterns' to match markdown headings. 266 | consult the documentation of `blk-patterns' for the keywords.") 267 | (defvar blk-rg-org-named-target-rule 268 | (list :shared-name 'blk-org-named-target-rule 269 | :title "named target" 270 | :glob "*.org" 271 | :anchor-regex "<<<.*?>>>" 272 | :src-id-function 'blk-org-named-target-value 273 | :title-function 'blk-org-named-target-value) 274 | "Used in `blk-rg-patterns' to match named targets. 275 | named targets are arbitrarily placed targets in the format of <<>>. 276 | consult the documentation of `blk-patterns' for the keywords.") 277 | 278 | (defcustom blk-rg-patterns 279 | (list blk-rg-org-file-rule 280 | blk-rg-org-block-rule 281 | blk-rg-elisp-function-rule 282 | blk-rg-org-header-rule 283 | blk-rg-org-id-rule 284 | blk-rg-org-link-rule 285 | blk-rg-identifier-rule 286 | blk-rg-latex-label-rule 287 | blk-rg-org-block-name-rule 288 | blk-rg-md-header-rule 289 | blk-rg-org-named-target-rule) 290 | "The pattern table for ripgrep; see documentation for `blk-patterns'.") 291 | 292 | ;; grep -E plays well with ripgrep regex's so as far as i can tell no extra work is needed 293 | (defcustom blk-grep-patterns 294 | blk-rg-patterns 295 | "The pattern table for `blk-grepper-grep'.") 296 | 297 | (defcustom blk-groups 298 | (list (list :title "org mode file/header outline" 299 | :title-group-function 'join-with-slash 300 | :rules '(blk-org-file-rule 301 | blk-org-header-rule)) 302 | (list :title "org mode file/header/block outline" 303 | :title-group-function 'join-with-slash 304 | :rules '(blk-org-file-rule 305 | blk-org-header-rule 306 | blk-org-block-rule)) 307 | (list :title "org mode file/block outline" 308 | :title-group-function 'join-with-slash 309 | :rules '(blk-org-file-rule 310 | blk-org-block-rule))) 311 | "group titles together for full outlines when navigating them") 312 | 313 | (defcustom blk-ignored-files 314 | nil 315 | "A list of files (or regex patterns describing filepaths) that are ignored 316 | when collecting entries.") 317 | 318 | (defun join-with-slash (strings) 319 | "Join STRINGS with forward slash." 320 | (string-join strings "/")) 321 | 322 | ;; Support insertion into editable non-file buffers too. 323 | (defcustom blk-insert-patterns 324 | (list (list :mode-list '(auctex-mode latex-mode tex-mode) 325 | :id-format "\\ref{blk:%i}") 326 | ;; By default, match to any other major-mode 327 | (list :mode-list nil 328 | :id-format "[[blk:%o]]")) 329 | "The patterns for inserting links. 330 | :mode-list is for matching buffer major modes. 331 | id-format is for inserting the link into a buffer. 332 | %i will be replaced by the target id. 333 | %o will use Org link format to include both the id and title, when given. 334 | %t will be replaced by the target title, when given.") 335 | 336 | (defcustom 337 | blk-tex-env-at-point-function 338 | #'blk-naive-env-at-point-bounds 339 | "Could be one of `blk-auctex-env-at-point-bounds', `blk-naive-env-at-point-bounds' (the former 340 | may be more \"sophisticated\"). has to be a function that returns a cons of the from 341 | (beginning . end) for the start/end position of the latex environment at point, respectively. 342 | used for transclusion of latex environments") 343 | 344 | (defun blk-auctex-env-at-point-bounds () 345 | "Get the boundaries of the latex environment at point using auctex, errors out if 346 | auctex isnt installed and loaded. errors out if theres no latex environment at point. 347 | Returns a cons of the from (beginning . end) for the start/end position of the latex environment 348 | at point, respectively." 349 | (save-excursion 350 | (forward-char) ;; without this auctex cant find the environment for some reason 351 | (LaTeX-find-matching-begin) 352 | (let ((begin (point))) 353 | (forward-char) ;; same as comment above 354 | (LaTeX-find-matching-end) 355 | (cons begin (point))))) 356 | 357 | (defun blk-naive-env-at-point-bounds () 358 | "Get the boundaries of the latex environment at point using a simple regex search, 359 | Returns a cons of the from (beginning . end) for the start/end position of the latex environment 360 | at point, respectively. errors out if it fails to find a latex environment." 361 | (save-excursion 362 | (search-backward "\\begin{") 363 | (let ((begin (point))) 364 | (re-search-forward "\\\\end{[^{}]+}") 365 | (goto-char (match-end 0)) 366 | (let ((end (point))) 367 | (cons begin end))))) 368 | 369 | (defun blk-tex-transclusion-env-at-point (grep-data) 370 | "Function that returns the latex environment the cursor is in. 371 | the plist returned represents an org-transclusion object which is then passed to 372 | org-transclusion to be handled for transclusion in an org buffer. 373 | this currently doesnt do anything being looking for the regex corresponding 374 | to a \\begin and \\end, which isnt the smartest way of doing it, but as long 375 | as the destination \\label{ID} is present in a latex environment the function 376 | works as intended. syntax like \\[ \\] isnt yet handled. 377 | the argument GREP-DATA is the result returned from the search for ID 378 | it is unused and may be ignored, but since the function is called with it 379 | we have to keep it defined this way. 380 | returns a plist that is then passed to org-transclusion" 381 | (let* ((bounds (funcall blk-tex-env-at-point-function)) 382 | (begin (car bounds)) 383 | (end (cdr bounds))) 384 | (list :src-content (format "%s\n" (buffer-substring begin end)) ;; org-transclusion doesnt insert a newline 385 | :src-buf (current-buffer) 386 | :src-beg begin 387 | :src-end end))) 388 | 389 | (defun blk-value-after-space (str) 390 | (string-trim (string-join (cdr (split-string str " ")) " "))) 391 | 392 | (defun blk-org-link-path (org-link-text) 393 | "Parse the text of an org link and return the id (path) it links to." 394 | ;; if a link doesnt contain a colon dont try to parse it 395 | (when (cl-search ":" org-link-text) 396 | (string-trim (car (split-string (cadr (split-string org-link-text ":")) "]"))))) 397 | 398 | (defun blk-org-id-value (org-id-text) 399 | (string-trim (caddr (split-string org-id-text ":")))) 400 | 401 | (defun blk-value-after-colon (text) 402 | (string-trim (cadr (split-string text ":")))) 403 | 404 | (defun blk-latex-label-id (text) 405 | (string-trim (car (split-string (cadr (split-string text "{")) "}")))) 406 | 407 | (defun blk-value-after-space-upto-colon (str) 408 | (string-trim (car (split-string (blk-value-after-space str) " :")))) 409 | 410 | (defconst 411 | blk-grepper-grep 412 | ;; the 'eval' trickery is there because grep doesnt accept directories to search in, 413 | ;; it only accepts files, so here we're expanding the glob in the shell itself 414 | ;; before passing the paths to grep, we dont pass the raw list of files as arguments 415 | ;; because it may cause an overflow in the buffer that holds the arguments 416 | ;; to the command (i have experienced it before implementing this solution). 417 | '(:command "grep -E -e \"%r\" $(eval echo $(printf ' %%s*.* ' %f)) --line-number --ignore-case --byte-offset --only-matching -d skip" 418 | :delimiter ":" 419 | :glob-arg "--include " 420 | :recursive-arg "-R") 421 | "The \"grepper\" definition for gnu grep (from coreutils), with the -E flag.") 422 | 423 | (defconst 424 | blk-grepper-rg 425 | (list :command "rg --max-depth 1 --field-match-separator '\t' --regexp \"%r\" %f --no-heading --line-number --ignore-case --byte-offset --only-matching --with-filename" 426 | :delimiter "\t" 427 | :glob-arg "--glob " 428 | :recursive-arg "--max-depth 10000") ;; rg can handle a duped arg, the latter overrides the former. 429 | "The \"grepper\" definition for ripgrep.") 430 | 431 | (defun blk-choose-grepper () 432 | "Choose a blk grepper based on a search of `exec-path'. 433 | If none are found, default to the `blk-grepper-emacs' function." 434 | (cond 435 | ((locate-file "rg" exec-path) blk-grepper-rg) 436 | ((locate-file "grep" exec-path) blk-grepper-grep) 437 | (_ 'blk-grepper-emacs))) 438 | 439 | (defcustom blk-grepper 440 | (blk-choose-grepper) 441 | "The program for blk to use for grepping files. 442 | Could be a function that takes as arguments the patterns and files, or 443 | a string representing a shell command to be formatted with the regex 444 | to grep for, together with the file list. 445 | See the function `blk-run-grep-cmd' for what the plist needs to contain if a grep shell 446 | command is to be used.") 447 | 448 | (defcustom blk-patterns 449 | (pcase (blk-choose-grepper) 450 | (blk-grepper-rg blk-rg-patterns) 451 | (blk-grepper-grep blk-grep-patterns) 452 | ('blk-grepper-emacs blk-emacs-patterns)) 453 | "The list of patterns to use with the blk grepper. 454 | Each entry should be a plist representing the data of a pattern: 455 | :title is the title/type of the pattern (used for completing-read). 456 | :glob is the glob pattern to matches files to be grepped. 457 | :anchor-regex is the regex for matching blocks of text that contain 458 | the target value which is then passed to :title-function to be 459 | turned into the final desired value to be passed to completing-read 460 | to serve as the entry in the completing-read menu for the target. 461 | :src-id-function is the function that gets the id to be used when 462 | creating links to the target; the need for :src-id-function over 463 | :title-function is that an id and a name/title for a target can be 464 | different, as an id can be a random sequence but a name could be 465 | a more memorable sequence of characters. the function takes the matched 466 | value and strips unnecessary turning it into just the id, 467 | think \\label{my-id} -> my-id 468 | :title-function is a function that takes as an argument the matched 469 | text and extracts the title from it. 470 | think \"#+title: my-title\" -> \"my-title\". 471 | :transclusion-function is a function that should take 472 | the match and return an object or plist that can be handled by 473 | org-transclusion, this allows for easily defining custom transclusion 474 | functions for different patterns of text. see the function 475 | `blk-org-trancslusion-at-point' for an example. 476 | :extract-id-function is a function that, given a title, opens the 477 | destination entry using the gathered metadata and grabs the id 478 | that corresponds to a particular entry. for example, given a 479 | result that matched the title of an org file, this function 480 | is called after opening the org file, the grep-result is passed 481 | to it, it should return the id of the org file that was opened. 482 | this is needed because when grepping we cant tell which id is 483 | is associated with which title (even if they're in the same file 484 | or belong to the same portion of text).") 485 | 486 | (defmacro blk-with-file-as-current-buffer (file &rest body) 487 | "Macro that reads FILE into the current buffer and executes BODY." 488 | (let ((present-buffer (gensym)) 489 | (result (gensym))) 490 | `(let ((,present-buffer (find-buffer-visiting ,file))) 491 | (save-excursion 492 | (with-current-buffer (find-file-noselect ,file) 493 | (setq ,result (progn ,@body)) 494 | (when (not ,present-buffer) 495 | (kill-buffer (current-buffer))) 496 | ,result))))) 497 | 498 | (defun blk-grepper-emacs (pattern-table directories) 499 | "Function that reads patterns from PATTERN-TABLE and greps for them in DIRECTORIES." 500 | (let ((results)) 501 | (dolist (pattern pattern-table) 502 | (let ((globs (plist-get pattern :glob))) 503 | (when (atom globs) 504 | (setq globs (list globs))) 505 | (let* ((files (apply 'append (mapcar (lambda (glob) (blk-list-files directories glob)) globs))) 506 | (all-files 507 | (delete-dups 508 | (append 509 | (apply 510 | 'append 511 | (mapcar 512 | (lambda (glob) 513 | (mapcar 'buffer-file-name (blk-list-buffers glob))) 514 | globs)) 515 | files)))) 516 | (dolist (filepath all-files) 517 | (let ((buf (find-buffer-visiting filepath))) 518 | ;; if file isnt already opened in some buffer, we open it ourselves, we dont use `find-file-noselect' as using `insert-file-contents' makes the code run alot faster 519 | (when (not buf) 520 | (setq buf (get-buffer-create " blk")) 521 | (with-current-buffer buf 522 | (delete-region (point-min) (point-max)) 523 | (insert-file-contents filepath))) 524 | (with-current-buffer buf 525 | (let ((matches (blk-string-search-regex (plist-get pattern :anchor-regex) 526 | (substring-no-properties (buffer-string))))) 527 | (dolist (match matches) 528 | (push (list :position (1+ (cdr match)) 529 | :filepath filepath 530 | :matched-value (car match) 531 | :matched-pattern pattern) 532 | results))))))))) 533 | results)) 534 | 535 | (defun blk-string-search-regex (regex str) 536 | "Return matches of REGEX found in STR as a list of conses of the form (match . position)." 537 | (let ((pos 0) 538 | (matches)) 539 | (cl-loop for match-pos = (string-match regex str pos) 540 | while match-pos do 541 | (push (cons (match-string 0 str) match-pos) matches) 542 | (setq pos (1+ match-pos))) 543 | matches)) 544 | 545 | (defun blk-list-files (directories glob) 546 | "Return a list of files in `blk-directories' for grepping links/references. 547 | For when `blk-grepper-emacs' is used. 548 | Recurse subdirectories if `blk-search-recursively' is non-nil." 549 | (let ((files)) 550 | (dolist (dir directories) 551 | (setq files 552 | (append files 553 | (if blk-search-recursively 554 | (mapcar (lambda (filename) (expand-file-name filename dir)) 555 | (directory-files-recursively dir (wildcard-to-regexp glob))) 556 | (directory-files dir t (wildcard-to-regexp glob)))))) 557 | files)) 558 | 559 | (defun blk-list-buffers (glob) 560 | "List buffers matching GLOB for searching when `blk-grepper-emacs' is used." 561 | (cl-remove-if-not 562 | (lambda (buf) 563 | (when (buffer-file-name buf) 564 | (string-match-p (wildcard-to-regexp glob) (buffer-file-name buf)))) 565 | (buffer-list))) 566 | 567 | (defun blk-update-cache () 568 | "Update the cache results stored in `blk-cache'." 569 | (interactive) 570 | (setq blk-cache (blk-collect-all))) 571 | 572 | (defun blk-list-titles-helper (data) 573 | "List all titles in DATA as propertized strings." 574 | (let* ((grep-results 575 | (cl-remove-if-not 576 | (lambda (grep-result) 577 | (let* ((title (plist-get grep-result :title))) 578 | (and title (not (string-empty-p (string-trim title)))))) 579 | data)) 580 | (groups (if blk-enable-groups (blk-group-entries grep-results) nil)) 581 | (entries (mapcar (lambda (grep-result) 582 | (propertize (plist-get grep-result :title) 583 | 'grep-data grep-result)) 584 | (append grep-results groups)))) 585 | entries)) 586 | 587 | (defun blk-list-titles () 588 | "List all the pattern matches found in the blk files, as propertized strings. 589 | each string is a title, with the property `grep-data' set to the match data." 590 | (let ((titles)) 591 | ;; if we have cached results, use those 592 | (when blk-use-cache 593 | ;; if we dont have cached results and the timer isnt set, fetch the results then start a new timer 594 | (when (not blk-cache-timer) 595 | (blk-update-cache) 596 | (setq blk-cache-timer (run-with-timer blk-cache-update-interval 597 | blk-cache-update-interval 598 | #'blk-update-cache))) 599 | (setq titles (blk-list-titles-helper blk-cache))) 600 | (when (not titles) 601 | ;; this would run if cache isnt enabled 602 | (setq titles (blk-list-titles-helper (blk-collect-all)))) 603 | titles)) 604 | 605 | (defun blk-group-entries (grep-results) 606 | "Given GREP-RESULTS, construct groupings (or outlines, if you will) out of them. 607 | the groupings rules are defined in `blk-groups'" 608 | (let* ((files-entries) ;; maps each file to its entries 609 | (final-groups)) 610 | (dolist (result grep-results) 611 | (let* ((result-file (plist-get result :filepath)) 612 | (file-entry (assoc result-file files-entries #'string=))) 613 | (if file-entry 614 | (push result (cdr file-entry)) 615 | (push (cons result-file (list result)) files-entries)))) 616 | ;; sort the grep entries of each file by their positions 617 | (dolist (file-entries files-entries) 618 | (setcdr file-entries 619 | (cl-sort (cdr file-entries) 620 | '< 621 | :key (lambda (entry) (plist-get entry :position))))) 622 | ;; gather the groups 623 | (dolist (group blk-groups) 624 | (dolist (file-entries files-entries) 625 | (let* ((group-rules (plist-get group :rules)) 626 | (first-rule (car group-rules)) 627 | (last-rule (car (last group-rules))) 628 | (new-groups)) 629 | (dolist (entry file-entries) 630 | (let ((prev-rule)) 631 | (dolist (group-rule group-rules) 632 | (when (equal group-rule 633 | (plist-get (plist-get entry :matched-pattern) 634 | :shared-name)) 635 | (if (equal group-rule first-rule) 636 | ;; create a new group 637 | (let ((new-group (copy-tree group))) 638 | (plist-put new-group :grep-entries (list entry)) 639 | (push new-group new-groups)) 640 | ;; append the entry onto existent groups 641 | (dolist (new-group new-groups) 642 | (let ((allow t)) 643 | (when (equal prev-rule 644 | (plist-get 645 | (plist-get 646 | (car (last (plist-get new-group :grep-entries))) 647 | :matched-pattern) 648 | :shared-name)) 649 | ;; check if this entry belongs to another group and not this one 650 | (dolist (other-new-group new-groups) 651 | (when (and (equal prev-rule 652 | (plist-get 653 | (plist-get 654 | (car (last (plist-get other-new-group 655 | :grep-entries))) 656 | :matched-pattern) 657 | :shared-name)) 658 | (> (plist-get entry :position) 659 | (plist-get 660 | (car (last (plist-get other-new-group 661 | :grep-entries))) 662 | :position)) 663 | (> (plist-get 664 | (car (last (plist-get other-new-group 665 | :grep-entries))) 666 | :position) 667 | (plist-get 668 | (car (last (plist-get new-group 669 | :grep-entries))) 670 | :position))) 671 | (setq allow nil))) 672 | ;; we have to make a copy because other entries have to make use 673 | ;; of the "incomplete" grouping 'new-group', if we delete it 674 | ;; after one use then we'd be disregarding all entries that would 675 | ;; complement it except the first. 676 | (when allow 677 | (let ((new-new-group (copy-tree new-group))) 678 | (plist-put new-new-group 679 | :grep-entries 680 | (append (plist-get new-group :grep-entries) 681 | (list entry))) 682 | (if (equal group-rule last-rule) 683 | (push new-new-group final-groups) 684 | (push new-new-group new-groups))))))))) 685 | (setq prev-rule group-rule))))))) 686 | ;; make the final groups of grep-result entries resemble grep-result entries of thsemselves, so that they can be handled as such by blk-find or other functions that accept grep-result entries, perhaps not the best way to go about it in terms of code readability. 687 | (dolist (final-group final-groups) 688 | (let* ((final-group-grep-entries (plist-get final-group :grep-entries)) 689 | (titles (mapcar (lambda (grep-result) 690 | (plist-get grep-result :title)) 691 | final-group-grep-entries)) 692 | (titles-func (plist-get final-group :title-group-function)) 693 | (last-grep-entry-in-group (elt final-group-grep-entries 694 | (1- (length final-group-grep-entries))))) 695 | (plist-put final-group :title (funcall titles-func titles)) 696 | (plist-put final-group :position (plist-get last-grep-entry-in-group :position)) 697 | (plist-put final-group :filepath (plist-get last-grep-entry-in-group :filepath)))) 698 | final-groups)) 699 | 700 | (defun blk-str-list-matches (regex str-list) 701 | "Return a list of the strings matching REGEX in STR-LIST." 702 | (cl-remove-if-not 703 | (lambda (str) 704 | (string-match regex str)) 705 | str-list)) 706 | 707 | (defun blk-run-grep-cmd (cmd patterns directories) 708 | "Run a grep-like CMD matching any PATTERNS across a list of DIRECTORIES. 709 | Return a list of lists of key-value pairs of the form: 710 | '(:matched-value 711 | :position 712 | :line-number 713 | :matched-pattern 714 | :filepath ). 715 | CMD is a plist where :command is the shell command and :delimiter is the delimiter in the output, 716 | :glob-arg is the argument of the grep command that takes a glob for filename matching, 717 | see `blk-grepper-grep' as an example of CMD. 718 | The result of CMD should contain lines of the form [filepath][line][position][match] where 719 | sep is the property :delimiter of the plist CMD" 720 | (let* (full-cmd 721 | matches 722 | out 723 | sep 724 | line-entries 725 | filepath 726 | line-number 727 | position 728 | match-text 729 | got-error 730 | globs 731 | exit-code 732 | (glob-arg (plist-get cmd :glob-arg)) 733 | (recursive-arg (plist-get cmd :recursive-arg)) 734 | (bfr-name " blk-out") ;; we use this (internal) buffer to grab the results of call-process 735 | (bfr (get-buffer-create bfr-name))) 736 | (dolist (pattern patterns) 737 | (when (not got-error) 738 | (with-current-buffer bfr 739 | (delete-region (point-min) (point-max))) 740 | (setq globs (plist-get pattern :glob)) 741 | (when (atom globs) 742 | (setq globs (list globs))) 743 | (setq globs-str (when glob-arg 744 | (string-join (mapcar (lambda (glob) (concat glob-arg (shell-quote-argument glob))) globs) " ")) 745 | files-str 746 | (string-join 747 | (mapcar 748 | (lambda (dirpath) 749 | (if glob-arg 750 | (format "%s/" dirpath) 751 | (string-join ;; if glob-arg isnt provided, we expand the globs (i.e. wildcards) ourselves 752 | (mapcar 753 | (lambda (glob) 754 | (string-join 755 | (mapcar 'shell-quote-argument 756 | (file-expand-wildcards (format "%s/%s" dirpath glob))) 757 | " ")) 758 | globs) 759 | " "))) 760 | directories) 761 | " ") 762 | full-cmd (format 763 | "%s %s %s" 764 | (format-spec (plist-get cmd :command) 765 | `((?f . ,files-str) 766 | (?r . ,(plist-get pattern :anchor-regex)))) 767 | globs-str 768 | (if (and recursive-arg blk-search-recursively) recursive-arg "")) 769 | exit-code (call-process-shell-command full-cmd nil bfr-name) 770 | out (with-current-buffer " blk-out" (substring-no-properties (buffer-string))) 771 | sep (plist-get cmd :delimiter)) 772 | (if (or (equal exit-code 0) (equal exit-code 1)) ;; i think exit-code 1 is usually for no match 773 | (dolist (line (split-string out "\n")) 774 | (when (not (string-empty-p line)) 775 | (setq line-entries (split-string line sep) 776 | filepath (car line-entries) 777 | line-number (string-to-number (or (cadr line-entries) "1")) 778 | position (string-to-number (or (caddr line-entries) "0")) 779 | match-text (if (cdddr line-entries) (string-join (cdddr line-entries) sep) "")) 780 | (push (list :matched-value match-text 781 | :position (1+ position) ;; grep starts at position 0, while emacs doesnt 782 | :line-number line-number 783 | :matched-pattern pattern 784 | :filepath filepath) 785 | matches))) 786 | (progn 787 | (message "received exit code %s with error: %s" exit-code out) 788 | (setq got-error t))))) 789 | (when (not got-error) 790 | matches))) 791 | 792 | ;;;###autoload 793 | (defun blk-find (text) 794 | "Find entries defined by patterns in `blk-patterns' using the grepper `blk-grepper'. 795 | Select one and visit it." 796 | (interactive 797 | (list (let* ((minibuffer-allow-text-properties t) 798 | (entries (blk-list-titles)) 799 | (completion-extra-properties 800 | '(:annotation-function 801 | (lambda (key) 802 | (let ((grep-result (get-text-property 0 'grep-data key))) 803 | (when (plist-get grep-result :matched-pattern) 804 | (propertize 805 | (format "\t%s" 806 | (plist-get (plist-get grep-result :matched-pattern) 807 | :title)) 808 | 'face 'font-lock-keyword-face))))))) 809 | (when entries (completing-read "entry " entries nil nil nil 'blk-hist))))) 810 | (when text 811 | (if (get-text-property 0 'grep-data text) 812 | (let* ((grep-data (get-text-property 0 'grep-data text)) 813 | (filepath (plist-get grep-data :filepath)) 814 | (position (plist-get grep-data :position))) 815 | (find-file filepath) 816 | (goto-char position)) 817 | (message "%s not found" text)))) 818 | 819 | (defun blk-insert (text) 820 | "Insert a link at point to an entry defined by the patterns in `blk-patterns'. 821 | Use the grepper given by `blk-grepper'. The link format is defined by 822 | entries in `blk-insert-patterns'." 823 | (interactive 824 | (progn (barf-if-buffer-read-only) 825 | (list (let ((minibuffer-allow-text-properties t)) 826 | (completing-read "blk: " (blk-list-titles) nil nil nil 'blk-hist))))) 827 | (barf-if-buffer-read-only) 828 | (let ((grep-result (get-text-property 0 'grep-data text))) 829 | (if grep-result 830 | ;; if :extract-id-function isnt provided, we could try making our own that simply 831 | ;; returns the "src id" of the target to be linked to, although notice that if this is to 832 | ;; happen, the file might be later loaded into memory for no reason by `blk-with-file-as-current-buffer' 833 | (let ((title (plist-get grep-result :title)) 834 | (id (blk-extract-id grep-result))) 835 | (when (and title 836 | (not id) 837 | blk-treat-titles-as-ids) 838 | (setq id title)) 839 | (if id 840 | (blk-insert-link id title) 841 | (message "Match has no id"))) 842 | (message "%s not found" text)))) 843 | 844 | (defun blk-extract-id (grep-result) 845 | "open the file and run the :extract-id-function of the grep rule that was matched to 846 | obtain the id" 847 | (let* ((grep-pattern (plist-get grep-result :matched-pattern)) 848 | (extract-id-func (plist-get grep-pattern :extract-id-function))) 849 | ;; if :extract-id-function isnt provided, we could try making our own that simply 850 | ;; returns the "src id" of the target to be linked to, although notice that if this is to 851 | ;; happen, the file might be later loaded into memory for no reason by `blk-with-file-as-current-buffer' 852 | (when (not extract-id-func) 853 | (let ((src-id-func (plist-get (plist-get grep-result :matched-pattern) :src-id-function))) 854 | (when src-id-func 855 | (setq extract-id-func 856 | (lambda (grep-data-local) 857 | ;; `grep-data-local' would be the same as `grep-result' anyway 858 | (funcall src-id-func (plist-get grep-data-local :matched-value))))))) 859 | (if extract-id-func 860 | (let* ((id (blk-with-file-as-current-buffer 861 | (plist-get grep-result :filepath) 862 | (goto-char (plist-get grep-result :position)) 863 | (funcall extract-id-func grep-result)))) 864 | id) 865 | (progn 866 | (message "Pattern has no `extract-id-function' or `src-id-function'") 867 | nil)))) 868 | 869 | (defun blk-insert-link (id title) 870 | "Insert a link at the current point with ID and TITLE, using the rule defined 871 | in `blk-insert-patterns' for the current major mode" 872 | (let ((id-pattern (or (cl-find-if (lambda (id-pattern) 873 | (apply #'derived-mode-p (plist-get id-pattern :mode-list))) 874 | blk-insert-patterns) 875 | (cl-find-if (lambda (id-pattern) 876 | ;; Use default pattern, ;; mode-list = nil, 877 | ;; meaning match to any other mode. 878 | (null (plist-get id-pattern :mode-list))) 879 | blk-insert-patterns)))) 880 | (if (plist-get id-pattern :id-format) 881 | (insert (format-spec (plist-get id-pattern :id-format) 882 | `((?i . ,id) 883 | ;; Org [[link]] or [[link][title]] format 884 | (?o . ,(if (equal id title) 885 | id 886 | (concat id "][" title))) 887 | (?t . ,title)))) 888 | (message "No link format match for major-mode found in `blk-insert-patterns'")))) 889 | 890 | (defun blk-grep (grepper patterns directories) 891 | "Run the blk grepper on the given patterns and directories, 892 | `grepper' can be a function that takes in the pattern tables and files 893 | as arguments; see `blk-grepper-emacs'. Alternatively, it may be a 894 | property list describing a shell command, see `blk-grepper-grep'," 895 | (blk-remove-ignored-files 896 | (if (functionp grepper) 897 | (funcall grepper patterns directories) 898 | (when (listp grepper) 899 | (blk-run-grep-cmd grepper patterns directories))))) 900 | 901 | (defun blk-remove-ignored-files (data) 902 | "Remove entries with files matching `blk-ignored-files'." 903 | (cl-delete-if 904 | (lambda (entry) 905 | (let ((to-ignore) 906 | (filepath (plist-get entry :filepath))) 907 | (dolist (filepath-regex blk-ignored-files) 908 | (setq to-ignore (or to-ignore (blk-string-search-regex filepath-regex filepath)))) 909 | to-ignore)) 910 | data)) 911 | 912 | 913 | (defun blk-find-links-to-id (id) 914 | "Find links that point to ID." 915 | (let* ((id-patterns 916 | (cl-remove-if-not 917 | (lambda (pattern) 918 | (plist-get pattern :dest-id-function)) 919 | blk-patterns)) 920 | (grep-results 921 | (cl-remove-if-not 922 | (lambda (entry) 923 | (equal (plist-get entry :target-id) id)) 924 | (mapcar 925 | (lambda (grep-result) 926 | ;; (message "got2 %s" grep-result) 927 | (plist-put grep-result 928 | :target-id 929 | (funcall (plist-get 930 | (plist-get grep-result :matched-pattern) 931 | :dest-id-function) 932 | (plist-get grep-result :matched-value)))) 933 | (blk-grep blk-grepper id-patterns blk-directories))))) 934 | grep-results)) 935 | 936 | (defun blk-find-by-id (id) 937 | "Return the file and position of a blk link ID." 938 | (if blk-use-cache 939 | (blk-find-by-id-helper blk-cache id) 940 | (blk-find-by-id-helper (blk-collect-all) id))) 941 | 942 | (defun blk-find-by-id-helper (data id) 943 | "Return the file and position of a blk link ID in DATA." 944 | (let* ((grep-results 945 | (cl-remove-if-not 946 | (lambda (entry) 947 | (or 948 | (equal (plist-get entry :id) id) 949 | (when blk-treat-titles-as-ids (equal (plist-get entry :title) id)))) 950 | data))) 951 | grep-results)) 952 | 953 | (defun blk-open-by-id (id) 954 | "Find an anchor by its ID, open it with `find-file'." 955 | (let ((result (car (blk-find-by-id id)))) 956 | (when result 957 | (find-file (plist-get result :filepath)) 958 | (goto-char (plist-get result :position)) 959 | t))) 960 | 961 | (defun blk-collect-all () 962 | "Collect some data about the text files that we know of." 963 | (mapcar 964 | (lambda (grep-result) 965 | (let* ((pattern (plist-get grep-result :matched-pattern)) 966 | (title-func (plist-get pattern :title-function)) 967 | (matched-value (plist-get grep-result :matched-value)) 968 | (src-id-func (plist-get pattern :src-id-function)) 969 | (dest-id-func (plist-get pattern :dest-id-function))) 970 | (when title-func 971 | (plist-put grep-result 972 | :title 973 | (funcall title-func matched-value))) 974 | (when src-id-func 975 | (plist-put grep-result 976 | :id 977 | (funcall src-id-func matched-value))) 978 | (when dest-id-func 979 | (plist-put grep-result 980 | :dest-id 981 | (funcall dest-id-func matched-value))) 982 | grep-result) 983 | grep-result) 984 | (blk-grep blk-grepper 985 | blk-patterns 986 | blk-directories))) 987 | 988 | ;;;###autoload 989 | (defun blk-all-to-json (filepath) 990 | "Export the data recognizable by blk into a json file." 991 | (interactive (list (read-file-name "output file: "))) 992 | (if (json-available-p) 993 | (let* ((data (blk-collect-all))) 994 | (with-temp-file 995 | filepath 996 | (insert (json-encode-array data))) 997 | (message "Wrote json to %s" filepath)) 998 | (message "Json isnt available"))) 999 | 1000 | (defun blk-completion-at-point () 1001 | "Completion-at-point function, to be added to `completion-at-point-functions'." 1002 | (let* ((bounds (bounds-of-thing-at-point 'symbol)) 1003 | (beg (car bounds)) 1004 | (end (cdr bounds))) 1005 | (list beg end 1006 | (blk-list-titles) 1007 | :annotation-function 1008 | (lambda (key) 1009 | (let ((grep-result (get-text-property 0 'grep-data key))) 1010 | (when (plist-get grep-result :matched-pattern) 1011 | (format "\t%s" 1012 | (plist-get (plist-get grep-result :matched-pattern) 1013 | :title))))) 1014 | :exit-function (lambda (str _status) 1015 | (let ((grep-result (get-text-property 0 'grep-data str))) 1016 | (let ((title (plist-get grep-result :title)) 1017 | (id (blk-extract-id grep-result))) 1018 | (when (and title 1019 | (not id) 1020 | blk-treat-titles-as-ids) 1021 | (setq id title)) 1022 | (if id 1023 | (progn 1024 | (delete-char (- (length str))) 1025 | (blk-insert-link id title)) 1026 | (message "Match has no id"))))) 1027 | :exclusive 'no))) 1028 | 1029 | (defun blk-enable-completion () 1030 | "enable completion for ids/titles recognized by blk, by adding the `blk-completion-at-point' function 1031 | to `completion-at-point-functions'. 1032 | example usage: 1033 | (add-hook 'org-mode-hook #'blk-enable-completion)" 1034 | (add-to-list 'completion-at-point-functions 1035 | #'blk-completion-at-point)) 1036 | 1037 | (provide 'blk) 1038 | ;; blk.el ends here 1039 | -------------------------------------------------------------------------------- /readme.org: -------------------------------------------------------------------------------- 1 | #+title: blk 2 | more documentation may be found at https://mahmoodsh36.github.io/blk.html 3 | * introduction 4 | blk tries to generalize the idea of creating and navigating titles of text files, as well as making links from one file to another, or one block to another (possibly in different files). if you have used org-roam, denote, or other similar tools like obsidian and logseq, you would know that inserting links between two files (or nodes, as they're usually called) and navigating them is a must-have feature for note-taking, with ~blk~, instead of restricting links to specific elements of text, such as a file or a heading, we can insert links to arbitrary forms of text, be it links to an org heading (or markdown heading), or a code block in an org file, or even links to python functions, elisp functions, or an html element (by its id). 5 | * installation & basic configuration 6 | basic installation with the basic features 7 | 8 | #+begin_src emacs-lisp :eval no 9 | (use-package blk 10 | :straight (blk :host github :repo "mahmoodsh36/blk") ;; replace with :quelpa if needed 11 | :after (org) 12 | :config 13 | (setq blk-directories 14 | (list (expand-file-name "~/notes") 15 | user-emacs-directory)) 16 | (add-hook 'org-mode-hook #'blk-enable-completion) 17 | (setq blk-use-cache t) ;; makes completion faster 18 | (global-set-key (kbd "C-c o") #'blk-open-at-point) 19 | (global-set-key (kbd "C-c f") #'blk-find) 20 | (global-set-key (kbd "C-c i") #'blk-insert)) 21 | #+end_src 22 | 23 | basic installation with ~org-transclusion~ "integration" 24 | 25 | #+begin_src emacs-lisp :eval no 26 | (use-package org-transclusion 27 | :config 28 | (add-hook 'org-mode-hook #'org-transclusion-mode)) 29 | 30 | (use-package blk 31 | :straight (blk :host github :repo "mahmoodsh36/blk") ;; replace with :quelpa if needed 32 | :after (org org-transclusion) 33 | :config 34 | (setq blk-directories 35 | (list (expand-file-name "~/notes") 36 | user-emacs-directory)) 37 | (add-hook 'org-mode-hook #'blk-enable-completion) 38 | (blk-configure-org-transclusion) 39 | (setq blk-use-cache t) ;; makes completion faster 40 | (global-set-key (kbd "C-c o") #'blk-open-at-point) 41 | (global-set-key (kbd "C-c f") #'blk-find) 42 | (global-set-key (kbd "C-c i") #'blk-insert)) 43 | #+end_src 44 | * blk vs interactive grepping 45 | if something like ~consult-grep~ is enough for you, and you dont need to make links to specific locations in your files or notes, then this package isnt for you, what it does is that it takes the idea of writing links to other files and extends it to more than just files, it allows for making links to arbitrary blocks of text and transcluding them from one file into another, the transclusion part is to avoid copying for example one equation from an org file into another, you can simply transclude it by its id, this reduces work and keeps the equation in the different files in sync (when the source is edited). 46 | note that ~org-transclusion~ on its own can handle blocks of text, but you would have to write the filename explicitly, specify what to search for in the file, and what exactly to transclude, ~blk~ abstracts this hassle away and allows for unambiguous transclusions (as long as the destination's id is unique). 47 | * todo 48 | ** rules for file names without needing to grep them (similar to what denote does) 49 | ** add support for ~customize~ (customization via the default interface, i.e. without code) --------------------------------------------------------------------------------