From 66772f99e8c6a472d8ba54aaafcd8707480b5eac Mon Sep 17 00:00:00 2001 From: Jacob Hrbek Date: Tue, 30 Aug 2022 12:46:29 +0200 Subject: [PATCH] Sync Signed-off-by: Jacob Hrbek --- pmake | 3 - pman | 20 ++ {make => src/pmake}/main.scm | 3 +- {make => src/pmake}/zz-README.org | 0 {potato => src/pmake}/zz-README.org~ | 0 {potato => src/potato}/builtins.scm | 45 +--- {potato => src/potato}/exceptions.scm | 31 ++- {potato => src/potato}/make.scm | 54 ++-- {potato => src/potato}/makevars.scm | 357 ++++++++++++++------------ {potato => src/potato}/parse-lib.scm | 0 {potato => src/potato}/parse.scm | 0 {potato => src/potato}/parser.scm | 0 {potato => src/potato}/rules.scm | 0 {potato => src/potato}/text.scm | 0 {potato => src/potato}/zz-README.org | 0 src/potato/zz-README.org~ | 0 src/zz-README.org | 1 + 17 files changed, 262 insertions(+), 252 deletions(-) delete mode 100755 pmake create mode 100755 pman rename {make => src/pmake}/main.scm (89%) rename {make => src/pmake}/zz-README.org (100%) rename {potato => src/pmake}/zz-README.org~ (100%) rename {potato => src/potato}/builtins.scm (66%) rename {potato => src/potato}/exceptions.scm (77%) rename {potato => src/potato}/make.scm (89%) rename {potato => src/potato}/makevars.scm (58%) rename {potato => src/potato}/parse-lib.scm (100%) rename {potato => src/potato}/parse.scm (100%) rename {potato => src/potato}/parser.scm (100%) rename {potato => src/potato}/rules.scm (100%) rename {potato => src/potato}/text.scm (100%) rename {potato => src/potato}/zz-README.org (100%) create mode 100644 src/potato/zz-README.org~ create mode 100644 src/zz-README.org diff --git a/pmake b/pmake deleted file mode 100755 index 4c6e61f..0000000 --- a/pmake +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env sh -exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@" -!# diff --git a/pman b/pman new file mode 100755 index 0000000..79a2f6f --- /dev/null +++ b/pman @@ -0,0 +1,20 @@ +#!/usr/bin/env sh +# shellcheck shell=sh # Written to comply with IEEE Std 1003.1-2017 (POSIX) +# The Project Manager ("pman") -- GNU Guile-based solution for project management +# Copyright (C) 2022 Jacob Hrbek +# +# This file is Free/Libre Open-Source Software; you may copy, redistribute and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version. +# This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public license along with this project. If not, see +# +# This file incorporates work covered by the following copyright and permission notice: +# +# Copyright (C) 2017-2021 Mike Gran +# +# Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@" +!# diff --git a/make/main.scm b/src/pmake/main.scm similarity index 89% rename from make/main.scm rename to src/pmake/main.scm index 25e7010..bd6b3aa 100644 --- a/make/main.scm +++ b/src/pmake/main.scm @@ -20,11 +20,10 @@ ;;; Commentary: ;;; -;;; Backend for the `pmake` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual . +;;; Backend for the `pman` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual . ;;; ;;; Code: -;; FIXME-QA(Krey): Is this even needed? ;; Declare exit codes (define EXIT_SUCCESS 0) (define EXIT_NOT_UP_TO_DATE 1) diff --git a/make/zz-README.org b/src/pmake/zz-README.org similarity index 100% rename from make/zz-README.org rename to src/pmake/zz-README.org diff --git a/potato/zz-README.org~ b/src/pmake/zz-README.org~ similarity index 100% rename from potato/zz-README.org~ rename to src/pmake/zz-README.org~ diff --git a/potato/builtins.scm b/src/potato/builtins.scm similarity index 66% rename from potato/builtins.scm rename to src/potato/builtins.scm index 450a38c..05f1f68 100644 --- a/potato/builtins.scm +++ b/src/potato/builtins.scm @@ -16,13 +16,11 @@ (define-module (potato builtins) - #:export (builtin-makevars -; builtin-rules - )) + #:export (builtin-makevars)) ;;; Commentary: ;;; -;;; Declaration of the built-in functionality such as variables and helper rules +;;; Dedicated to the declaration of built-in functionality such as variables, rules, tasks, etc.. ;;; ;;; Code: @@ -43,43 +41,4 @@ ("GUILD" . "guild") ("GFLAGS" . "-W2"))) -;; FIXME(Krey): This was commented out by the original author and it's use needs to be abstracted and re-implemented -#;(define builtin-rules - `((".c" - "" - (,~ ,($ CC) ,($ CFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<)) - (".f" - "" - (,~ ,($ FC) ,($ FFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<)) - (".sh" - "" - (,~ "cp" ,$< ,$@) - (,~ "chmod a+x" ,$@)) - (".c" - ".o" - (,~ ,($ CC) ,($ CFLAGS) -c ,$<)) - (".f" - ".o" - (,~ ,($ FC) ,($ FFLAGS) -c ,$<)) - (".y" - ".o" - (,~ ,($ YACC) ,($ YFLAGS) ,$<)) - (".l" - ".o" - (,~ ,($ LEX) ,($ LFLAGS) ,$<) - (,~ ,($ CC) ,($ CFLAGS) "-c" lex.yy.c) - "rm -f lex.yy.c" - (,~ "mv lex.yy.o" ,$@)) - (".y" - ".c" - (,~ ,($ YACC) ,($ YFLAGS) ,$<) - (,~ "mv y.tab.c" ,$@)) - (".l" - ".c" - (,~ ,($ LEX) ,($ LDFLAGS) ,$<) - ("mv lex.yy.c" ,$@)) - (".scm" - ".go" - (,~ ,($ GUILD) "compile" ,($ GFLAGS) ,$<)))) - ;;; builtins.scm ends here diff --git a/potato/exceptions.scm b/src/potato/exceptions.scm similarity index 77% rename from potato/exceptions.scm rename to src/potato/exceptions.scm index 5cda7de..1415398 100644 --- a/potato/exceptions.scm +++ b/src/potato/exceptions.scm @@ -14,7 +14,7 @@ ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE --(define-module (potato exceptions) +(define-module (potato exceptions) #:use-module (ice-9 exceptions) #:export (bad-key-type bad-value-type @@ -22,30 +22,44 @@ invalid-macro not-a-regular-file not-a-procedure - no-read-access-to-file - )) + no-read-access-to-file)) + +;;; Commentary: +;;; +;;; Dedicated to handling 'exceptions' as in termination of the program +;;; +;;; Code: + +;; FIXME-QA(Krey): This code is using 'bad' which is hard to understand without context, thus should be changed on 'unexpected' (define (make-bad-key-type origin irritants) + "Exception used when bad key is parsed to 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) + ;; FIXME-TRANSLATE(Krey) (make-exception-with-message "Wrong type for key. Expecting string or procedure.") (make-exception-with-irritants irritants))) (define (bad-key-type origin irritant) + "Generic exception for unexpected key" (raise-exception (make-bad-key-type origin irritant))) (define (make-bad-value-type origin irritants) + "Exception for unexpected value in the 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) + ;; FIXME-TRANSLATE(Krey) (make-exception-with-message "Wrong type for value. Expecting string or procedure.") (make-exception-with-irritants irritants))) (define (bad-value-type origin irritant) + "Generic exception for unexpected value" (raise-exception (make-bad-value-type origin irritant))) (define (make-bad-proc-output origin irritants) + "Exception for unexpected process output in 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) @@ -53,9 +67,11 @@ (make-exception-with-irritants irritants))) (define (bad-proc-output origin irritant) + "Generic exception for unexpected process output" (raise-exception (make-bad-proc-output origin irritant))) (define (make-invalid-macro origin irritants) + "Exception for invalid macro in 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) @@ -63,9 +79,11 @@ (make-exception-with-irritants irritants))) (define (invalid-macro origin irritant) + "Generic exception for invalid macro" (raise-exception (make-invalid-macro origin irritant))) (define (make-not-a-regular-file origin irritants) + "Exception for not regular file in 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) @@ -73,9 +91,11 @@ (make-exception-with-irritants irritants))) (define (not-a-regular-file origin irritant) + "Generic exception for when regular file is not parsed" (raise-exception (make-not-a-regular-file origin irritant))) (define (make-not-a-procedure origin irritants) + "Exception for when regular file is not parsed in the 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) @@ -83,9 +103,11 @@ (make-exception-with-irritants irritants))) (define (not-a-procedure origin irritant) + "Generic exception for when procedure is not parsed" (raise-exception (make-not-a-procedure origin irritant))) (define (make-no-read-access-to-file origin irritants) + "Exception for when we don't have the expected read access to the file in 'make' functionality" (make-exception (make-programming-error) (make-exception-with-origin origin) @@ -93,4 +115,7 @@ (make-exception-with-irritants irritants))) (define (no-read-access-to-file origin irritant) + "Generic exception for when we don't have the excepted read access to the file" (raise-exception (make-no-read-access-to-file origin irritant))) + +;;; exceptions.scm end here diff --git a/potato/make.scm b/src/potato/make.scm similarity index 89% rename from potato/make.scm rename to src/potato/make.scm index 772fa60..f244fb2 100644 --- a/potato/make.scm +++ b/src/potato/make.scm @@ -29,7 +29,6 @@ #:re-export (%suffix-rules lazy-assign ?= assign := - ;; WTF(Krey): Why is the 'Q' here? reference $ Q reference-func $$ target-rule : @@ -47,26 +46,21 @@ ;;; Commentary: ;;; -;;; TBD +;;; Entry file to the project, designed for handling the functionality ;;; ;;; Code: +;; FIXME-QA(Krey): This file includes debugging utilities that should be exported into a standalone library to make this software more maintainable +;; FIXME-QA(Krey): Needs refactor + +;; FIXME-QA(Krey): Why is this here? ;; Project version (define %version "1.0") ;; WTF(Krey) (define %debug-argv0 #f) -;; WTF(Krey): Was commented out by the original author.. no idea why -;; #:re-export ( -;; lazy-assign ?= -;; assign := -;; ref $ -;; target-rule : -;; suffix-rule -> -;; compose ~ -;; )) - +;; FIXME-DOCS(Krey): Lacks context ;;; Asynchronous events. ;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target ;;; unless that target is a directory or the target is a prerequisite @@ -88,27 +82,31 @@ ;;; If the -t option was specified, make shall write to standard ;;; output a message for each file that was touched. +;;; Output handlers +;;; These handlers are designed to be used for debug management ;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose (define %verbosity 2) -;; WTF(Krey) +;; WTF(Krey): Option to set verbose output and %verbosity defining the "deepness" of output? (define %opt-verbose #f) -;; WTF(Krey) +;; WTF(Krey): Option to ignore errors? (define %opt-ignore-errors #f) -;; WTF(Krey) +;; WTF(Krey): Option to continue on errors? (define %opt-continue-on-error #f) -;; WTF(Krey) +;; WTF(Krey): Generic definition of targets for appending? (define %targets '()) -;; WTF(Krey) +;; WTF(Krey): No idea (define %initialized #f) -;; Output handlers (define (critical spec . args) + "Output to handle 'cricital' output messages" (apply format (append (list #t spec) args))) ;; FIXME-QA(Krey): The 'print' is too generic, should we rename it? (define (print spec . args) + "Output to handle printing of output. Only works when verbosity is set to 2 and higher" (when (>= %verbosity 2) (apply format (append (list #t spec) args)))) (define (debug spec . args) + "Output to handle level 3 debug messages" (when (>= %verbosity 3) (apply format (append (list #t spec) args)))) @@ -127,6 +125,7 @@ ;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient (define (display-help-and-exit argv0) + "Function used to output help message and exit" (format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0) (format #t " -h, --help print help and exit~%") (format #t " -v, --version print version and exit~%") @@ -148,11 +147,11 @@ (format #t " ASCII only output and no colors~%") (format #t " -S, --strict~%") (format #t " causes some behaviours to throw errors~%") - ;; FIXME-QA(Krey): 'exit'? It should be using 'throw' (exit 0)) +;; FIXME-QA(Krey): Why is this accepting input? (define (display-version-and-exit argv0) - "Procedure to output the project version and exit" + "Function to output the project version and exit" (format #t "~a~%" argv0) (format #t " using potato make~a~%" %version) (exit 0)) @@ -173,8 +172,7 @@ of pairs of KEY VAL" lst)) (define (parse-targets lst) - "Search the list for strings that don't have equals signs, and -return them in a list." + "Search the list for strings that don't have equals signs, and return them in a list." (filter-map (lambda (str) (if (string-index str #\=) @@ -184,13 +182,7 @@ return them in a list." (define* (initialize #:optional (arguments #f)) - "Set up the options, rules, and makevars. If ARGUMENTS -is not set, it will use options, makevars, and targets as -specified by the command line. If it is set, it is -expected to be a list of strings that are command-line -arguments." - - ;; If left unset, assume user want all the command line arguments. + "Set up the options, rules, and makevars. If ARGUMENTS is not set, it will use options, makevars, and targets as specified by the command line. If it is set, it is expected to be a list of strings that are command-line arguments." ;; If left unset, assume user want all the command line arguments. (when (not arguments) (set! arguments (command-line))) ;; If the user has set it to '(), expecting a null environment, add @@ -284,9 +276,7 @@ arguments." %opt-no-execution %verbosity %opt-ascii) - (set! %initialized #t) - %targets - ))) + (set! %initialized #t) %targets))) (define* (execute #:key (targets '())) "This function runs build actions. TARGETS, if provided, is a list diff --git a/potato/makevars.scm b/src/potato/makevars.scm similarity index 58% rename from potato/makevars.scm rename to src/potato/makevars.scm index 2d56470..0d1a725 100644 --- a/potato/makevars.scm +++ b/src/potato/makevars.scm @@ -21,46 +21,66 @@ #:use-module (potato builtins) #:use-module (potato text) #:export (initialize-makevars - %makevars - %elevate-environment? - lazy-assign ?= - assign := - reference $ Q - reference-func $$ - dump-makevars - )) + %makevars + %elevate-environment? + lazy-assign ?= + assign := + reference $ Q + reference-func $$ + dump-makevars)) +;;; Commentary: +;;; +;;; Used to handle the 'makevars' functionality meaning assigning and managing environmental variables into variables used by guile +;;; +;;; Code: + +;; Defines the priority level ;; There are five priority levels -;; 1. defined - in the script itself -;; 2. command-line -;; 3. makeflags - in the MAKEFLAGS environment variable -;; 4. env - specified in the environment -;; 5. built-in - one of the built-in macros - +;; 1. defined - in the script itself +;; 2. command-line +;; 3. makeflags - in the MAKEFLAGS environment variable +;; 4. env - specified in the environment +;; 5. built-in - one of the built-in macros +;; ;; The lower priority level always win, unless the '-e' flag was set ;; If the '-e' flag is set level 1 doesn't override level 3 and 4. +(define %level-name '("unknown" + "script" + "command-line" + "makeflags" + "environment" + "built-in")) -(define %level-name '("unknown" "script" "command-line" "makeflags" "environment" "built-in")) - +;; WTF(Krey): No fucking idea.. something with ASCII? If ASCII is supported? (define %ascii? #f) + +;; WTF(Krey) (define %makevars (make-hash-table)) + +;; WTF(Krey) (define %elevate-environment? #f) + +;; WTF(Krey) (define %strict #f) + +;; WTF(Krey) (define %verbose? #t) + +;; WTF(Krey) (define (debug spec . args) + "Output to handle debugging messages" (when %verbose? (apply format (append (list #t spec) args)))) - (define (split-at-equals str) - "Splits the string at the first equals sign, ignoring -later equals signs." + "Splits the string at the first equals sign, ignoring later equals signs." (let ((idx (string-index str #\=))) (if (and idx (> idx 0)) - (cons (substring str 0 idx) - (substring str (1+ idx))) - ;; else - #f))) + (cons (substring str 0 idx) + (substring str (1+ idx))) + ;; else + #f))) (define (string-append-with-spaces lst) "Appends the strings in lst, adding spaces in between." @@ -75,69 +95,66 @@ later equals signs." others." (if %elevate-environment? (if (and (or (= old-priority 2) (= old-priority 3) (= old-priority 4)) - (= new-priority 1)) - #f - ;; else - (<= new-priority old-priority)) + (= new-priority 1)) + #f + ;; else + (<= new-priority old-priority)) ;; else (<= new-priority old-priority))) (define* (makevars-set key - #:optional (new-val "") (new-priority 1)) + #:optional (new-val "") (new-priority 1)) "Maybe add key / val to %makevars hash table, if there is sufficient priority." ;; Note that VAL can be either a string or a procedure. If it is a ;; procedure, it is converted into a promise to be evaluated later. (let* ((val&priority (hash-ref %makevars key)) - (old-val (if (pair? val&priority) (cdr val&priority) #f)) - (old-priority (if (pair? val&priority) (cdr val&priority) #f))) + (old-val (if (pair? val&priority) (cdr val&priority) #f)) + (old-priority (if (pair? val&priority) (cdr val&priority) #f))) (when (or (not old-val) - (override? old-priority new-priority)) + (override? old-priority new-priority)) (if (procedure? new-val) - (hash-set! %makevars key (cons (delay new-val) new-priority)) - (hash-set! %makevars key (cons new-val new-priority))) + (hash-set! %makevars key (cons (delay new-val) new-priority)) + (hash-set! %makevars key (cons new-val new-priority))) (when %verbose? (print-makevar key)))) *unspecified*) (define (makevars-add-keyvals keyvals) - "Adds any suitable macros passed in from the command line, which -here are expected to be a list of key / val string pairs." + "Adds any suitable macros passed in from the command line, which here are expected to be a list of key / val string pairs." (for-each (lambda (entry) (let ((key (car entry)) - (val (cdr entry))) + (val (cdr entry))) (unless (or (string=? key "SHELL") - (string=? key "MAKEFLAGS")) - (makevars-set key val 2)))) + (string=? key "MAKEFLAGS")) + (makevars-set key val 2)))) keyvals)) (define (makevars-add-makeflags) - "Adds any suitable environment variables found in the MAKEFLAGS -environment variable to the macro store" + "Adds any suitable environment variables found in the MAKEFLAGS environment variable to the macro store" (let ((makeflags (getenv "MAKEFLAGS"))) (when makeflags (for-each (lambda (entry) - (let* ((keyval (split-at-equals entry)) - (key (if keyval (car keyval) #f)) - (val (if keyval (cdr keyval) #f))) - (unless (or (not (string? key)) - (string=? key "SHELL") - (string=? key "MAKEFLAGS")) - (makevars-set key val 3)))) + (let* ((keyval (split-at-equals entry)) + (key (if keyval (car keyval) #f)) + (val (if keyval (cdr keyval) #f))) + (unless (or (not (string? key)) + (string=? key "SHELL") + (string=? key "MAKEFLAGS")) + (makevars-set key val 3)))) (string-split makeflags #\space))))) (define (makevars-add-environment) - "Adds any suitable environment variables to the macro store, but not -the value of MAKEFLAGS or SHELL." + "Adds any suitable environment variables to the macro store, but not the value of MAKEFLAGS or SHELL." (for-each (lambda (entry) (let* ((keyval (split-at-equals entry)) - (key (if keyval (car keyval) #f)) - (val (if keyval (cdr keyval) #f))) + (key (if keyval (car keyval) #f)) + (val (if keyval (cdr keyval) #f))) (unless (or (string=? key "SHELL") - (string=? key "MAKEFLAGS")) - (makevars-set key val 4)))) + (string=? key "MAKEFLAGS")) + (makevars-set key val 4)))) (environ))) (define (makevars-add-builtins) @@ -147,44 +164,45 @@ the value of MAKEFLAGS or SHELL." (makevars-set (car keyval) (cdr keyval) 5)) builtin-makevars)) +;; FIXME-DOCS(Krey) (define (print-makevar key) (let ((val (hash-ref %makevars key))) (let ((keyval-string - (if (zero? (string-length (car val))) - (string-copy key) - (string-append key " " (right-arrow) " " (car val))))) + (if (zero? (string-length (car val))) + (string-copy key) + (string-append key " " (right-arrow) " " (car val))))) ;; Replace any control characters in VAL, like newline or tab (set! keyval-string - (string-fold - (lambda (c str) - (string-append str - (if (char (string-length keyval-string) 60) - (if %ascii? - (set! keyval-string - (string-append (substring keyval-string 0 57) "...")) - (set! keyval-string - (string-append (substring keyval-string 0 59) "…")))) + (if %ascii? + (set! keyval-string + (string-append (substring keyval-string 0 57) "...")) + (set! keyval-string + (string-append (substring keyval-string 0 59) "…")))) (let* ((space (make-string (- 64 (string-length keyval-string)) - #\space)) - (priority (cdr val)) - (source-string (list-ref '("unknown" - "script" - "command line" - "MAKEFLAGS" - "environment" - "built-in") - priority))) - (display "Var: ") - (display keyval-string) - (display space) - (display source-string) - (newline))))) + #\space)) + (priority (cdr val)) + (source-string (list-ref '("unknown" + "script" + "command line" + "MAKEFLAGS" + "environment" + "built-in") + priority))) + (display "Var: ") + (display keyval-string) + (display space) + (display source-string) + (newline))))) (define (dump-makevars) "Write out a list of the current makevars." @@ -194,59 +212,60 @@ the value of MAKEFLAGS or SHELL." (display (default)) (newline) (let ((keyvals - (sort - (hash-map->list cons %makevars) - (lambda (a b) - (stringlist cons %makevars) + (lambda (a b) + (string (string-length keyval-string) 60) - (if %ascii? - (set! keyval-string - (string-append (substring keyval-string 0 57) "...")) - (set! keyval-string - (string-append (substring keyval-string 0 59) "…")))) - (let* ((space (make-string (- 64 (string-length keyval-string)) - #\space)) - (priority (cdr val)) - (source-string (list-ref '("unknown" - "script" - "command line" - "MAKEFLAGS" - "environment" - "built-in") - priority))) - (display " ") - (display keyval-string) - (display space) - (display source-string) - (newline))))) - keyvals)))) + (let ((key (car keyval)) + (val (cdr keyval))) + (let ((keyval-string + (if (zero? (string-length (car val))) + (string-copy key) + (string-append key " " (right-arrow) " " (car val))))) + ;; Replace any control characters in VAL, like newline or tab + (set! keyval-string + (string-fold + (lambda (c str) + (string-append str + (if (char (string-length keyval-string) 60) + (if %ascii? + (set! keyval-string + (string-append (substring keyval-string 0 57) "...")) + (set! keyval-string + (string-append (substring keyval-string 0 59) "…")))) + (let* ((space (make-string (- 64 (string-length keyval-string)) + #\space)) + (priority (cdr val)) + (source-string (list-ref '("unknown" + "script" + "command line" + "MAKEFLAGS" + "environment" + "built-in") + priority))) + (display " ") + (display keyval-string) + (display space) + (display source-string) + (newline))))) + keyvals)))) +;; FIXME-DOCS(Krey) (define (initialize-makevars keyvals - environment? - elevate-environment? - builtins? - strict? - verbosity - ascii?) + environment? + elevate-environment? + builtins? + strict? + verbosity + ascii?) (set! %elevate-environment? elevate-environment?) (hash-clear! %makevars) (set! %strict strict?) @@ -316,13 +335,13 @@ or a procedure that evaluates to a string. in the hash table was a *promise* it will be forced, evaluated, and set to that result. If no transformer is supplied, the looked up value will be -returned. +returned. TRANSFORMER, if supplied, should be a procedure of one string argument that returns a string. If a transformer is supplied, it will be applied to every space-separated token in the looked-up value." (when (and (not (string? key)) - (not (procedure? key))) + (not (procedure? key))) (bad-key-type "reference" (list key))) (when (procedure? key) (set! key (key)) @@ -331,42 +350,42 @@ space-separated token in the looked-up value." (when (not (string? key)) (set! key (format #t "~a" key))) (let* ((val&priority (hash-ref %makevars key)) - (val (if (pair? val&priority) (car val&priority) #f)) - (priority (if (pair? val&priority) (cdr val&priority) #f))) + (val (if (pair? val&priority) (car val&priority) #f)) + (priority (if (pair? val&priority) (cdr val&priority) #f))) (if (not val) - (if %strict - (error (format #t "There is no makevar for key ~a~%~!" key)) - ;; else - (if quoted? - "\"\"" - "")) - ;; else - (begin - (cond - ((promise? val) - (set! val (force val)) - (cond - ((string? val) - ;; noop - #t) - ((procedure? val) - (set! val (val))) - (else - (set! val (format #f "~a" val))))) - ((string? val) - ;; noop - #f) - (else - (set! val (format #f "~a" val)))) - (hash-set! %makevars key (cons val priority)) - (when %verbose? (print-makevar key)) - (when (procedure? transformer) - (set! val (string-append-with-spaces - (map transformer - (string-tokenize val))))) - (if quoted? - (string-append "\"" val "\"") - val))))) + (if %strict + (error (format #t "There is no makevar for key ~a~%~!" key)) + ;; else + (if quoted? + "\"\"" + "")) + ;; else + (begin + (cond + ((promise? val) + (set! val (force val)) + (cond + ((string? val) + ;; noop + #t) + ((procedure? val) + (set! val (val))) + (else + (set! val (format #f "~a" val))))) + ((string? val) + ;; noop + #f) + (else + (set! val (format #f "~a" val)))) + (hash-set! %makevars key (cons val priority)) + (when %verbose? (print-makevar key)) + (when (procedure? transformer) + (set! val (string-append-with-spaces + (map transformer + (string-tokenize val))))) + (if quoted? + (string-append "\"" val "\"") + val))))) (define-syntax $ (lambda (stx) diff --git a/potato/parse-lib.scm b/src/potato/parse-lib.scm similarity index 100% rename from potato/parse-lib.scm rename to src/potato/parse-lib.scm diff --git a/potato/parse.scm b/src/potato/parse.scm similarity index 100% rename from potato/parse.scm rename to src/potato/parse.scm diff --git a/potato/parser.scm b/src/potato/parser.scm similarity index 100% rename from potato/parser.scm rename to src/potato/parser.scm diff --git a/potato/rules.scm b/src/potato/rules.scm similarity index 100% rename from potato/rules.scm rename to src/potato/rules.scm diff --git a/potato/text.scm b/src/potato/text.scm similarity index 100% rename from potato/text.scm rename to src/potato/text.scm diff --git a/potato/zz-README.org b/src/potato/zz-README.org similarity index 100% rename from potato/zz-README.org rename to src/potato/zz-README.org diff --git a/src/potato/zz-README.org~ b/src/potato/zz-README.org~ new file mode 100644 index 0000000..e69de29 diff --git a/src/zz-README.org b/src/zz-README.org new file mode 100644 index 0000000..9dc9848 --- /dev/null +++ b/src/zz-README.org @@ -0,0 +1 @@ +Source code of the project