forked from Trevoke/org-gtd.el
-
Notifications
You must be signed in to change notification settings - Fork 0
/
org-gtd-id.el
118 lines (105 loc) · 6.03 KB
/
org-gtd-id.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
;;; org-gtd-id.el --- generating ids for tasks -*- lexical-binding: t; coding: utf-8 -*-
;;
;; Copyright © 2019-2023 Aldric Giacomoni
;; Author: Aldric Giacomoni <[email protected]>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Generating ids from tasks.
;; Most of this code is stolen and adapted from Karl Voit's code and demo at
;; https://gitlab.com/publicvoit/orgmode-link-demo/-/raw/main/link_demo.org
;;
;;; Code:
(require 'ffap)
(defun org-gtd-id-get-create (&optional pom)
"Get the ID property of the entry at point-or-marker POM.
If POM is nil, refer to the entry at point.
If the entry does not have an ID, create an ID prefixed for org-gtd.
In any case, the ID of the entry is returned.
This function is a modified copy of `org-id-get'."
(interactive)
(org-with-point-at pom
(let ((id (org-entry-get nil "ID")))
(if (and id (stringp id) (string-match "\\S-" id))
id
(setq id (org-gtd-id--generate))
(org-entry-put pom "ID" id)
(org-id-add-location id (or org-id-overriding-file-name
(buffer-file-name (buffer-base-buffer))))
id))))
(defun org-gtd-id--generate-sanitized-alnum-dash-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).
Taken from https://gitlab.com/publicvoit/orgmode-link-demo/-/raw/main/link_demo.org."
(let* (;; Remove "<FOO>..</FOO>" HTML tags if present.
(str (replace-regexp-in-string "<\\(?1:[a-z]+\\)[^>]*>.*</\\1>" "" 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
"\\." " dot "
(replace-regexp-in-string
"\\+" " plus " str))))
;; Replace German Umlauts with 7-bit ASCII.
(str (replace-regexp-in-string "ä" "ae" str nil))
(str (replace-regexp-in-string "ü" "ue" str nil))
(str (replace-regexp-in-string "ö" "oe" str nil))
(str (replace-regexp-in-string "ß" "ss" str nil))
;; 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-gtd-id--generate()
"Generates and returns a new id.
The generated ID is stripped off potential progress indicator cookies and
sanitized to get a slug. Furthermore, it is suffixed with an ISO date-stamp."
(let* ((my-heading-text (nth 4 (org-heading-components))) ;; retrieve heading string
(my-heading-text (replace-regexp-in-string "\\(\\[[0-9]+%\\]\\)" "" my-heading-text)) ;; remove progress indicators like "[25%]"
(my-heading-text (replace-regexp-in-string "\\(\\[[0-9]+/[0-9]+\\]\\)" "" my-heading-text)) ;; remove progress indicators like "[2/7]"
(my-heading-text (replace-regexp-in-string "\\(\\[#[ABC]\\]\\)" "" my-heading-text)) ;; remove priority indicators like "[#A]"
(my-heading-text (replace-regexp-in-string "\\[\\[\\(.+?\\)\\]\\[" "" my-heading-text t)) ;; removes links, keeps their description and ending brackets
(my-heading-text (replace-regexp-in-string "<[12][0-9]\\{3\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\( .*?\\)>" "" my-heading-text t)) ;; removes day of week and time from active date- and time-stamps
(my-heading-text (replace-regexp-in-string "\\[[12][0-9]\\{3\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\( .*?\\)\\]" "" my-heading-text t)) ;; removes day of week and time from inactive date- and time-stamps
(raw-id (org-gtd-id--generate-sanitized-alnum-dash-string my-heading-text)) ;; get slug from heading text
(timestamp (format-time-string "%Y-%m-%d")))
(concat raw-id "-" timestamp)))
(provide 'org-gtd-id)
;;; org-gtd-id.el ends here