changeset 640: |
642b3b82b20d |
parent: |
32375ed43c74
|
child: |
48bcbca019e6 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sun, 08 Sep 2024 17:35:03 -0400 |
permissions: |
-rw-r--r-- |
description: |
thrift fixes, org-get-with-inheritance init |
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/>. 31 "CC Universal Language.") 33 (defvar ulang-link-history nil) 34 (defvar ulang-file-history nil) 36 ;; see org-special-properties 37 (defvar ulang-special-properties 41 (defun dblock-insert-links (regexp) 42 "Create dblock to insert links matching REGEXP." 43 (interactive (list (read-regexp "Insert links matching: " nil ulang-link-history))) 44 (org-create-dblock (list :name "links" 49 (org-dynamic-block-define "links" 'dblock-insert-links) 51 ;; (org-export-translate-to-lang (list '("Table of Contents" "Index")) "ulang") 52 ;; (setq org-export-global-macros nil) 55 (setq org-stuck-projects '("+PROJECT/-DONE" ("NEXT") nil "")) 57 (setq org-todo-keywords 58 '((sequence "TBD(0!)" "TODO(t!)" "NEXT(n!)" "WIP(i!)" "|" "DONE(d!)") 59 (sequence "HOLD(H@/!)" "WIP(!)" "|") 60 (sequence "WAIT(W@/!)" "WIP(!)" "|") 61 (sequence "RESEARCH(s!)" "WIP(!)" "REPORT(c!)" "|") 62 (sequence "OUTLINE(O!)" "DRAFT(M!)" "REVIEW(V!)" "|") 63 (sequence "FIXME(f!)" "WIP(!)" "TEST(T!)" "|") 64 (type "FIND(q!)" "READ(r@!)" "WATCH(A@!)" "HACK(h!)" 65 "CODE(c!)" "BENCH(b!)" "DEPLOY(D!)" "RUN(X!)" 66 "REFILE(w!)" "LOG(L!)" "GOTO(g!)" "|") 67 (type "PROJECT(p!)" "PRODUCT(P!)" "SPRINT(S!)" "RELEASE(R!)" "|") 68 (sequence "|" "DONE(d!)" "NOPE(x@!)"))) 70 (setq org-todo-keyword-faces 71 '(("PROJECT" . (:foreground "lightseagreen" :weight bold)) 72 ("PRODUCT" . (:foreground "olivedrab" :weight bold)) 73 ("RELEASE" . (:foreground "maroon3" :weight bold)) 74 ("RESEARCH" . (:foreground "maroon2" :weight bold)) 75 ("HACK" . (:foreground "maroon3" :weight bold)) 76 ("TBD" . (:foreground "brown" :weight bold)) 77 ("CODE" . (:foreground "bisque" :weight bold :background "midnightblue")) 78 ("HOLD" . (:foreground "red1" :weight bold :background "yellow1")) 79 ("WAIT" . (:foreground "red4" :weight bold :background "yellow1")) 80 ("WIP" . (:foreground "darkorchid2" :weight bold)) 81 ("NOPE" . (:foreground "hotpink" :weight bold :background "darkgreen")))) 84 (setq org-link-abbrev-alist 85 '(("vc" . "https://vc.compiler.company/%s") 86 ("comp" . "https://compiler.company/%s") 87 ("cdn" . "https://cdn.compiler.company/%s") 88 ("packy" . "https://packy.compiler.company/%s") 89 ("yt" . "https://youtube.com/watch?v=%s") 90 ("wikipedia" . "https://en.wikipedia.org/wiki/%s") 91 ("reddit" . "https://reddit.com/%s") 92 ("hn" . "https://news.ycombinator.com/%s") 93 ("so" . "https://stackoverflow.com/%s"))) 96 (defun org-custom-id-get (&optional pom create prefix) 97 "Get the CUSTOM_ID property of the entry at point-or-marker POM. 98 If POM is nil, refer to the entry at point. If the entry does 99 not have an CUSTOM_ID, the function returns nil. However, when 100 CREATE is non nil, create a CUSTOM_ID if none is present 101 already. PREFIX will be passed through to `org-id-new'. In any 102 case, the CUSTOM_ID of the entry is returned." 104 (org-with-point-at pom 105 (let ((id (org-entry-get nil "CUSTOM_ID")) 106 ;; use CUSTOM_ID for links 107 (org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id)) 109 ((and id (stringp id) (string-match "\\S-" id)) 112 (setq id (org-id-new prefix)) 113 (org-entry-put pom "CUSTOM_ID" id) 114 (org-id-add-location id (buffer-file-name (buffer-base-buffer))) 118 (defun org-id-add-to-headlines-in-file () 119 "Add ID properties to all headlines in the 120 current file which do not already have one." 122 (org-map-entries (lambda () (org-id-get (point) 'create)))) 124 (defun org-custom-id-add-to-headlines-in-file () 125 "Add CUSTOM_ID properties to all headlines in the 126 current file which do not already have one." 128 (org-map-entries (lambda () (org-custom-id-get (point) 'create)))) 130 (defun org-id-add-to-headlines-in-files (&optional files) 133 (dolist (f (or files org-agenda-files)) 135 (org-id-add-to-headlines-in-file) 138 (defun org-id-add-to-headlines-in-directory (&optional dir) 140 (let ((dir (or dir org-directory))) 141 (org-id-add-to-headlines-in-files 142 (directory-files-recursively dir "[.]org$")))) 144 (message "Initialized ULANG.") 148 ;; (org-property-inherit-p "LOCATION") 150 ;; currently does not support locations with spaces.. need to walk 151 ;; ancestors ourselves to do so. for now only URIs and pathnames are 153 (defun org-get-with-inheritance (property &optional literal-nil epom) 154 "Like `org-entry-get-with-inheritance' but in additional to properties we 155 also check file keywords (aka in-buffer settings). 157 For example, a PROPERTY value of 'LOCATION' would check all property 158 values in addition to the keyword '#+LOCATION:'." 159 (interactive (list nil nil)) 160 (let ((property (or property (org-read-property-name)))) 161 ;; most of the work passed through to the property handler 162 (org-entry-get-with-inheritance property literal-nil epom))) 164 (defun org-get-location (point) 165 "Get the value of property LOCATION at POINT." 167 (org-with-point-at point 168 (message "%s" (or (when-let ((prop (org-entry-get-with-inheritance "LOCATION"))) 169 (apply 'join-paths (string-split prop " "))) 170 (caadar (org-collect-keywords '("LOCATION") nil '("LOCATION"))))))) 172 (defun org-set-location (value) 173 "Set the value of property LOCATION. If point is before first heading 174 instead set or replace the location file keyword." 175 (interactive (list nil)) 176 (let ((val (or value (org-read-property-value "LOCATION" nil nil)))) 177 (if (org-before-first-heading-p) 179 (beginning-of-buffer) 180 (let ((start (point))) 181 (when (re-search-forward (rx bol "#+LOCATION:" (+ space) (group (* (not space))) eol) nil t) 182 (setq start (match-beginning 0)) 185 (insert "#+LOCATION: " val "\n"))) 186 (org-set-property "LOCATION" value)))) 188 (defun org-follow-location () 189 "Open the location specified by the LOCATION property of the org heading 194 ((string-match-p org-link-any-re loc) (org-link-open-from-string loc)) 195 ;; TODO 2024-08-29: handle other location types (physical, etc) 196 (t (find-file loc t))))) 199 ;;; ulang.el ends here