changeset 651: |
af486e0a40c9 |
parent: |
926d95e5fdc7
|
child: |
cad61259ba57 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 14 Sep 2024 22:13:06 -0400 |
permissions: |
-rw-r--r-- |
description: |
multi-binaries, working on removing x.lisp |
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"))) 97 (defun org-custom-id-get (&optional pom create prefix) 98 "Get the CUSTOM_ID property of the entry at point-or-marker POM. 99 If POM is nil, refer to the entry at point. If the entry does 100 not have an CUSTOM_ID, the function returns nil. However, when 101 CREATE is non nil, create a CUSTOM_ID if none is present 102 already. PREFIX will be passed through to `org-id-new'. In any 103 case, the CUSTOM_ID of the entry is returned." 105 (org-with-point-at pom 106 (let ((id (org-entry-get nil "CUSTOM_ID")) 107 ;; use CUSTOM_ID for links 108 (org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id)) 110 ((and id (stringp id) (string-match "\\S-" id)) 113 (setq id (org-id-new prefix)) 114 (org-entry-put pom "CUSTOM_ID" id) 115 (org-id-add-location id (buffer-file-name (buffer-base-buffer))) 119 (defun org-id-add-to-headlines-in-file () 120 "Add ID properties to all headlines in the 121 current file which do not already have one." 123 (org-map-entries (lambda () (org-id-get (point) 'create)))) 125 (defun org-custom-id-add-to-headlines-in-file () 126 "Add CUSTOM_ID properties to all headlines in the 127 current file which do not already have one." 129 (org-map-entries (lambda () (org-custom-id-get (point) 'create)))) 131 (defun org-id-add-to-headlines-in-files (&optional files) 134 (dolist (f (or files org-agenda-files)) 136 (org-id-add-to-headlines-in-file) 139 (defun org-id-add-to-headlines-in-directory (&optional dir) 141 (let ((dir (or dir org-directory))) 142 (org-id-add-to-headlines-in-files 143 (directory-files-recursively dir "[.]org$")))) 145 (message "Initialized ULANG.") 149 ;; (org-property-inherit-p "LOCATION") 151 ;; currently does not support locations with spaces.. need to walk 152 ;; ancestors ourselves to do so. for now only URIs and pathnames are 154 (defun org-get-with-inheritance (property &optional literal-nil epom) 155 "Like `org-entry-get-with-inheritance' but in additional to properties we 156 also check file keywords (aka in-buffer settings). 158 For example, a PROPERTY value of 'LOCATION' would check all property 159 values in addition to the keyword '#+LOCATION:'." 160 (interactive (list nil nil)) 161 (let* ((property (or property (org-read-property-name))) 162 (kw (when-let ((val (org-collect-keywords '("LOCATION") nil))) 164 ;; most of the work passed through to the property handler 165 (props (org-entry-get-with-inheritance property literal-nil epom))) 167 (append (list kw) (if (listp props) props (list props))) 170 (defun org-get-location (point) 171 "Get the value of property LOCATION at POINT." 173 (let ((path (org-get-with-inheritance "LOCATION" nil point))) 174 ;; when the second path component is an absolute path, skip the first 175 (when (and (< 1 (length path)) (file-name-absolute-p (print (cadr path)))) 176 (setq path (cdr path))) 181 (lambda (x) (split-string x " ")) 184 (defun org-set-location (value) 185 "Set the value of property LOCATION. If point is before first heading 186 instead set or replace the location file keyword." 187 (interactive (list nil)) 188 (let ((val (or value (org-read-property-value "LOCATION" nil nil)))) 189 (if (org-before-first-heading-p) 191 (beginning-of-buffer) 192 (let ((start (point))) 193 (when (re-search-forward (rx bol "#+LOCATION:" (+ space) (group (* (not space))) eol) nil t) 194 (setq start (match-beginning 0)) 197 (insert "#+LOCATION: " val "\n"))) 198 (org-set-property "LOCATION" value)))) 200 (defun org-follow-location (point) 201 "Open the location specified by the LOCATION property of the org heading 204 (let ((loc (org-get-location point))) 206 ((string-match-p org-link-any-re loc) (org-link-open-from-string loc)) 207 ;; TODO 2024-08-29: handle other location types (physical, etc) 208 (t (find-file loc t))))) 211 ;;; ulang.el ends here