Replace Build Tools (TITLE)

B.1.2.3 Replace Build Tools

These three small scripts are used by replace-build-tools. org-template-version returns the main Org Template’s version number. project-tree returns a parsed tree from a buffer. find-hl-cid locates a level 1 heading that contains a particular custom id and returns that subtree’s beginning and ending points.


(defun org-template-key-value (key &optional regexp-str)
  "Given a KEY string and an optional REGEXP-STR string, in the file
SYNC_ORG_TEMPLATE find the key and return the value of the match
string, which defaults to (.*)$ if nil."
  (with-current-buffer (find-file-noselect (getenv "SYNC_ORG_TEMPLATE"))
    (save-excursion
      (let ((regexp-use-str
              (or regexp-str
                  "\\(.*\\)$")))
        (goto-char (point-min))
        (re-search-forward (concat "^#[+]" key regexp-use-str))
        (match-string-no-properties 1)))))

(defun org-template-version ()
  "Return the current version number of SYNC_ORG_TEMPLATE."
  (org-template-key-value "macro:\s*version Version " "\\(\\(?:[[:digit:]]+[.]?\\)\\{3\\}\\)"))

(defun org-template-bucket ()
  "Return the bucket name of SYNC_ORG_TEMPLATE."
  (org-template-key-value "bucket:\s*"))


(defun project-tree (proj-buf)
  "With a buffer PROJ-BUF, return an Org-parsed tree"
  (with-current-buffer proj-buf
    (org-element-parse-buffer 'headline)))


(defun find-hl (buf hl)
  "With a buffer BUF, find a headline HL.

Return nil if the headline is not found. Return its point if it
is found."
  (with-current-buffer buf
    (save-excursion
      (goto-char (point-min))
      (let ((re (format "^[*]\\{1,\\}\\s\\{1,\\}%s$" hl)))
        (re-search-forward re nil t)))))

(defun find-hl-cid (proj-tree cid)
  "With an Org-parsed tree PROJ-TREE,  find a headline of leval 1
or 2 with a particular property drawer custom_id of CID."
  (let* ((cid-hl (org-element-map proj-tree 'headline
          (lambda (e) (let ((lev (org-element-property :level e))
                            (bt (org-element-property :CUSTOM_ID e)))
                        (and (<= lev 2)
                             (string= bt cid)
                             e)))
          nil t))
         (car cid-hl))
    (cons (org-element-property :begin cid-hl)
          (org-element-property :end cid-hl))))

The replace-build-tools function replaces a section of an old templated file with the corresponding section from the source template file found in ‘SYNC_ORG_TEMPLATE’, which is presumably newer. It must be run from within the directory holding the older templated file, and the original template file must be identified by the environment variable ‘SYNC_ORG_TEMPLATE’.

This function works by parsing the buffers by headlines and then using org-element-map to find a level 1 headline containing a custom id of CID. Once it finds such a headline, it records that section’s beginning and ending points. It does this for both the old template file and the template file. Then it deletes that section from the old template file, and inserts the corresponding section from the root template file.


(defun replace-build-tools (cid)
  "Replaces a section of an Org template file identified by the
custom_id CID with the corresponding section of the root
template identified by the environment variable.

OLD-BUF is the Org template in the current working directory.
SYNC_ORG_TEMPLATE must be set."
  ;(message "...in replace-build-tools with %s..." cid)
  (let* ((old-buf (car (find-file-noselect "./*.org" nil nil t)))
         (sync-buf (find-file-noselect (getenv "SYNC_ORG_TEMPLATE")))
         (old-tree (project-tree old-buf))
         (sync-tree (project-tree sync-buf))
         (old-be (find-hl-cid old-tree cid))
         (sync-be (find-hl-cid sync-tree cid)))
      (set-buffer old-buf)
      (delete-region (car old-be) (cdr old-be))
      (goto-char (car old-be))
      (insert-buffer-substring sync-buf (car sync-be) (cdr sync-be))
      (goto-char (car old-be))
      (org-set-property "org-template-version" (org-template-version))
      (save-buffer)))

(defun delete-build-tools (cid)
  "Delete a section of an Org template file identified by the
custom_id CID."
  ;(message "...in delete-build-tools at %s..." cid)
  (let* ((old-buf (car (find-file-noselect "./*.org" nil nil t)))
         (old-tree (project-tree old-buf))
         (old-be (find-hl-cid old-tree cid)))
    ;(message "old-buf: %s\told-be: %s" old-buf old-be)
    (with-current-buffer old-buf
      (delete-region (car old-be) (cdr old-be))
      (save-buffer))))