IBIS identifiers for org-mode

org-ibis.el

;; 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))