Last active
June 29, 2023 15:34
-
-
Save doriantaylor/17e64d3601263a6cf49a9c5a5c018abd to your computer and use it in GitHub Desktop.
IBIS identifiers for org-mode
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; this is for making identifiers like <<I001>> <<P001>> <<A001> in org-mode and renumbering them | |
(defun my/org-ibis-targets-before-point (&optional type) | |
(when (stringp type) (setq type (intern (upcase type)))) | |
(when (not (or (null type) (and (symbolp type) (member type '(I P A))))) | |
(error "type must be one of symbols 'I 'P 'A")) | |
;;(message (format "%s" type)) | |
(let ((p (point)) (org (org-element-parse-buffer))) | |
(remq nil (org-element-map org 'target | |
(lambda (e) | |
(let* ((begin (org-element-property :begin e)) | |
(value (org-element-property :value e)) | |
(target-type (progn | |
(string-match "\\([IPA]\\)\\([0-9]+\\)" value) | |
(when (match-string 1 value) | |
(intern (match-string 1 value))))) | |
(serial (string-to-number (match-string 2 value)))) | |
(when (and (> p begin) (or (null type) (eq type target-type))) | |
(message (format "%s %s" type target-type)) | |
(cons target-type serial)))))))) | |
(defun my/org-insert-ibis-target (&optional type) | |
(interactive "sType: ") | |
(let* ((tt (cond ((null type) 'I) | |
((symbolp type) type) | |
((stringp type) (intern (upcase type))) | |
(t 'I))) | |
(precedents (my/org-ibis-targets-before-point tt)) | |
(index (or (cdar (last precedents)) 0))) | |
(message (format "%d" index)) | |
(insert (format "<<%s%03d>>" tt (1+ index))))) | |
;; bind them keys | |
(when (boundp 'org-mode-map) | |
(add-hook 'org-mode-hook | |
(lambda () | |
(mapc (lambda (char) | |
(define-key org-mode-map | |
(kbd (format "C-c x %s" (downcase (symbol-name char)))) | |
`(lambda () (interactive) | |
(my/org-insert-ibis-target (quote ,char))))) | |
'(I P A))))) | |
;; XXX this is gonna ship in emacs 29 thanks buddy | |
;; https://emacs.stackexchange.com/a/54412 | |
(defmacro my/with-undo-amalgamate (&rest body) | |
"Like `progn' but perform BODY with amalgamated undo barriers. | |
This allows multiple operations to be undone in a single step. | |
When undo is disabled this behaves like `progn'." | |
(declare (indent 0) (debug t)) | |
(let ((handle (make-symbol "--change-group-handle--"))) | |
`(let ((,handle (prepare-change-group)) | |
;; Don't truncate any undo data in the middle of this, | |
;; otherwise Emacs might truncate part of the resulting | |
;; undo step: we want to mimic the behavior we'd get if the | |
;; undo-boundaries were never added in the first place. | |
(undo-outer-limit nil) | |
(undo-limit most-positive-fixnum) | |
(undo-strong-limit most-positive-fixnum)) | |
(unwind-protect | |
(progn | |
(activate-change-group ,handle) | |
,@body) | |
(progn | |
(accept-change-group ,handle) | |
(undo-amalgamate-change-group ,handle)))))) | |
;; how would i go about renumbering these things | |
;; don't fuck around just scan whole document and renumber them from the top | |
(defun my/org-renumber-ibis-targets () | |
(interactive) | |
(let ((targets nil) (links nil) | |
;; this is necessary because the cons cells stick around | |
(index (mapcar (lambda (x) (cons x 1)) '(I P A)))) | |
;; gather up all the thingies | |
(org-element-map (org-element-parse-buffer) '(target link) | |
(lambda (element) | |
(let* ((type (org-element-type element)) | |
(path (org-element-property :path element)) | |
(ln (assoc path links))) | |
(if (equal type 'link) | |
(if ln (add-to-list (cdr ln) element t) | |
(add-to-list 'links (cons path (list element)) t)) | |
(add-to-list 'targets element t))))) | |
;; now we iterate over the list | |
(my/with-undo-amalgamate | |
(mapc (lambda (target) | |
(let* ((value (org-element-property :value target)) | |
(begin (org-element-property :begin target)) | |
(end (org-element-property :end target)) | |
(slug (progn | |
(string-match "\\([IPA]\\)\\([0-9]+\\)" value) | |
(when (match-string 1 value) | |
(intern (match-string 1 value))))) | |
(i (assoc slug index)) | |
(lns (cdr (assoc value links)))) | |
(when slug | |
(mapc (lambda (ln) | |
(replace-region-contents | |
(org-element-property :begin ln) | |
(org-element-property :end ln) | |
(lambda () (format "[[%s%03d]]" slug (cdr i))))) | |
lns) | |
(replace-region-contents begin end | |
(lambda () (format "<<%s%03d>> " slug (cdr i)))) | |
(setcdr i (1+ (cdr i)))))) | |
targets)) | |
index)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment