Changeset 38877 in project

Timestamp:

08/22/20 22:19:18 (2 months ago)

Author:

Kon Lovett

Message:

make help an arg

Location:

release/5/apropos/trunk

Files:

• apropos-csi.scm (modified) (4 diffs)
• apropos.egg (modified) (1 diff)

release/5/apropos/trunk/apropos-csi.scm

@@ -20 +20 @@
 (import (chicken io))
 (import (chicken port))
-(import (only (srfi 1) cons* reverse!))
+(import (only (srfi 1) first cons* reverse!))
 ;Warning: the following extensions are not currently installed: chicken.csi
 (import (only (chicken csi) toplevel-command))
@@ -58 +58 @@
   (csi-help
     ",a PATT ARG..."
-    "Apropos of PATT with ARG from ?, mac, ci, sort nam|mod|typ|#f, split nam|mod|#f"))
+    "Apropos of PATT with ARG from help, mac, ci, sort nam|mod|typ|#f, split nam|mod|#f"))
 
 (define-constant HELP-TEXT
@@ -76 +76 @@
   '<atom>         interpret `<atom>` as an irregex.
 
- Use "?" as a PATT to list symbols containing a `?`.
-
 Arguments:
 
+ help              This message
  macros            Include macro bound symbols
  ci | case-insensitive
@@ -126 +125 @@
 
 (define (parse-csi-apropos-arguments iargs)
-  ;look at every argument
-  (let loop ((args iargs) (oargs '()))
-    ;
-    (define (restargs next optarg?)
-      (cond
-        ((null? next)
-          '() )
-        (optarg?
-          (cdr next))
-        (else
-          next ) ) )
-    ;
-    (define (arg-next kwd init #!optional optarg?)
+  (let* (
+    (1st (and (not (zero? (length iargs))) (first iargs)))
+    (rest (if 1st (cdr iargs) '())) )
+    (let loop ((args rest) (oargs `(,1st)))
       ;
-      (define (thisargs next kwd init optarg?)
+      (define (restargs next optarg?)
         (cond
           ((null? next)
-            (cons* init kwd oargs))
+            '() )
           (optarg?
-            (cons* (optarg? (car next)) kwd oargs))
+            (cdr next))
           (else
-            (cons* init kwd oargs) ) ) )
+            next ) ) )
       ;
-      (let* (
-        (next (cdr args))
-        (args (restargs next optarg?))
-        (oargs (thisargs next kwd init optarg?) ) )
+      (define (arg-next kwd init #!optional optarg?)
         ;
-        (loop args oargs) ) )
-    ;
-    (if (null? args)
-      ; original ordering
-      (reverse! oargs)
-      ;csi-apropos-syntax => keyword-apropos-syntax
-      (let ((arg (car args)))
-        (case arg
+        (define (thisargs next kwd init optarg?)
+          (cond
+            ((null? next)
+              (cons* init kwd oargs))
+            (optarg?
+              (cons* (optarg? (car next)) kwd oargs))
+            (else
+              (cons* init kwd oargs) ) ) )
+        ;
+        (let* (
+          (next (cdr args))
+          (args (restargs next optarg?))
+          (oargs (thisargs next kwd init optarg?) ) )
           ;
-          ((krl)
-            (loop
-              (restargs (cons* 'all (cdr args)) #f)
-              (cons* #:module #:sort oargs)))
-          ;
-          ((all)
-            (loop
-              (restargs (cdr args) #f)
-              (cons* #t #:case-insensitive? #t #:macros? oargs)))
-          ;
-          ((imp imported)
-            (arg-next #:imported? #t))
-          ;
-          ((mac macros)
-            (arg-next #:macros? #t))
-          ;
-          ((ci case-insensitive)
-            (arg-next #:case-insensitive? #t))
-          ;
-          ((internal)
-            (arg-next #:internal? #t))
-          ;
-          ((raw)
-            (arg-next #:raw? #t))
-          ;
-          ((base)
-            (arg-next #:base (apropos-default-base) (cut check-apropos-number-base ',a <>)))
-          ;
-          ((sort)
-            (arg-next #:sort #:type (cut interp-sort-arg ',a <>)))
-          ;
-          ((split)
-            (arg-next #:split #f (cut interp-split-arg ',a <>)))
-          ;
-          ((?)
-            (loop '() '()))
-          ;
-          (else
-            (loop (cdr args) (cons arg oargs)) ) ) ) ) ) )
+          (loop args oargs) ) )
+      ;
+      (if (null? args)
+        ; original ordering
+        (reverse! oargs)
+        ;csi-apropos-syntax => keyword-apropos-syntax
+        (let ((arg (car args)))
+          (case arg
+            ;
+            ((krl)
+              (loop
+                (restargs (cons* 'all (cdr args)) #f)
+                (cons* #:module #:sort oargs)))
+            ;
+            ((all)
+              (loop
+                (restargs (cdr args) #f)
+                (cons* #t #:case-insensitive? #t #:macros? oargs)))
+            ;
+            ((imp imported)
+              (arg-next #:imported? #t))
+            ;
+            ((mac macros)
+              (arg-next #:macros? #t))
+            ;
+            ((ci case-insensitive)
+              (arg-next #:case-insensitive? #t))
+            ;
+            ((internal)
+              (arg-next #:internal? #t))
+            ;
+            ((raw)
+              (arg-next #:raw? #t))
+            ;
+            ((base)
+              (arg-next #:base (apropos-default-base) (cut check-apropos-number-base ',a <>)))
+            ;
+            ((sort)
+              (arg-next #:sort #:type (cut interp-sort-arg ',a <>)))
+            ;
+            ((split)
+              (arg-next #:split #f (cut interp-split-arg ',a <>)))
+            ;
+            ((help)
+              (loop '() '()))
+            ;
+            (else
+              (loop (cdr args) (cons arg oargs)) ) ) ) )  ) ) )
 
 (define (csi-apropos-command)

release/5/apropos/trunk/apropos.egg

@@ -2 +2 @@
 ;;;; Kon Lovett, Jul '18
 
-;BUG? (inline-file) w/o any define-inline causes error for non-existent apropos.inline
-
 ((synopsis "CHICKEN apropos")
- (version "3.5.1")
+ (version "3.6.0")
  (category misc)
  (author "[[kon lovett]]")
  (license "BSD")
  (dependencies
-  (srfi-1 "0.1")
-  (srfi-13 "0.1")
-        (check-errors "3.1.0")
+  srfi-1
+  srfi-13
+        check-errors
         (string-utils "2.1.1")
         (symbol-utils "2.0.2"))