Changeset 35134 in project


Ignore:
Timestamp:
02/16/18 23:15:07 (7 months ago)
Author:
kon
Message:

add apropos-default-options (heh , heh , my shiny)

Location:
release/4/apropos/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/apropos/trunk/apropos.scm

    r35088 r35134  
    3636(;export
    3737  ;
    38   apropos-interning
     38  apropos-interning apropos-default-options
    3939  ;Original
    4040  apropos apropos-list apropos-information-list
     
    884884;;; API
    885885
     886(define-constant KRL-OPTIONS '(
     887  #:sort #:module #:case-insensitive? #t #:qualified? #t #:macros? #t))
     888
     889(define apropos-default-options (make-parameter '() (lambda (x)
     890  (cond
     891    ((boolean? x)
     892      (or
     893        (and x KRL-OPTIONS)
     894        '() ) )
     895    ((list? x)
     896      x )
     897    (else
     898      (warning 'apropos-default-options "not a list of options" x)
     899      (apropos-default-options))))))
     900
    886901;; Original
    887902
    888903(define (apropos patt . args)
    889   (let*-values (
    890     ((sort-key args) (parse-sort-key-argument 'apropos args) )
    891     ((syms macenv raw?) (parse-arguments-and-match 'apropos patt args) ) )
    892     ;
    893     (display-apropos syms macenv sort-key raw?) ) )
     904  (let (
     905    (args (if (null? args) (apropos-default-options) args)) )
     906    (let*-values (
     907      ((sort-key args) (parse-sort-key-argument 'apropos args) )
     908      ((syms macenv raw?) (parse-arguments-and-match 'apropos patt args) ) )
     909      ;
     910      (display-apropos syms macenv sort-key raw?) ) ) )
    894911
    895912(define (apropos-list patt . args)
    896   (parse-arguments-and-match 'apropos-list patt args)
    897   #;
    898   (receive
    899     (syms _ _) (parse-arguments-and-match 'apropos-list patt args)
    900     ;
    901     syms ) )
     913  (let (
     914    (args (if (null? args) (apropos-default-options) args)) )
     915    (parse-arguments-and-match 'apropos-list patt args) ) )
    902916
    903917(define (apropos-information-list patt . args)
    904   (let*-values (
    905     ((sort-key args) (parse-sort-key-argument 'apropos-information-list args) )
    906     ((syms macenv raw?) (parse-arguments-and-match 'apropos-information-list patt args) ) )
    907     ;
    908     (make-sorted-information-list syms macenv sort-key raw?) ) )
    909 
    910 #| ;UNSUPPORTED ;FIXME case-insensitive support
    911 
    912 ;; Crispy
    913 
    914 ==== apropos/environment
    915 
    916 <procedure>(apropos/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?) (#:sort SORT))</procedure>
    917 
    918 Displays information about identifiers matching {{PATTERN}} in the
    919 {{ENVIRONMENT}}.
    920 
    921 Like {{apropos}}.
    922 
    923 ; {{ENVIRONMENT}} : An {{environment}} or a {{macro-environment}}.
    924 
    925 ==== apropos-list/environment
    926 
    927 <procedure>(apropos-list/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?))</procedure>
    928 
    929 Like {{apropos-list}}.
    930 
    931 ==== apropos-information-list/environment
    932 
    933 <procedure>(apropos-information-list/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?))</procedure>
    934 
    935 Like {{apropos-information-list}}.
    936 
    937 (define (apropos/environment patt env #!key qualified? (sort #:name))
    938   (check-sort-key 'apropos/environment sort #:sort)
    939   (receive
    940     (syms macenv)
    941       (parse-arguments/environment 'apropos/environment patt env qualified?)
    942     ;
    943     (newline)
    944     (display-apropos syms macenv sort-key) ) )
    945 
    946 (define (apropos-list/environment patt env #!key qualified?)
    947   (receive
    948     (syms macenv)
    949       (parse-arguments/environment 'apropos/environment patt env qualified?)
    950     ;
    951     syms ) )
    952 
    953 (define (apropos-information-list/environment patt env #!key qualified?)
    954   (receive
    955     (syms macenv)
    956       (parse-arguments/environment 'apropos/environment patt env qualified?)
    957     ;
    958     (*make-information-list syms macenv) ) )
    959 
    960 ;; Extra Crispy
    961 
    962 ==== apropos/environments
    963 
    964 <procedure>(apropos/environments PATTERN (#:qualified? QUALIFIED?) (#:sort SORT) ENVIRONMENT...)</procedure>
    965 
    966 Displays information about identifiers matching {{PATTERN}} in each
    967 {{ENVIRONMENT}}.
    968 
    969 Like {{apropos}}.
    970 
    971 ; {{PATTERN}} : A {{symbol}}, {{string}} or {{regexp}}. When symbol or string substring matching is performed.
    972 
    973 ==== apropos-list/environments
    974 
    975 <procedure>(apropos-list/environments PATTERN (#:qualified? QUALIFIED?) ENVIRONMENT...)</procedure>
    976 
    977 Like {{apropos-list}}.
    978 
    979 ==== apropos-information-list/environments
    980 
    981 <procedure>(apropos-information-list/environments PATTERN (#:qualified? QUALIFIED?) ENVIRONMENT...)</procedure>
    982 
    983 Like {{apropos-information-list}}.
    984 
    985 (define (apropos/environments patt . args)
    986   (let-values (((sort-key args) (parse-sort-key-argument 'apropos/environments args)))
    987     (let ((i 0))
    988       (for-each
    989         (lambda (macenv+syms)
    990           (set! i (fx+ 1 i))
    991           (newline) (display "** Environment " i " **") (newline) (newline)
    992           (display-apropos (cdr macenv+syms) (car macenv+syms) sort-key) )
    993         (parse-arguments/environments 'apropos/environments patt args)) ) ) )
    994 
    995 (define (apropos-list/environments patt . args)
    996   (map cdr (parse-arguments/environments 'apropos-list/environments patt args)) )
    997 
    998 (define (apropos-information-list/environments patt . args)
    999   (map
    1000     (lambda (macenv+syms) (*make-information-list (cdr macenv+syms) (car macenv+syms)))
    1001     (parse-arguments/environments 'apropos-information-list/environments patt args)) )
    1002 |#
     918  (let (
     919    (args (if (null? args) (apropos-default-options) args)) )
     920    (let*-values (
     921      ((sort-key args) (parse-sort-key-argument 'apropos-information-list args) )
     922      ((syms macenv raw?) (parse-arguments-and-match 'apropos-information-list patt args) ) )
     923      ;
     924      (make-sorted-information-list syms macenv sort-key raw?) ) ) )
    1003925
    1004926;;;
     
    1076998    ;
    1077999    (if (null? args)
     1000      ; original ordering
    10781001      (reverse! oargs)
     1002      ;csi-apropos-syntax => keyword-apropos-syntax
    10791003      (let ((arg (car args)))
    10801004        (case arg
     
    11211045    (aargs (parse-csi-apropos-arguments iargs)))
    11221046    ;NOTE will not dump the symbol-table unless explicit ; use '(: (* any))
    1123     (if (null? aargs)
    1124       (display-apropos-help)
    1125       (apply apropos aargs) ) ) )
     1047    (cond
     1048      ((null? aargs)
     1049        (display-apropos-help) )
     1050      ((null? (cdr aargs))
     1051        (apply apropos (car aargs) (apropos-default-options)) )
     1052      (else
     1053        (apply apropos aargs) ) ) ) )
    11261054
    11271055;;; Main
     
    11311059
    11321060) ;module apropos
     1061
     1062#| ;UNSUPPORTED ;FIXME case-insensitive support
     1063
     1064;; Crispy
     1065
     1066==== apropos/environment
     1067
     1068<procedure>(apropos/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?) (#:sort SORT))</procedure>
     1069
     1070Displays information about identifiers matching {{PATTERN}} in the
     1071{{ENVIRONMENT}}.
     1072
     1073Like {{apropos}}.
     1074
     1075; {{ENVIRONMENT}} : An {{environment}} or a {{macro-environment}}.
     1076
     1077==== apropos-list/environment
     1078
     1079<procedure>(apropos-list/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?))</procedure>
     1080
     1081Like {{apropos-list}}.
     1082
     1083==== apropos-information-list/environment
     1084
     1085<procedure>(apropos-information-list/environment PATTERN ENVIRONMENT (#:qualified? QUALIFIED?))</procedure>
     1086
     1087Like {{apropos-information-list}}.
     1088
     1089(define (apropos/environment patt env #!key qualified? (sort #:name))
     1090  (check-sort-key 'apropos/environment sort #:sort)
     1091  (receive
     1092    (syms macenv)
     1093      (parse-arguments/environment 'apropos/environment patt env qualified?)
     1094    ;
     1095    (newline)
     1096    (display-apropos syms macenv sort-key) ) )
     1097
     1098(define (apropos-list/environment patt env #!key qualified?)
     1099  (receive
     1100    (syms macenv)
     1101      (parse-arguments/environment 'apropos/environment patt env qualified?)
     1102    ;
     1103    syms ) )
     1104
     1105(define (apropos-information-list/environment patt env #!key qualified?)
     1106  (receive
     1107    (syms macenv)
     1108      (parse-arguments/environment 'apropos/environment patt env qualified?)
     1109    ;
     1110    (*make-information-list syms macenv) ) )
     1111
     1112;; Extra Crispy
     1113
     1114==== apropos/environments
     1115
     1116<procedure>(apropos/environments PATTERN (#:qualified? QUALIFIED?) (#:sort SORT) ENVIRONMENT...)</procedure>
     1117
     1118Displays information about identifiers matching {{PATTERN}} in each
     1119{{ENVIRONMENT}}.
     1120
     1121Like {{apropos}}.
     1122
     1123; {{PATTERN}} : A {{symbol}}, {{string}} or {{regexp}}. When symbol or string substring matching is performed.
     1124
     1125==== apropos-list/environments
     1126
     1127<procedure>(apropos-list/environments PATTERN (#:qualified? QUALIFIED?) ENVIRONMENT...)</procedure>
     1128
     1129Like {{apropos-list}}.
     1130
     1131==== apropos-information-list/environments
     1132
     1133<procedure>(apropos-information-list/environments PATTERN (#:qualified? QUALIFIED?) ENVIRONMENT...)</procedure>
     1134
     1135Like {{apropos-information-list}}.
     1136
     1137(define (apropos/environments patt . args)
     1138  (let-values (((sort-key args) (parse-sort-key-argument 'apropos/environments args)))
     1139    (let ((i 0))
     1140      (for-each
     1141        (lambda (macenv+syms)
     1142          (set! i (fx+ 1 i))
     1143          (newline) (display "** Environment " i " **") (newline) (newline)
     1144          (display-apropos (cdr macenv+syms) (car macenv+syms) sort-key) )
     1145        (parse-arguments/environments 'apropos/environments patt args)) ) ) )
     1146
     1147(define (apropos-list/environments patt . args)
     1148  (map cdr (parse-arguments/environments 'apropos-list/environments patt args)) )
     1149
     1150(define (apropos-information-list/environments patt . args)
     1151  (map
     1152    (lambda (macenv+syms) (*make-information-list (cdr macenv+syms) (car macenv+syms)))
     1153    (parse-arguments/environments 'apropos-information-list/environments patt args)) )
     1154|#
  • release/4/apropos/trunk/apropos.setup

    r35056 r35134  
    99  (exit 1) )
    1010
    11 (setup-shared-extension-module 'apropos (extension-version "2.6.5")
     11(setup-shared-extension-module 'apropos (extension-version "2.7.0")
    1212  #:types? #t
    1313  #:inline? #t
Note: See TracChangeset for help on using the changeset viewer.