kreyren/pman
1
0
Fork 0
Code Issues 16 Pull Requests 2 Releases Activity

Sync

Browse Source 
Signed-off-by: Jacob Hrbek <kreyren@rixotstudio.cz>
This commit is contained in:
Jacob Hrbek 2022-09-03 10:10:11 +02:00
parent 6a8b09699e
commit ddef402c69
Signed by: kreyren
GPG Key ID: 667F0DAFAF09BA2B
3 changed files with 239 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
TAGS.org
View File

@ -18,6 +18,15 @@ Which in practice might be used as:
- FIXME = Used to tag code that needs attention - FIXME = Used to tag code that needs attention
- FIXME-QA = Used to tag code with Quality Assurance issues - FIXME-QA = Used to tag code with Quality Assurance issues
- FIXME-DOCS = Tags code that needs documentation - FIXME-DOCS = Tags code that needs documentation
- FIXME-TRANSLATE = Needs definition for handling translations
- DNR = Do Not Release - Usage prevents new version release, used to tag code that needs to be addressed prior - DNR = Do Not Release - Usage prevents new version release, used to tag code that needs to be addressed prior
- DNM = Do Not Merge - Usage in merge/pull requests blocks syncing the code, used to tag code that needs to be addressed before merge can happen - DNM = Do Not Merge - Usage in merge/pull requests blocks syncing the code, used to tag code that needs to be addressed before merge can happen
- PROD/PRODUCTION = Code that should be considered prior to it's usage in production environment - PROD/PRODUCTION = Code that should be considered prior to it's usage in production environment
- TRANSLATE = Needs to be translated
** Repository-wide tags
Tags that apply repository-wide
- FIXME(Krey): The repository is using things like =(format ... (green)..)= to make the text green, these should be renamed on e.g. =(font-green)=

353
src/potato/rules.scm
View File

@ -759,73 +759,70 @@ failure condition happens, mark the node as having failed."
(define (create-node name parent) (define (create-node name parent)
"Constructs a tree of nodes, with name as the root node." "Constructs a tree of nodes, with name as the root node."
(when (and (node? parent) (> (node-depth parent) 30)) (when (and (node? parent) (> (node-depth parent) 30))
;; FIXME-TRANSLATE(Krey)
(error "Stack overflow")) (error "Stack overflow"))
(let ((node (make-node name parent 'undetermined))) (let ((node (make-node name parent 'undetermined)))
(node-set-children! node '()) (node-set-children! node '())
(node-set-rule-type! node 'default) (node-set-rule-type! node 'default)
;; FIXME: here check that this name differs from all ancestor's ;; FIXME(spk121): here check that this name differs from all ancestor's names
;; names
;; Try to the file's modification time. ;; Try to the file's modification time.
(when (file-exists? name) (when (file-exists? name)
(when (not (regular-file? name)) (when (not (regular-file? name))
(not-a-regular-file "create-node" name)) (not-a-regular-file "create-node" name))
(when (not (access? name R_OK)) (when (not (access? name R_OK))
(no-read-access-to-file "create-node" name)) (no-read-access-to-file "create-node" name))
(node-set-mtime! node (compute-mtime name))) (node-set-mtime! node (compute-mtime name)))
;; Search for matching target rule. ;; Search for matching target rule
(when (not (null? %target-rules)) (when (not (null? %target-rules))
(let loop ((rule (car %target-rules)) (let loop ((rule (car %target-rules))
(rest (cdr %target-rules))) (rest (cdr %target-rules)))
;; N.B: here we assume target rule names and ;; NOTE(spk121): here we assume target rule names and predicates are exclusively strings
;; predicates are exclusively strings. (if (string=? name (target-rule-get-name rule))
(if (string=? name (target-rule-get-name rule)) (begin
(begin ;; OK we have a matching rule
;; OK we have a matching rule (node-set-rules! node (list rule))
(node-set-rules! node (list rule)) (node-set-rule-type! node 'target)
(node-set-rule-type! node 'target) ;; For target-rules, the prerequisites comes from the rule itself
;; For target-rules, the prerequisites comes from the
;; rule itself.
;; Oooh, recursion! ;; Oooh, recursion!
(node-set-children! node (node-set-children! node
(map (lambda (prereq) (map (lambda (prereq)
(create-node prereq node)) (create-node prereq node))
(target-rule-get-prerequisites rule)))) (target-rule-get-prerequisites rule))))
;; else ;; else
(if (not (null? rest)) (if (not (null? rest))
(loop (car rest) (cdr rest)) (loop (car rest) (cdr rest))
;; else, no matching rule found ;; else, no matching rule found
(node-set-rules! node '()))))) (node-set-rules! node '())))))
;; If no rule found so far, search for suffix rules. ;; If no rule found so far, search for suffix rules.
(when (null? (node-get-rules node)) (when (null? (node-get-rules node))
(for-each (for-each
(lambda (rule) (lambda (rule)
(let ((targ (suffix-rule-get-target rule))) (let ((targ (suffix-rule-get-target rule)))
(when (string-suffix? targ name) (when (string-suffix? targ name)
;; For suffix rules, there will be exactly one child per ;; For suffix rules, there will be exactly one child per rule and the name of the child is constructed from a suffix and the parent's name
;; rule and the name of the child is constructed from a (node-set-rules! node (cons rule (node-get-rules node)))
;; suffix and the parent's name. (node-set-rule-type! node 'suffix)
(node-set-rules! node (cons rule (node-get-rules node))) (let* ((src (suffix-rule-get-source rule))
(node-set-rule-type! node 'suffix) (prereq
(let* ((src (suffix-rule-get-source rule)) (string-append
(prereq (string-drop-right name (string-length src))
(string-append src)))
(string-drop-right name (string-length src))
src)))
;; Note the recursion here. ;; Note the recursion here.
(node-set-children! node (node-set-children! node
(cons (create-node prereq node) (cons (create-node prereq node)
(node-get-children node))))))) (node-get-children node)))))))
%suffix-rules)) %suffix-rules))
;; FIXME: First matching rule has highest priority? Or is last better? ;; FIXME(spk121): First matching rule has highest priority? Or is last better?
(node-set-rules! node (reverse (node-get-rules node))) (node-set-rules! node (reverse (node-get-rules node)))
(node-set-children! node (reverse (node-get-children node))) (node-set-children! node (reverse (node-get-children node)))
;; FIXME(Krey): This was commented out by the original author, figure out what we want to do with it
;;(format #t "matching suffix rules ~S~%~!" (node-get-rules node)) ;;(format #t "matching suffix rules ~S~%~!" (node-get-rules node))
;;(format #t "matching children rules ~S~%~!" (node-get-children node)) ;;(format #t "matching children rules ~S~%~!" (node-get-children node))
@ -838,133 +835,155 @@ This is where the magic happens."
(let ((tree (create-node root #f))) (let ((tree (create-node root #f)))
(let ((node tree)) (let ((node tree))
(when (>= %verbosity 3) (when (>= %verbosity 3)
(format #t "~ABegin building target ~a~A~a.~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (format #t "~ABegin building target ~a~A~a.~%~!"
(node-depth-string node) (lquo) (node-get-name node) (rquo)))
(while #t (while #t
(when (>= %verbosity 3) (when (>= %verbosity 3)
(format #t "~AConsidering target ~a~A~a.~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (format #t "~AConsidering target ~a~A~a.~%~!"
(if (undetermined? node) (node-depth-string node) (lquo) (node-get-name node) (rquo)))
(begin (if (undetermined? node)
(when (>= %verbosity 3) (begin
(format #t "~ATarget file ~a~A~a is undetermined.~%~!" (when (>= %verbosity 3)
(node-depth-string node) (lquo) (node-get-name node) (rquo)) ;; FIXME-TRANSLATE(Krey)
(unless (node-get-mtime node) (format #t "~ATarget file ~a~A~a is undetermined.~%~!"
(format #t "~AFile ~a~A~a does not exist.~%~!" (node-depth-string node) (lquo) (node-get-name node) (rquo))
(node-depth-string node) (lquo) (node-get-name node) (rquo)))) (unless (node-get-mtime node)
(if (children-complete? node) ;; FIXME-TRANSLATE(Krey)
(begin (format #t "~AFile ~a~A~a does not exist.~%~!"
(when (and (>= %verbosity 3) (has-children? node)) (node-depth-string node) (lquo) (node-get-name node) (rquo))))
(format #t "~AFinished prerequisites of target file ~a~A~a.~%~!" (if (children-complete? node)
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (begin
(if (children-passed? node) (when (and (>= %verbosity 3) (has-children? node))
(begin ;; FIXME-TRANSLATE(Krey)
(when (and (>= %verbosity 3) (has-children? node)) (format #t "~AFinished prerequisites of target file ~a~A~a.~%~!"
(format #t "~AThe prerequisites of target file ~a~A~a have passed.~%~!" (node-depth-string node) (lquo) (node-get-name node) (rquo)))
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (if (children-passed? node)
(if (up-to-date? node) (begin
(begin (when (and (>= %verbosity 3) (has-children? node))
(when (node-get-mtime node) ;; FIXME-TRANSLATE(Krey)
(when (>= %verbosity 3) (format #t "~AThe prerequisites of target file ~a~A~a have passed.~%~!"
(format #t "~ATarget file ~a~A~a is up to date.~%~!" (node-depth-string node) (lquo) (node-get-name node) (rquo)))
(node-depth-string node) (if (up-to-date? node)
(lquo) (node-get-name node) (rquo)))) (begin
(set-pass! node)) (when (node-get-mtime node)
;; else, not up to date (when (>= %verbosity 3)
(begin ;; FIXME-TRANSLATE(Krey)
(when (>= %verbosity 3) (format #t "~ATarget file ~a~A~a is up to date.~%~!"
(format #t "~ATarget file ~a~A~a is not up to date.~%~!" (node-depth-string node)
(node-depth-string node) (lquo) (node-get-name node) (rquo))))
(lquo) (node-get-name node) (rquo))) (set-pass! node))
(cond ;; else, not up to date
((using-target-rule? node) (begin
(when (>= %verbosity 3) (when (>= %verbosity 3)
(format #t "~ATarget file ~a~A~a has a target rule.~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (format #t "~ATarget file ~a~A~a is not up to date.~%~!"
(lquo) (node-get-name node) (rquo))) (node-depth-string node)
(run-target-rule! node)) (lquo) (node-get-name node) (rquo)))
((using-suffix-rules? node) (cond
(when (>= %verbosity 3) ((using-target-rule? node)
(format #t "~ATarget file ~a~A~a has a suffix rule.~%~!" (when (>= %verbosity 3)
(node-depth-string node) ;; FIXME-TRANSLATE(Krey)
(lquo) (node-get-name node) (rquo))) (format #t "~ATarget file ~a~A~a has a target rule.~%~!"
(run-suffix-rules! node)) (node-depth-string node)
((using-default-rule? node) (lquo) (node-get-name node) (rquo)))
(when (>= %verbosity 3) (run-target-rule! node))
(format #t "~ATarget file ~a~A~a is using the default rule.~%~!" ((using-suffix-rules? node)
(node-depth-string node) (when (>= %verbosity 3)
(lquo) (node-get-name node) (rquo))) (format #t "~ATarget file ~a~A~a has a suffix rule.~%~!"
(run-default-rule! node)) (node-depth-string node)
(else (lquo) (node-get-name node) (rquo)))
(error "bad rules"))) (run-suffix-rules! node))
((using-default-rule? node)
(when (>= %verbosity 3)
;; FIXME-TRANSLATE(Krey)
(format #t "~ATarget file ~a~A~a is using the default rule.~%~!"
(node-depth-string node)
(lquo) (node-get-name node) (rquo)))
(run-default-rule! node))
(else
(error "bad rules")))
(if (passed? node) (if (passed? node)
(when (>= %verbosity 3) (when (>= %verbosity 3)
(format #t "~ATarget file ~a~A~a has passed.~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (format #t "~ATarget file ~a~A~a has passed.~%~!"
(lquo) (node-get-name node) (rquo))) (node-depth-string node)
(when (>= %verbosity 3) (lquo) (node-get-name node) (rquo)))
(format #t "~ATarget file ~a~A~a has failed.~%~!" (when (>= %verbosity 3)
(node-depth-string node) ;; FIXME-TRANSLATE(Krey)
(lquo) (node-get-name node) (rquo))))))) (format #t "~ATarget file ~a~A~a has failed.~%~!"
;; else, children have failed (node-depth-string node)
(begin (lquo) (node-get-name node) (rquo)))))))
(when (>= %verbosity 3) ;; else, children have failed
(format #t "~AThe prerequisites of target file ~a~A~a have failed.~%~!" (begin
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (when (>= %verbosity 3)
(set-fail! node)))) (format #t "~AThe prerequisites of target file ~a~A~a have failed.~%~!"
;; else, children aren't complete (node-depth-string node) (lquo) (node-get-name node) (rquo)))
(begin (set-fail! node))))
(when (>= %verbosity 3) ;; else, children aren't complete
(format #t "~AThe prerequisites of target file ~a~A~a are incomplete.~%~!" (begin
(node-depth-string node) (lquo) (node-get-name node) (rquo))) (when (>= %verbosity 3)
(let ((next (get-next-child node))) ;; FIXME-TRANSLATE(Krey)
(when (>= %verbosity 3) (format #t "~AThe prerequisites of target file ~a~A~a are incomplete.~%~!"
(format #t "~ADescending node ~a~A~a ~a ~a~A~a.~%~!" (node-depth-string node) (lquo) (node-get-name node) (rquo)))
(node-depth-string node) (let ((next (get-next-child node)))
(lquo) (node-get-name node) (rquo) (when (>= %verbosity 3)
(right-arrow) ;; FIXME-TRANSLATE(Krey)
(lquo) (node-get-name next) (rquo))) (format #t "~ADescending node ~a~A~a ~a ~a~A~a.~%~!"
(set! node (get-next-child node)) (node-depth-string node)
)))) (lquo) (node-get-name node) (rquo)
;; else, this node is determined (right-arrow)
(begin (lquo) (node-get-name next) (rquo)))
(if (passed? node) (set! node (get-next-child node))
(when (>= %verbosity 2) ))))
(format #t "~A~a~A~a: ~APASS~A~%~!" ;; else, this node is determined
(node-depth-string node) (lquo) (node-get-name node) (rquo) (begin
(green) (default))) (if (passed? node)
(when (>= %verbosity 2) (when (>= %verbosity 2)
(format #t "~A~a~A~a: ~AFAIL~A~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (lquo) (node-get-name node) (rquo) (format #t "~A~a~A~a: ~APASS~A~%~!"
(red) (default)))) (node-depth-string node) (lquo) (node-get-name node) (rquo)
(if (has-parent? node) (green) (default)))
(begin (when (>= %verbosity 2)
(when (>= %verbosity 3) ;; FIXME-TRANSLATE(Krey)
(format #t "~AAscending node ~a~A~a ~a ~a~A~a.~%~!" (format #t "~A~a~A~a: ~AFAIL~A~%~!"
(node-depth-string node) (node-depth-string node) (lquo) (node-get-name node) (rquo)
(lquo) (node-get-name node) (rquo) (red) (default))))
(right-arrow) (if (has-parent? node)
(lquo) (node-get-name (node-get-parent node)) (rquo))) (begin
(when (>= %verbosity 3)
;; FIXME-TRANSLATE(Krey)
(format #t "~AAscending node ~a~A~a ~a ~a~A~a.~%~!"
(node-depth-string node)
(lquo) (node-get-name node) (rquo)
(right-arrow)
(lquo) (node-get-name (node-get-parent node)) (rquo)))
(set! node (get-parent node))) (set! node (get-parent node)))
;; else, there is no parent to this node ;; else, there is no parent to this node
(begin (begin
(when (>= %verbosity 3) (when (>= %verbosity 3)
(format #t "~ATarget file ~a~A~a has no parent.~%~!" ;; FIXME-TRANSLATE(Krey)
(node-depth-string node) (format #t "~ATarget file ~a~A~a has no parent.~%~!"
(lquo) (node-get-name node) (rquo))) (node-depth-string node)
(if (passed? node) (lquo) (node-get-name node) (rquo)))
(when (>= %verbosity 1) (if (passed? node)
(format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" (when (>= %verbosity 1)
(node-depth-string node) ;; FIXME-TRANSLATE(Krey)
(lquo) (node-get-name node) (rquo) (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!"
(green) (default))) (node-depth-string node)
(when (>= %verbosity 1) (lquo) (node-get-name node) (rquo)
(format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" (green) (default)))
(node-depth-string node) (when (>= %verbosity 1)
(lquo) (node-get-name node) (rquo) ;; FIXME-TRANSLATE(Krey)
(red) (default)))) (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!"
(break))))))) (node-depth-string node)
(lquo) (node-get-name node) (rquo)
(red) (default))))
(break)))))))
;; Return the command output of the root node ;; Return the command output of the root node
(passed? tree))) (passed? tree)))
;;; rules.scm ends here

56
src/potato/text.scm
View File

@ -16,91 +16,113 @@
(define-module (potato text) (define-module (potato text)
#:export (underline #:export (underline
default default
right-arrow right-arrow
left-arrow left-arrow
ellipses ellipses
C0 C0
red green red green
lquo lquo
rquo rquo
initialize-text)) initialize-text))
;;; Commentary:
;;;
;;; File handling the text formatting in the repository
;;;
;;; Code:
(define %fancy #t) (define %fancy #t)
(define (initialize-text ascii) (define (initialize-text ascii)
"FIXME-DOCS"
(set! %fancy (not ascii))) (set! %fancy (not ascii)))
(define (default) (define (default)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\0 #\m) (string #\escape #\[ #\0 #\m)
"")) ""))
(define (bold) (define (bold)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\1 #\m) (string #\escape #\[ #\1 #\m)
"")) ""))
(define (underline) (define (underline)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\4 #\m) (string #\escape #\[ #\4 #\m)
"")) ""))
(define (red) (define (red)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\3 #\1 #\m) (string #\escape #\[ #\3 #\1 #\m)
"")) ""))
(define (green) (define (green)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\3 #\2 #\m) (string #\escape #\[ #\3 #\2 #\m)
"")) ""))
(define (blue) (define (blue)
"FIXME-DOCS"
(if %fancy (if %fancy
(string #\escape #\[ #\3 #\4 #\m) (string #\escape #\[ #\3 #\4 #\m)
"")) ""))
(define (important) (define (important)
"FIXME-DOCS"
(if %fancy (if %fancy
"⚠" ; U+26A0 WARNING SIGN "⚠" ; U+26A0 WARNING SIGN
"!!!")) "!!!"))
(define (stop) (define (stop)
"FIXME-DOCS"
(if %fancy (if %fancy
"🛑" ; U+26A0 WARNING SIGN "🛑" ; U+26A0 WARNING SIGN
"XXX")) "XXX"))
(define (right-arrow) (define (right-arrow)
"FIXME-DOCS"
(if %fancy (if %fancy
"→" "->")) "→" "->"))
(define (left-arrow) (define (left-arrow)
"FIXME-DOCS"
(if %fancy (if %fancy
"←" "<-")) "←" "<-"))
(define (ellipses) (define (ellipses)
"FIXME-DOCS"
(if %fancy "…" "...")) (if %fancy "…" "..."))
(define (QED) (define (QED)
"FIXME-DOCS"
(if %fancy "∎" "QED")) ; U+220E END OF PROOF (if %fancy "∎" "QED")) ; U+220E END OF PROOF
(define (C0 c) (define (C0 c)
"FIXME-DOCS"
(if %fancy (if %fancy
;; Replace control codes with control pictures ;; Replace control codes with control pictures
(string (integer->char (+ #x2400 (char->integer c)))) (string (integer->char (+ #x2400 (char->integer c))))
(list-ref '("<NUL>" "<SOH>" "<STX>" "<ETX>" "<EOT>" "<ENQ>" (list-ref '("<NUL>" "<SOH>" "<STX>" "<ETX>" "<EOT>" "<ENQ>"
"<ACK>" "<BEL>" "<BS>" "<HT>" "<LF>" "<ACK>" "<BEL>" "<BS>" "<HT>" "<LF>"
"<VT>" "<FF>" "<CR>" "<SO>" "<SI>" "<VT>" "<FF>" "<CR>" "<SO>" "<SI>"
"<DLE>" "<DC1>" "<DC2>" "<DC3>" "<DC4>" "<DLE>" "<DC1>" "<DC2>" "<DC3>" "<DC4>"
"<NAK>" "<SYN>" "<ETB>" "<CAN>" "<EM>" "<NAK>" "<SYN>" "<ETB>" "<CAN>" "<EM>"
"<SUB>" "<ESC>" "<FS>" "<GS>" "<RS>" "<SUB>" "<ESC>" "<FS>" "<GS>" "<RS>"
"<US>") "<US>")
(char->integer c)))) (char->integer c))))
(define (lquo) (define (lquo)
"FIXME-DOCS"
(if %fancy (string #\“) (string #\"))) (if %fancy (string #\“) (string #\")))
(define (rquo) (define (rquo)
"FIXME-DOCS"
(if %fancy (string #\”) (string #\"))) (if %fancy (string #\”) (string #\")))
(define (BOL) (define (BOL)
@ -122,3 +144,5 @@ in normal mode it is
then then
☒ target -> parent (on pass) ☒ target -> parent (on pass)
|# |#
;; text.scm ends here