changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: org-set-location

changeset 639: 32375ed43c74
parent 638: 6c0e4a44c082
child 640: 642b3b82b20d
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 08 Sep 2024 12:24:33 -0400
files: emacs/lib/ulang.el
description: org-set-location
     1.1--- a/emacs/lib/ulang.el	Sat Sep 07 22:34:12 2024 -0400
     1.2+++ b/emacs/lib/ulang.el	Sun Sep 08 12:24:33 2024 -0400
     1.3@@ -143,19 +143,45 @@
     1.4 
     1.5 (message "Initialized ULANG.")
     1.6 
     1.7-(provide 'ulang)
     1.8 ;;; Commands
     1.9 
    1.10 ;; (org-property-inherit-p "LOCATION")
    1.11+
    1.12+;; currently does not support locations with spaces.. need to walk
    1.13+;; ancestors ourselves to do so. for now only URIs and pathnames are
    1.14+;; supported.
    1.15+(defun org-get-location (point)
    1.16+  "Get the value of property LOCATION at POINT."
    1.17+  (interactive "d")
    1.18+  (org-with-point-at point
    1.19+    (format "%s" (or (apply 'join-paths (string-split (org-entry-get-with-inheritance "LOCATION") " "))
    1.20+                     (caadar (org-collect-keywords '("LOCATION") nil '("LOCATION")))))))
    1.21+
    1.22+(defun org-set-location (value)
    1.23+  "Set the value of property LOCATION. If point is before first heading
    1.24+instead set or replace the location file keyword."
    1.25+  (interactive (list nil))
    1.26+  (let ((val (or value (org-read-property-value "LOCATION" nil nil))))
    1.27+    (if (org-before-first-heading-p)
    1.28+        (save-excursion
    1.29+          (beginning-of-buffer)
    1.30+          (let ((start (point)))
    1.31+            (when (re-search-forward (rx bol "#+LOCATION:" (+ space) (group (* (not space))) eol) nil t)
    1.32+              (setq start (match-beginning 0))
    1.33+              (goto-char start)
    1.34+              (delete-line))
    1.35+            (insert "#+LOCATION: " val "\n")))
    1.36+      (org-set-property "LOCATION" value))))
    1.37+
    1.38 (defun org-follow-location ()
    1.39   "Open the location specified by the LOCATION property of the org heading
    1.40 or file at point."
    1.41   (interactive)
    1.42-  (let ((loc (or (org-entry-get-with-inheritance "LOCATION")
    1.43-                 (caadar (org-collect-keywords '("LOCATION") nil '("LOCATION"))))))
    1.44+  (let ((loc ))
    1.45     (cond
    1.46      ((string-match-p org-link-any-re loc) (org-link-open-from-string loc))
    1.47      ;; TODO 2024-08-29: handle other location types (physical, etc)
    1.48      (t (find-file loc t)))))
    1.49 
    1.50+(provide 'ulang)
    1.51 ;;; ulang.el ends here