amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix: LISP-STRUCTURAL-CHECK error by separating tests from main lisp files; fix T-as-variable in system-archivist, programming-org, system-memory; fix SOME arg count in org-privacy-tag-p

Browse Source 
- Separated test code from programming-lisp.org and programming-org.org into tests/ directory (was tangled to main lisp/, causing LOADER ERROR because export hadn't run yet)
- Added eval-when to load fiveam before test defpackage
- Renamed t→tag in lambda parameters in system-archivist, programming-org
- Renamed t→obj-type in let binding in system-memory
- Fixed missing lambda close paren in org-privacy-tag-p (SOME called with 1 arg)
This commit is contained in:
Amr Gharbeia
2026-05-04 11:58:21 -04:00
parent 619407c6e6
commit 5ab54091c1
8 changed files with 19 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
org/programming-lisp.org
View File

@@ -215,7 +215,7 @@ The skill has four layers:
* Test Suite
Tests for the Lisp Validator structural, syntactic, and semantic gates.
#+begin_src lisp :tangle ../lisp/programming-lisp.lisp
#+begin_src lisp :tangle ../tests/programming-lisp-tests.lisp
(defpackage :passepartout-utils-lisp-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-lisp-suite))

11
org/programming-org.org
View File

@@ -33,9 +33,9 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
(some (lambda (tag)
(some (lambda (private-tag)
(string-equal (string-trim '(#\: #\space) tag)
(string-trim '(#\: #\space) private-tag))
(string-trim '(#\: #\space) private-tag)))
privacy-tags))
tags-list)))))
tags-list))))
#+end_src
** org-privacy-strip
@@ -299,7 +299,7 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
;; Headline
(setf output (format nil "~a~@[ ~a~] ~a" stars todo title))
(when tags
(let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (t) (string-trim '(#\:) t)) tags))))
(let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (tag) (string-trim '(#\:) tag)) tags))))
(setf output (concatenate 'string output (format nil " :~a::~%" tag-str))))
(setf output (concatenate 'string output (string #\Newline))))
(unless tags
@@ -331,7 +331,10 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
* Test Suite
Verification of the structural manipulation for Org-mode files and their AST representation.
#+begin_src lisp :tangle ../lisp/programming-org.lisp
#+begin_src lisp :tangle ../tests/programming-org-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ignore-errors (ql:quickload :fiveam :silent t)))
(defpackage :passepartout-utils-org-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-org-suite))

2
org/system-archivist.org
View File

@@ -104,7 +104,7 @@ Returns a list of plists: (:title <str> :content <str> :tags <list>)."
(setf in-properties nil))
(when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed))
(setf current-tags
(mapcar (lambda (t) (string-trim '(#\Space) t))
(mapcar (lambda (tag) (string-trim '(#\Space) tag))
(uiop:split-string (string-trim '(#\Space) (subseq trimmed 6))
:separator '(#\space #\tab)))))
(cond

6
org/system-memory.org
View File

@@ -29,16 +29,16 @@ Returns a plist: (:total <n> :by-type <alist> :by-todo <alist>
(orphans 0))
(maphash (lambda (id obj)
(setf (gethash id all-ids) t)
(let ((t (memory-object-type obj))
(let ((obj-type (memory-object-type obj))
(attrs (memory-object-attributes obj))
(v (memory-object-version obj)))
(unless (and type-filter (not (eq t type-filter)))
(unless (and type-filter (not (eq obj-type type-filter)))
(let ((todo (getf attrs :TODO-STATE)))
(when (and todo-filter
(not (string-equal todo todo-filter)))
(return nil)))
(incf total)
(incf (gethash t type-counts 0))
(incf (gethash obj-type type-counts 0))
(let ((todo (getf attrs :TODO-STATE)))
(when todo
(incf (gethash todo todo-counts 0))))