ref: 24a52040fab52619577fcf4ac9756eea1183b610
parent: b0d0d82887dd95ffa9a6157d0c1446e8249eca32
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Mar 25 22:59:32 EDT 2025
help: sort groups and members
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -64,20 +64,20 @@
car cadr #fn("n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list) #fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!)))) let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc) λ #fn(map) #fn("n10B3500<:0:") #fn(copy-list) #fn("n10B3500T:7060:" #(void)) letrec)) bcode:code #fn("n1200Ee3:" #(aref)) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) quasiquote #fn("n1700E62:" #(bq-process)) > #fn("z12021e1721510e163:" #(#fn(nconc)- < reverse)) when #fn("z1200211Pqe4:" #(if begin)) help #fn("O100010003000W1000J60q?14W2000J7071?24Ib7228723_514024CG0252687>12778295252@H113;02:10e3@3007;8829527;882<q531;3<042=2>1520P2?89;J5048:3\xcd082888:2@1544893@07A895147B50@30q47;882C527D2E8=528>3W07B5047A2F5147B504252G8<>18>5247B50@30q^1^1413_07B5047A2H5147B504252I8;8<>2277829525247B50@30q47J50@g07A2K13<02L12M52@402N05341JE00R3@00ZJ;07A2O51@30q47B50^1^1^1^1^147J60:" #(#(:print-header- 0) help-print-header #0# #fn("n12002152853;0220E8563:0:" #(#fn(str-find) "\n" #fn(str-sub)) first-line)- groups #fn(for-each) #fn("n20B3\\00<20CU00T21CN0727305124A<7502652515347760:q:" #(doc group princ- caddr ": "
- getprop *doc*
- newline))
- #fn(get) *properties* *doc* doc getprop *formals-list* #fn(sym) ":doc-" #fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each)- #fn("n17050471A51472F0P61:" #(newline princ print)) newline princ print)) :kind princ newline- *doc-extra* filter #fn("n10<20Q:" #(:doc-see)) "See also:" #fn("n1A0=700=21q532263:" #(getprop- *formals-list* " ")) "Members:" #fn("n20H3P070A7102252523A0F071023q532463:q:" #(member getprop- *doc-extra*
- *formals-list*
- " ")) void
- "no help for " #fn(str) " " "" " (undefined)")) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;J:042902:5283;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=528>3<07>08>52@30q42?2@e12A8D2Be22C8C2Be22D2E2F8Fe2e22G2H2BEe32F0e2e3e32I2J2Be2268F518@Me3e4e3e18E3X02A8E2?1e12?2Fe12K8F5152e12K8A5153e3@30qe12K7L2M8;8B8A8G8D8F0>78@525164:" #(#(NIL+ < reverse)) when #fn("z1200211Pqe4:" #(if begin)) help #fn("O100010003000W1000J60q?14W2000J7071?241;3<0422231520P13;02410e3@3007588265275882752IIIIIb;b<288;29_514288<2:_514282;?=514282<87>1?>514282=??51402>CM02?2@8<>18?2A7B26528=5252@\x12089;J5048:3\xd1082888:2C1544893@07D895147E50@30q475882F527G2H8@528A3W07E5047D2I5147E5042?2J8;>18A5247E50@30q^1^1413c07E5047D2K5147E5042?2L8;>18?2A7B26528>525247E50@30q47M50@g07D2N13<02O12P52@402Q05341JE00R3@00ZJ;07D2R51@30q47E5047M60:" #(#(:print-header+ 0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
+ #fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each)+ #fn("n17050471A51472F0P61:" #(newline princ print))+ newline princ print) print-sig)
+ #fn("n12002152853;0220E8563:0:" #(#fn(str-find) "\n" #fn(str-sub)) first-line)+ #fn("n10B;3B040<20Q;38040T21Q:" #(doc group) doc-group?)+ #fn("n10H;3?0470A710225262:" #(member getprop *doc-extra*) doc-extra-term?)+ #fn("n27021221>1q0537362:" #(sort #fn(table-foldl)+ #fn("n3A051370082P:82:") <) table-keys-filter-sort) groups #fn(for-each)+ #fn("n1707105122A<7302452515347560:" #(princ caddr ": " getprop *doc* newline))+ #fn(get) *properties* :kind princ newline *doc-extra* filter #fn("n10<20Q:" #(:doc-see)) "See also:"+ #fn("n1A<0=700=21522263:" #(getprop *formals-list* " ")) "Members:" #fn("n1A<070021522263:" #(getprop+ *formals-list* " ")) void "no help for " #fn(str) " " "" " (undefined)")) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;J:042902:5283;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=528>3<07>08>52@30q42?2@e12A8D2Be22C8C2Be22D2E2F8Fe2e22G2H2BEe32F0e2e3e32I2J2Be2268F518@Me3e4e3e18E3X02A8E2?1e12?2Fe12K8F5152e12K8A5153e3@30qe12K7L2M8;8B8A8G8D8F0>78@525164:" #(#(NILNIL :named 1 :conc-name 3 :type 0 NIL NIL NIL NIL NIL NIL :predicate 4 NIL NIL NIL NIL NIL NIL
:constructor 2) vec #0# #fn("n17005121220A>28552485:" #(cddr #fn(for-each) #fn("n17002152340q:722324A<25F2605661:" #(member@@ -469,7 +469,7 @@
1-) trim-end)
#fn(str-length)
#fn(str-sub)) str-trim)
- sym-set-doc #fn("z220151873601@401<87360q@401=21Z3\xb40883\xaf0228823528:<8:=74258<528=;3H04268=5126778=28295351~8=;3?042:2;8>>18<52718;8?P23527<02=8@534893>07<02>8953@30q^1^1^1^1^1^1^1@30q482B3\\07?02@q537A2B8:>182527<02@2C8:8;5253^1^1@30q47D60:" #(#fn(str?)+ sym-set-doc #fn("z220151873601@401<87360q@401=21Z3\xb40883\xaf0228823528:<8:=74258<528=;3H04268=5126778=28295351~8=;3?042:2;8>>18<52718;8?P23527<02=8@534893>07<02>8953@30q^1^1^1^1^1^1^1@30q482B3[07?02@527A2B8:>182527<02@2C8:8;5253^1^1@30q47D60:" #(#fn(str?) str-join #fn(str-split) "\n" any #fn("n1E20051L2;3@040EG21l2;34040:" #(#fn(length) #\space)) #fn(length) str-trim " " "" #fn(map) #fn("n170A2105152390220A62:0:" #(<= #fn(length)#fn(str-sub))) putprop
--- a/src/system.sl
+++ b/src/system.sl
@@ -181,7 +181,7 @@
(putprop symbol '*doc* final)
(when extra (putprop symbol '*doc-extra* extra))))
(when (cons? formals-list)
- (let* {[existing (getprop symbol '*formals-list* NIL)]+ (let* {[existing (getprop symbol '*formals-list*)]; filter out duplicates
[to-add (filter (λ (formals) (not (member formals existing)))
formals-list)]}
@@ -218,29 +218,36 @@
All available documentation groups can be displayed with `(help
groups)`."
:doc-group doc
- (def (first-line s)
- (let* {[nl (str-find s "\n")]}- (if nl (str-sub s 0 nl) s)))
- (if (eq? term 'groups)
- (for-each (λ (k v) (when (and (cons? k)
- (eq? (car k) 'doc)
- (eq? (cadr k) 'group))
- (princ (caddr k) ": " (first-line (getprop k '*doc*)))
- (newline)))
- (get *properties* '*doc*))
- (let* {[docterm (if kind (list 'doc kind term) term)]- [doc (getprop docterm '*doc*)]
- [formals-list (getprop docterm '*formals-list* NIL)]
- [doc-extra-term (and kind (cons (sym ":doc-" kind) term))]
- [print-sig (λ (term sigs lpad) (if sigs
- (for-each (λ (sig) (newline)
- (princ lpad)
- (print (cons term sig)))
- sigs)
- (begin
- (newline)
- (princ lpad)
- (print term))))]}
+ (let* {[doc-extra-term (and kind (cons (sym ":doc-" kind) term))]+ [docterm (if kind (list 'doc kind term) term)]
+ [doc (getprop docterm '*doc*)]
+ [formals-list (getprop docterm '*formals-list*)]}
+ (def (print-sig term sigs lpad)
+ (if sigs
+ (for-each (λ (sig) (newline)
+ (princ lpad)
+ (print (cons term sig)))
+ sigs)
+ (begin (newline)
+ (princ lpad)
+ (print term))))
+ (def (first-line s)
+ (let* {[nl (str-find s "\n")]}+ (if nl (str-sub s 0 nl) s)))
+ (def (doc-group? k)
+ (and (cons? k)
+ (eq? (car k) 'doc)
+ (eq? (cadr k) 'group)))
+ (def (doc-extra-term? k)
+ (and (atom? k)
+ (member doc-extra-term (getprop k '*doc-extra*))))
+ (def (table-keys-filter-sort tbl pred)
+ (sort (table-foldl (λ (k _ z) (if (pred k) (cons k z) z)) NIL tbl) <))
+ (if (eq? term 'groups)
+ (for-each (λ (k) (princ (caddr k) ": " (first-line (getprop k '*doc*)))
+ (newline))
+ (table-keys-filter-sort (get *properties* '*doc*)
+ doc-group?))
(if (or doc formals-list)
(begin (print-header docterm formals-list :kind kind)
(when doc
@@ -252,7 +259,9 @@
(newline)
(princ "See also:")
(newline)
- (for-each (λ (v) (print-sig (cdr v) [getprop (cdr v) '*formals-list* NIL] " "))
+ (for-each (λ (v) (print-sig (cdr v)
+ (getprop (cdr v) '*formals-list*)
+ " "))
see)
(newline)))
(when kind
@@ -259,11 +268,11 @@
(newline)
(princ "Members:")
(newline)
- (for-each (λ (k v) (when (and (atom? k)
- (member doc-extra-term
- (getprop k '*doc-extra*)))
- (print-sig k [getprop k '*formals-list* NIL] " ")))
- (get *properties* '*doc*))
+ (for-each (λ (k) (print-sig k
+ (getprop k '*formals-list*)
+ " "))
+ (table-keys-filter-sort (get *properties* '*doc*)
+ doc-extra-term?))
(newline))
(void))
(begin (princ "no help for " (if kind (str kind " ") "") term)
@@ -271,8 +280,8 @@
(sym? term)
(not (bound? term)))
(princ " (undefined)"))
- (newline)))))
- (void))
+ (newline))))
+ (void)))
;;; standard procedures