Skip to content

Instantly share code, notes, and snippets.

@mskorzhinskiy
Created January 23, 2023 07:09
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mskorzhinskiy/9292263b2940f798416375303a375e79 to your computer and use it in GitHub Desktop.
Save mskorzhinskiy/9292263b2940f798416375303a375e79 to your computer and use it in GitHub Desktop.
My take on generating human-readable attach id's for org-attach
(use-package ffap)
(defun sanitze-string (str)
"Returns a string which contains only a-zA-Z0-9 with single dashes
replacing all other characters in-between them.
Some parts were copied and adapted from org-hugo-slug
from https://github.com/kaushalmodi/ox-hugo (GPLv3)."
(let* (;; Remove "<FOO>..</FOO>" HTML tags if present.
(str (replace-regexp-in-string "<\\(?1:[a-z]+\\)[^>]*>.*</\\1>" "" str))
;; Remove org-mode links
(str (replace-regexp-in-string "\\[\\[.*\\]\\[" "" str))
;; Remove URLs if present in the string. The ")" in the
;; below regexp is the closing parenthesis of a Markdown
;; link: [Desc](Link).
(str (replace-regexp-in-string (concat "\\](" ffap-url-regexp "[^)]+)") "]" str))
;; Replace "&" with " and ", "." with " dot ", "+" with
;; " plus ".
(str (replace-regexp-in-string
"&" " and "
(replace-regexp-in-string
"\\+" " plus " str)))
;; Replace German Umlauts with 7-bit ASCII.
(str (replace-regexp-in-string "[Ä]" "Ae" str t))
(str (replace-regexp-in-string "[Ü]" "Ue" str t))
(str (replace-regexp-in-string "[Ö]" "Oe" str t))
(str (replace-regexp-in-string "[ä]" "ae" str t))
(str (replace-regexp-in-string "[ü]" "ue" str t))
(str (replace-regexp-in-string "[ö]" "oe" str t))
(str (replace-regexp-in-string "[ß]" "ss" str t))
;; Replace all characters except alphabets, numbers and
;; parentheses with spaces.
(str (replace-regexp-in-string "[^[:alnum:]()]" " " str))
;; On emacs 24.5, multibyte punctuation characters like ":"
;; are considered as alphanumeric characters! Below evals to
;; non-nil on emacs 24.5:
;; (string-match-p "[[:alnum:]]+" ":")
;; So replace them with space manually..
(str (if (version< emacs-version "25.0")
(let ((multibyte-punctuations-str ":")) ;String of multibyte punctuation chars
(replace-regexp-in-string (format "[%s]" multibyte-punctuations-str) " " str))
str))
;; Remove leading and trailing whitespace.
(str (replace-regexp-in-string "\\(^[[:space:]]*\\|[[:space:]]*$\\)" "" str))
;; Replace 2 or more spaces with a single space.
(str (replace-regexp-in-string "[[:space:]]\\{2,\\}" " " str))
;; Replace parentheses with double-hyphens.
(str (replace-regexp-in-string "\\s-*([[:space:]]*\\([^)]+?\\)[[:space:]]*)\\s-*" " -\\1- " str))
;; Remove any remaining parentheses character.
(str (replace-regexp-in-string "[()]" "" str))
;; Replace spaces with hyphens.
(str (replace-regexp-in-string " " "-" str))
;; Remove leading and trailing hyphens.
(str (replace-regexp-in-string "\\(^[-]*\\|[-]*$\\)" "" str)))
str))
(defun org-attach-id--get-date ()
(or (when-let ((date-prop
(or (org-entry-get (point) "DATE")
(org-entry-get (point) "CREATED")
(org-entry-get (point) "CLOSED")
(org-entry-get (point) "SCHEDULED"))))
(ts-format "%Y.%m.%d" (ts-parse date-prop)))
(format-time-string "%Y.%m.%d")))
(defun org-attach-id-new ()
"Generate a new ATTACH_ID property for the `org-mode' attaching mechanism.
New id is: title with the date plus headline with the date, if
it's a insidie the headline."
(let* ((title (get-title (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer)))))
(title (sanitze-string title))
(file-date (save-excursion
(goto-char (point-min))
(org-attach-id--get-date)))
(title (format "%s [%s]" title file-date))
(headline-date
(unless (org-before-first-heading-p)
(let* ((headline (nth 4 (org-heading-components)))
(headline (sanitze-string headline))
(headline (substring headline 0 (min 60 (length headline))))
(date (org-attach-id--get-date))
(previous-headlines
(let (acc)
(dolist (h (org-get-outline-path nil nil))
(setq acc (concat acc (let ((pos (or (string-match "[:alnum:а-яА-Я]" h)
0)))
(substring h pos (1+ pos))))))
acc))
(headline-date
(if previous-headlines
(format "%s [%s] [%s]" headline date previous-headlines)
(format "%s [%s]" headline date))))
headline-date)))
(id (if headline-date
(mapconcat 'identity (list title headline-date) "/")
title)))
(let* ((id (replace-regexp-in-string (regexp-quote "-") " " id nil 'literal))
(id (replace-regexp-in-string "\s+" " " id nil 'literal))
(id (replace-regexp-in-string "\s*$" "" id nil 'literal))
(id (capitalize id)))
id)))
(defun org-attach-id-reliable-id (id)
"Get's and `ATTACH_ID' property or if doesn't exist generate one."
(let ((marker (org-id-find id 'marker)))
(org-with-point-at marker
(org-with-wide-buffer
(let ((attach-id (or (org-entry-get (point) "ATTACH_ID")
(org-attach-id-new))))
;; Ensure DATE existence at the entry. Just for additional info.
(unless (org-entry-get (point) "DATE")
(org-set-property "DATE" (format-time-string "[%Y-%m-%d %a]")))
;; Do the same for the file. This is to ensure to generate stables
;; attach-ids for this file.
(save-excursion
(goto-char (point-min))
(unless (org-entry-get (point) "DATE")
(org-set-property "DATE" (format-time-string "[%Y-%m-%d %a]"))))
;; And the ATTACH_ID itself
(unless (org-entry-get (point) "ATTACH_ID")
(org-set-property "ATTACH_ID" attach-id))
attach-id)))))
(setq org-attach-id-to-path-function-list '(org-attach-id-reliable-id))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment