1.1--- a/emacs/lib/graph.el Sat Sep 14 22:13:06 2024 -0400
1.2+++ b/emacs/lib/graph.el Sat Sep 14 23:55:38 2024 -0400
1.3@@ -111,24 +111,21 @@
1.4 ;; See https://github.com/toshism/org-super-links/blob/develop/org-super-links.el
1.5 (declare-function org-make-link-description-function "ext:org-mode")
1.6
1.7-(defvar org-graph-edge-backlink-into-drawer "LINKS"
1.8- "Controls how/where to insert the backlinks.
1.9-If non-nil a drawer will be created and backlinks inserted there. The
1.10-default is BACKLINKS. If this is set to a string a drawer will be
1.11-created using that string. For example LINKS. If nil backlinks will
1.12-just be inserted under the heading.")
1.13+(defvar org-graph-edge-drawer "LINKS"
1.14+ "Controls how/where to insert edges. If nil edges will just be inserted
1.15+under the heading.")
1.16
1.17-(defvar org-graph-edge-backlink-prefix 'org-graph-edge-backlink-prefix-timestamp
1.18- "Prefix to insert before the backlink.
1.19+(defvar org-graph-edge-prefix 'org-graph-edge-prefix-timestamp
1.20+ "Prefix to insert before the edge.
1.21 This can be a string, nil, or a function that takes no arguments and
1.22 returns a string.
1.23
1.24-Default is the function `org-graph-edge-backlink-prefix-timestamp'
1.25+Default is the function `org-graph-edge-prefix-timestamp'
1.26 which returns an inactive timestamp formatted according to the variable
1.27 `org-time-stamp-formats' and a separator ' <- '.")
1.28
1.29-(defvar org-graph-edge-backlink-postfix nil
1.30- "Postfix to insert after the backlink.
1.31+(defvar org-graph-edge-postfix nil
1.32+ "Postfix to insert after the edge.
1.33 This can be a string, nil, or a function that takes no arguments and
1.34 returns a string")
1.35
1.36@@ -165,27 +162,12 @@
1.37
1.38 Default is the variable `org-make-link-desciption-function'.")
1.39
1.40-(defvar org-graph-edge-search-function
1.41- (cond ((require 'helm-org-ql nil 'no-error) "helm-org-ql")
1.42- ((require 'helm-org-rifle nil 'no-error) "helm-org-rifle")
1.43- (t 'org-graph-edge-get-location))
1.44- "The interface to use for finding target links.
1.45-This can be a string with one of the values 'helm-org-ql',
1.46-'helm-org-rifle', or a function. If you provide a custom
1.47+(defvar org-graph-edge-search-function 'org-graph-edge-get-location
1.48+ "The interface to use for finding target links. If you provide a custom
1.49 function it will be called with the `point` at the location the link
1.50 should be inserted. The only other requirement is that it should call
1.51-the function `org-graph-edge--insert-link' with a marker to the target link.
1.52-AKA the place you want the backlink.
1.53-
1.54-Using 'helm-org-ql' or 'helm-org-rifle' will also add a new
1.55-action to the respective action menu.
1.56-
1.57-See the function `org-graph-edge-link-search-interface-ql' or for an example.
1.58-
1.59-Default is set based on currently installed packages. In order of priority:
1.60-- 'helm-org-ql'
1.61-- 'helm-org-rifle'
1.62-- `org-graph-edge-get-location'
1.63+the function `org-graph-edge--insert-link' with a marker to the target
1.64+link. AKA the place you want the edge.
1.65
1.66 `org-graph-edge-get-location' internally uses `org-refile-get-location'.")
1.67
1.68@@ -197,36 +179,27 @@
1.69 "Hook called before storing the link on the backlink side.
1.70 This is called with point in the heading of the backlink.")
1.71
1.72-(declare-function org-graph-edge-org-ql-link-search-interface "ext:org-graph-edge-org-ql")
1.73-(declare-function org-graph-edge-org-rifle-link-search-interface "ext:org-graph-edge-org-rifle")
1.74-
1.75 (defun org-graph-edge-get-location ()
1.76 "Default for function `org-graph-edge-search-function' that reuses the `org-refile' machinery."
1.77- (let ((target (org-refile-get-location "Super Link")))
1.78+ (let ((target (org-refile-get-location "Node")))
1.79 (org-graph-edge--insert-link (set-marker (make-marker) (car (cdddr target))
1.80 (get-file-buffer (car (cdr target)))))))
1.81
1.82 (defun org-graph-edge-search-function ()
1.83 "Call the search interface specified in variable `org-graph-edge-search-function'."
1.84- (cond ((string= org-graph-edge-search-function "helm-org-ql")
1.85- (require 'org-graph-edge-org-ql)
1.86- (org-graph-edge-org-ql-link-search-interface))
1.87- ((string= org-graph-edge-search-function "helm-org-rifle")
1.88- (require 'org-graph-edge-org-rifle)
1.89- (org-graph-edge-org-rifle-link-search-interface))
1.90- (t (funcall org-graph-edge-search-function))))
1.91+ (funcall org-graph-edge-search-function))
1.92
1.93-(defun org-graph-edge-backlink-prefix ()
1.94- "Return an appropriate string based on variable `org-graph-edge-backlink-prefix'."
1.95- (cond ((equal org-graph-edge-backlink-prefix nil) "")
1.96- ((stringp org-graph-edge-backlink-prefix) org-graph-edge-backlink-prefix)
1.97- (t (funcall org-graph-edge-backlink-prefix))))
1.98+(defun org-graph-edge-prefix ()
1.99+ "Return an appropriate string based on variable `org-graph-edge-prefix'."
1.100+ (cond ((equal org-graph-edge-prefix nil) "")
1.101+ ((stringp org-graph-edge-prefix) org-graph-edge-prefix)
1.102+ (t (funcall org-graph-edge-prefix))))
1.103
1.104-(defun org-graph-edge-backlink-postfix ()
1.105- "Return an appropriate string based on variable `org-graph-edge-backlink-postfix'."
1.106- (cond ((equal org-graph-edge-backlink-postfix nil) "\n")
1.107- ((stringp org-graph-edge-backlink-postfix) org-graph-edge-backlink-postfix)
1.108- (t (funcall org-graph-edge-backlink-postfix))))
1.109+(defun org-graph-edge-postfix ()
1.110+ "Return an appropriate string based on variable `org-graph-edge-postfix'."
1.111+ (cond ((equal org-graph-edge-postfix nil) "\n")
1.112+ ((stringp org-graph-edge-postfix) org-graph-edge-postfix)
1.113+ (t (funcall org-graph-edge-postfix))))
1.114
1.115 (defun org-graph-edge-link-prefix ()
1.116 "Return an appropriate string based on variable `org-graph-edge-link-prefix'."
1.117@@ -240,8 +213,8 @@
1.118 ((stringp org-graph-edge-link-postfix) org-graph-edge-link-postfix)
1.119 (t (funcall org-graph-edge-link-postfix))))
1.120
1.121-(defun org-graph-edge-backlink-prefix-timestamp ()
1.122- "Return the default prefix string for a backlink.
1.123+(defun org-graph-edge-prefix-timestamp ()
1.124+ "Return the default prefix string for an edge.
1.125 Inactive timestamp formatted according to `org-time-stamp-formats' and
1.126 a separator ' <- '."
1.127 (concat (format-time-string (org-time-stamp-format t t) (current-time))
1.128@@ -256,19 +229,19 @@
1.129 ((fboundp p) (funcall p link desc))
1.130 (t desc))))
1.131
1.132-(defun org-graph-edge-backlink-into-drawer ()
1.133- "Name of the backlink drawer, as a string, or nil.
1.134+(defun org-graph-edge-drawer ()
1.135+ "Name of the edge drawer, as a string, or nil.
1.136 This is the value of variable
1.137-`org-graph-edge-backlink-into-drawer'. However, if the current
1.138-entry has or inherits a BACKLINK_INTO_DRAWER property, it will be
1.139+`org-graph-edge-drawer'. However, if the current
1.140+entry has or inherits a EDGE_DRAWER property, it will be
1.141 used instead of the default value."
1.142- (let ((p (org-entry-get nil "BACKLINK_INTO_DRAWER" 'inherit t)))
1.143+ (let ((p (org-entry-get nil "EDGE_DRAWER" 'inherit t)))
1.144 (cond ((equal p "nil") nil)
1.145- ((equal p "t") "BACKLINKS")
1.146+ ((equal p "t") "LINKS")
1.147 ((stringp p) p)
1.148- (p "BACKLINKS")
1.149- ((stringp org-graph-edge-backlink-into-drawer) org-graph-edge-backlink-into-drawer)
1.150- (org-graph-edge-backlink-into-drawer "BACKLINKS"))))
1.151+ (p "LINKS")
1.152+ ((stringp org-graph-edge-drawer) org-graph-edge-drawer)
1.153+ (org-graph-edge-drawer "LINKS"))))
1.154
1.155 ;; delete related functions
1.156 (defun org-graph-edge--find-link (id)
1.157@@ -348,7 +321,7 @@
1.158 (insert (org-graph-edge-link-postfix))))
1.159
1.160 (defun org-graph-edge-link-prefix-timestamp ()
1.161- "Return the default prefix string for a backlink.
1.162+ "Return the default prefix string for an edge.
1.163 Inactive timestamp formatted according to `org-time-stamp-formats' and
1.164 a separator ' -> '."
1.165 (concat (format-time-string (org-time-stamp-format t t) (current-time))
1.166@@ -374,16 +347,16 @@
1.167 ;; /EXPERIMENTAL related into drawer
1.168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1.169
1.170-(defun org-graph-edge-insert-backlink (link desc)
1.171- "Insert backlink to LINK with DESC.
1.172-Where the backlink is placed is determined by the variable `org-graph-edge-backlink-into-drawer'."
1.173- (let* ((org-log-into-drawer (org-graph-edge-backlink-into-drawer))
1.174+(defun org-graph-edge-insert (link desc)
1.175+ "Insert edge to LINK with DESC.
1.176+Where the edge is placed is determined by the variable `org-graph-edge-drawer'."
1.177+ (let* ((org-log-into-drawer (org-graph-edge-drawer))
1.178 (description (org-graph-edge-default-description-formatter link desc))
1.179 (beg (org-log-beginning t)))
1.180 (goto-char beg)
1.181- (insert (org-graph-edge-backlink-prefix))
1.182+ (insert (org-graph-edge-prefix))
1.183 (insert (org-link-make-string link description))
1.184- (insert (org-graph-edge-backlink-postfix))
1.185+ (insert (org-graph-edge-postfix))
1.186 (org-indent-region beg (point))))
1.187
1.188 (defun org-graph-edge-links-action (marker hooks)
1.189@@ -405,8 +378,8 @@
1.190 (cons link-ref description)))
1.191
1.192 (defun org-graph-edge--insert-link (target &optional no-forward)
1.193- "Insert link to marker TARGET at current `point`, and create backlink to here.
1.194-Only create backlinks in files in `org-mode' or a derived mode, otherwise just
1.195+ "Insert link to marker TARGET at current `point`, and create edge to here.
1.196+Only create edges in files in `org-mode' or a derived mode, otherwise just
1.197 act like a normal link.
1.198
1.199 If NO-FORWARD is non-nil skip creating the forward link. Currently
1.200@@ -422,7 +395,7 @@
1.201 (widen) ;; buffer could be narrowed
1.202 (goto-char (marker-position target))
1.203 (when (derived-mode-p 'org-mode)
1.204- (org-graph-edge-insert-backlink (car source-formatted-link) (cdr source-formatted-link))))))
1.205+ (org-graph-edge-insert (car source-formatted-link) (cdr source-formatted-link))))))
1.206 (unless no-forward
1.207 (with-current-buffer (marker-buffer source)
1.208 (save-excursion
1.209@@ -468,7 +441,7 @@
1.210 (let ((link-element (org-graph-edge--find-link id)))
1.211 (if link-element
1.212 (org-graph-edge--delete-link link-element)
1.213- (message "No backlink found. Deleting active only.")))))))
1.214+ (message "No edge found. Deleting active only.")))))))
1.215 (org-graph-edge--delete-link (org-element-context)))
1.216
1.217 ;;;###autoload
1.218@@ -500,7 +473,7 @@
1.219
1.220 ;;;###autoload
1.221 (defun org-graph-edge-insert-link ()
1.222- "Insert a super link from the register."
1.223+ "Insert an edge link from the register."
1.224 (interactive)
1.225 (let* ((target (get-register ?^)))
1.226 (if target
2.1--- a/lisp/bin/skel.lisp Sat Sep 14 22:13:06 2024 -0400
2.2+++ b/lisp/bin/skel.lisp Sat Sep 14 23:55:38 2024 -0400
2.3@@ -21,11 +21,7 @@
2.4 *arg*)
2.5 :info)))
2.6
2.7-;; TODO 2023-10-13: almost there
2.8-(defopt skc-config
2.9- (load-user-skelrc (or
2.10- *arg*
2.11- *user-skelrc*)))
2.12+(defopt skc-config (load-user-skelrc (or *arg* *user-skelrc*)))
2.13
2.14 (defcmd skc-edit
2.15 (let ((file (or (when *args* (pop *args*)) (sk-path *skel-project*))))
2.16@@ -82,7 +78,7 @@
2.17 (if (null args)
2.18 (sk-call *skel-project* action)
2.19 (mapc (lambda (x)
2.20- (sk-call *skel-project* (keywordicate action '- (string-upcase x))))
2.21+ (sk-call *skel-project* (keywordicate (symbol-name action) '- (string-upcase x))))
2.22 args))))
2.23
2.24 (defcmd skc-compile
2.25@@ -134,7 +130,7 @@
2.26 (":cache" (sk-cache *skel-user-config*))))
2.27
2.28 (defcmd skc-show
2.29- (if *args*
2.30+ (if *args*
2.31 (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) *args*)
2.32 (describe (if (boundp '*skel-project*) *skel-project*
2.33 (if (boundp '*skel-user-config*) *skel-user-config*
2.34@@ -201,10 +197,12 @@
2.35 (defcmd skc-run
2.36 (if *args*
2.37 (mapc (lambda (script)
2.38- (when-let ((script (sk-find-script
2.39- (pathname-name script)
2.40- (find-skelfile #P"." :load t))))
2.41- (debug! (sk-run script))))
2.42+ ;; first check if a script with the same name exists, else check for a rule definition
2.43+ (if-let ((script (sk-find-script
2.44+ (pathname-name script)
2.45+ (find-skelfile #P"." :load t))))
2.46+ (sk-run script)
2.47+ (call-with-args :run (list script))))
2.48 *args*)
2.49 (required-argument 'name)))
2.50
2.51@@ -258,9 +256,7 @@
2.52 :thunk skc-describe)
2.53 (:name show
2.54 :description "show project slots"
2.55- :opts ((:name "file" :description "path to skelfile" :kind file)
2.56- (:name "user" :description "print user configuration")
2.57- (:name "system" :description "print system configuration"))
2.58+ :opts ((:name "file" :description "path to skelfile" :kind file))
2.59 :thunk skc-show)
2.60 (:name vc
2.61 :description "version control"
2.62@@ -290,6 +286,9 @@
2.63 (:name build
2.64 :description "build programs and libraries"
2.65 :thunk skc-build)
2.66+ (:name save
2.67+ :description "save a file"
2.68+ :thunk skc-save)
2.69 (:name dist
2.70 :description "distribute build artifacts"
2.71 :thunk skc-dist)
3.1--- a/lisp/lib/cli/clap/cmd.lisp Sat Sep 14 22:13:06 2024 -0400
3.2+++ b/lisp/lib/cli/clap/cmd.lisp Sat Sep 14 23:55:38 2024 -0400
3.3@@ -164,7 +164,7 @@
3.4 (%compose-short-opt o)
3.5 ;; TODO 2024-09-11: signal error?
3.6 (with-opt-restart-case a
3.7- (clap-unknown-argument a)))
3.8+ (clap-unknown-argument a 'cli-opt)))
3.9 else if (long-opt-p a) ;; LONG OPT
3.10 collect
3.11 (let ((o (car (find-opts self (string-left-trim "-" a) :recurse t)))
3.12@@ -179,7 +179,7 @@
3.13 (setq skip t)))
3.14 (t ;; (not o) (not has-eq)
3.15 (with-opt-restart-case a
3.16- (clap-unknown-argument a)))))
3.17+ (clap-unknown-argument a 'cli-opt)))))
3.18 ;; OPT GROUP
3.19 else if (opt-group-p a)
3.20 collect (make-cli-node 'group nil)
4.1--- a/lisp/lib/cli/clap/proto.lisp Sat Sep 14 22:13:06 2024 -0400
4.2+++ b/lisp/lib/cli/clap/proto.lisp Sat Sep 14 23:55:38 2024 -0400
4.3@@ -16,10 +16,10 @@
4.4 (deferror clap-invalid-argument (clap-error invalid-argument) ())
4.5 (defwarning clap-simple-warning (simple-warning clap-warning) () (:auto t)))
4.6
4.7-(defun clap-unknown-argument (arg &optional kind)
4.8+(defun clap-unknown-argument (arg kind)
4.9 (error 'clap-unknown-argument :name arg :kind kind))
4.10
4.11-(defun clap-missing-argument (arg &optional kind)
4.12+(defun clap-missing-argument (arg kind)
4.13 (error 'clap-missing-argument :item arg :kind kind))
4.14
4.15 (defun clap-invalid-argument (arg &key reason kind)
5.1--- a/lisp/lib/cli/tests.lisp Sat Sep 14 22:13:06 2024 -0400
5.2+++ b/lisp/lib/cli/tests.lisp Sat Sep 14 23:55:38 2024 -0400
5.3@@ -682,7 +682,7 @@
5.4 (signals clap-unknown-argument
5.5 (proc-args *cli* '("--log" "default" "--foo=11"))))
5.6
5.7-(defmain foo-main (:exit nil :export nil)
5.8+(defmain foo-main (:exit nil)
5.9 (with-cli (*cli*) ()
5.10 (log:trace! "defmain is OK")
5.11 t))
6.1--- a/lisp/lib/vc/tests.lisp Sat Sep 14 22:13:06 2024 -0400
6.2+++ b/lisp/lib/vc/tests.lisp Sat Sep 14 23:55:38 2024 -0400
6.3@@ -5,8 +5,7 @@
6.4 (defsuite :vc)
6.5 (in-suite :vc)
6.6
6.7-(defmacro with-temp-repo ((kind &rest opts) &body body)
6.8- (declare (ignore opts)) ;; TODO 2024-06-01:
6.9+(defmacro with-temp-repo (kind &body body)
6.10 `(let ((repo ,(make-repo ".")))
6.11 (setf (vc-path repo) (merge-pathnames (format nil "~A" (gensym "repo")) "/tmp/"))
6.12 (case ,kind
6.13@@ -18,11 +17,11 @@
6.14 ,@body)))
6.15
6.16 (deftest git ()
6.17- (with-temp-repo (:git)
6.18+ (with-temp-repo :git
6.19 (is (streamp (sb-ext:process-output (run-git-command "status" nil :stream))))))
6.20
6.21 (deftest hg ()
6.22- (with-temp-repo (:hg)
6.23+ (with-temp-repo :hg
6.24 (is (streamp (sb-ext:process-output (run-hg-command "status" nil :stream))))))
6.25
6.26 (deftest vc ()
6.27@@ -30,6 +29,7 @@
6.28
6.29 ;; TODO 2024-08-22:
6.30 (deftest vc-mirror-update (:skip t)
6.31- "This test replicates a nushell script we've used for a very long time."
6.32- (with-temp-repo (:hg)
6.33- (vc-id repo)))
6.34+ "This test replicates a nushell script we've used for a very long time - 'use
6.35+vc.nu; vc mirrors update;'"
6.36+ (with-temp-repo :hg
6.37+ (vc-id repo)))
7.1--- a/lisp/lib/vc/vc.asd Sat Sep 14 22:13:06 2024 -0400
7.2+++ b/lisp/lib/vc/vc.asd Sat Sep 14 23:55:38 2024 -0400
7.3@@ -1,16 +1,17 @@
7.4 (defsystem :vc
7.5 :depends-on (:std :cli :obj :net :log :parse)
7.6- :components ((:file "pkg")
7.7- (:file "proto")
7.8- (:file "hg")
7.9- ;; (:module "hg"
7.10- ;; :components
7.11- ;; ())
7.12- (:file "git")
7.13- ;; (:module "git"
7.14- ;; :components
7.15- ;; ())
7.16- (:file "vc"))
7.17+ :components
7.18+ ((:file "pkg")
7.19+ (:file "proto")
7.20+ (:file "hg")
7.21+ ;; (:module "hg"
7.22+ ;; :components
7.23+ ;; ())
7.24+ (:file "git")
7.25+ ;; (:module "git"
7.26+ ;; :components
7.27+ ;; ())
7.28+ (:file "vc"))
7.29 :in-order-to ((test-op (test-op :vc/tests))))
7.30
7.31 (defsystem :vc/tests
