changeset 698: |
96958d3eb5b0 |
parent: |
cad61259ba57
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Fri, 04 Oct 2024 22:04:59 -0400 |
permissions: |
-rw-r--r-- |
description: |
fixes |
1 ;;; ulang.el --- ulang compliance lib -*- lexical-binding:t -*- 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 28 (require 'org-element) 32 "CC Universal Language.") 34 (defvar ulang-link-history nil) 35 (defvar ulang-file-history nil) 37 ;; see org-special-properties 38 (defvar ulang-special-properties 42 (defun dblock-insert-links (regexp) 43 "Create dblock to insert links matching REGEXP." 44 (interactive (list (read-regexp "Insert links matching: " nil ulang-link-history))) 45 (org-create-dblock (list :name "links" 50 (org-dynamic-block-define "links" 'dblock-insert-links) 52 ;; (org-export-translate-to-lang (list '("Table of Contents" "Index")) "ulang") 53 ;; (setq org-export-global-macros nil) 56 (setq org-stuck-projects '("+PROJECT/-DONE" ("NEXT") nil "")) 58 (setq org-todo-keywords 59 '((sequence "TBD(0!)" "TODO(t!)" "NEXT(n!)" "WIP(i!)" "|" "DONE(d!)") 60 (sequence "HOLD(H@/!)" "WIP(!)" "|") 61 (sequence "WAIT(W@/!)" "WIP(!)" "|") 62 (sequence "RESEARCH(s!)" "WIP(!)" "REPORT(c!)" "|") 63 (sequence "OUTLINE(O!)" "DRAFT(M!)" "REVIEW(V!)" "|") 64 (sequence "FIXME(f!)" "WIP(!)" "TEST(T!)" "|") 65 (type "FIND(q!)" "READ(r@!)" "WATCH(A@!)" "HACK(h!)" 66 "CODE(c!)" "BENCH(b!)" "DEPLOY(D!)" "RUN(X!)" 67 "REFILE(w!)" "LOG(L!)" "GOTO(g!)" "|") 68 (type "PROJECT(p!)" "PRODUCT(P!)" "SPRINT(S!)" "RELEASE(R!)" "|") 69 (sequence "|" "DONE(d!)" "NOPE(x@!)"))) 71 (setq org-todo-keyword-faces 72 '(("PROJECT" . (:foreground "lightseagreen" :weight bold)) 73 ("PRODUCT" . (:foreground "olivedrab" :weight bold)) 74 ("RELEASE" . (:foreground "maroon3" :weight bold)) 75 ("RESEARCH" . (:foreground "maroon2" :weight bold)) 76 ("HACK" . (:foreground "maroon3" :weight bold)) 77 ("TBD" . (:foreground "brown" :weight bold)) 78 ("CODE" . (:foreground "bisque" :weight bold :background "midnightblue")) 79 ("HOLD" . (:foreground "red1" :weight bold :background "yellow1")) 80 ("WAIT" . (:foreground "red4" :weight bold :background "yellow1")) 81 ("WIP" . (:foreground "darkorchid2" :weight bold)) 82 ("NOPE" . (:foreground "hotpink" :weight bold :background "darkgreen")))) 85 (setq org-link-abbrev-alist 86 '(("vc" . "https://vc.compiler.company/%s") 87 ("comp" . "https://compiler.company/%s") 88 ("cdn" . "https://cdn.compiler.company/%s") 89 ("packy" . "https://packy.compiler.company/%s") 90 ("yt" . "https://youtube.com/watch?v=%s") 91 ("wikipedia" . "https://en.wikipedia.org/wiki/%s") 92 ("reddit" . "https://reddit.com/%s") 93 ("hn" . "https://news.ycombinator.com/%s") 94 ("so" . "https://stackoverflow.com/%s"))) 98 (defun org-title-to-filename (title) 99 "Convert TITLE to a reasonable filename." 100 ;; Based on the slug logic in org-roam, but org-roam also uses a 102 (setq title (downcase title)) 103 (setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title)) 104 (setq title (s-replace-regexp "-+" "-" title)) 105 (setq title (s-replace-regexp "^-" "" title)) 106 (setq title (s-replace-regexp "-$" "" title)) 109 (defun org-get-custom-id-list () 113 (org-entry-get nil "CUSTOM_ID"))))) 115 (defun org-generate-custom-id (&optional id-list) 116 (let* ((custom-id (org-entry-get nil "CUSTOM_ID")) 117 (heading (org-heading-components)) 118 (level (nth 0 heading)) 119 (todo (nth 2 heading)) 120 (headline (nth 4 heading)) 121 (slug (org-title-to-filename headline)) 122 (duplicate-id (when id-list (member slug id-list)))) 123 (when (not duplicate-id) 124 (message "Adding CUSTOM_ID %s to %s" slug headline) 125 (org-entry-put nil "CUSTOM_ID" slug)))) 127 (defun org-generate-custom-ids () 128 "Generate CUSTOM_ID for any headings that are missing one" 130 (org-with-wide-buffer 131 (let ((existing-ids (org-get-custom-id-list))) 134 (org-generate-custom-id existing-ids))))))) 137 (defun org-id-add-to-headlines-in-file () 138 "Add ID properties to all headlines in the 139 current file which do not already have one." 141 (org-map-entries (lambda () (org-id-get (point) 'create)))) 143 (defun org-id-add-to-headlines-in-files (&optional files) 146 (dolist (f (or files org-agenda-files)) 148 (org-id-add-to-headlines-in-file) 151 (defun org-id-add-to-headlines-in-directory (&optional dir) 153 (let ((dir (or dir org-directory))) 154 (org-id-add-to-headlines-in-files 155 (directory-files-recursively dir "[.]org$")))) 157 (message "Initialized ULANG.") 161 ;; (org-property-inherit-p "LOCATION") 163 ;; currently does not support locations with spaces.. need to walk 164 ;; ancestors ourselves to do so. for now only URIs and pathnames are 166 (defun org-get-with-inheritance (property &optional literal-nil epom) 167 "Like `org-entry-get-with-inheritance' but in additional to properties we 168 also check file keywords (aka in-buffer settings). 170 For example, a PROPERTY value of 'LOCATION' would check all property 171 values in addition to the keyword '#+LOCATION:'." 172 (interactive (list nil nil)) 173 (let* ((property (or property (org-read-property-name))) 174 (kw (when-let ((val (org-collect-keywords '("LOCATION") nil))) 176 ;; most of the work passed through to the property handler 177 (props (org-entry-get-with-inheritance property literal-nil epom))) 179 (append (list kw) (if (listp props) props (list props))) 182 (defun org-get-location (point) 183 "Get the value of property LOCATION at POINT." 185 (let ((path (org-get-with-inheritance "LOCATION" nil point))) 186 ;; when the second path component is an absolute path, skip the first 187 (when (and (< 1 (length path)) (file-name-absolute-p (print (cadr path)))) 188 (setq path (cdr path))) 193 (lambda (x) (split-string x " ")) 196 (defun org-set-location (value) 197 "Set the value of property LOCATION. If point is before first heading 198 instead set or replace the location file keyword." 199 (interactive (list nil)) 200 (let ((val (or value (org-read-property-value "LOCATION" nil nil)))) 201 (if (org-before-first-heading-p) 203 (beginning-of-buffer) 204 (let ((start (point))) 205 (when (re-search-forward (rx bol "#+LOCATION:" (+ space) (group (* (not space))) eol) nil t) 206 (setq start (match-beginning 0)) 209 (insert "#+LOCATION: " val "\n"))) 210 (org-set-property "LOCATION" value)))) 212 (defun org-follow-location (point) 213 "Open the location specified by the LOCATION property of the org heading 216 (let ((loc (org-get-location point))) 218 ((string-match-p org-link-any-re loc) (org-link-open-from-string loc)) 219 ;; TODO 2024-08-29: handle other location types (physical, etc) 220 (t (find-file loc t))))) 223 ;;; ulang.el ends here