Changeset 34109 in project


Ignore:
Timestamp:
05/30/17 00:21:15 (4 weeks ago)
Author:
kon
Message:

re-flow

Location:
release/4/apropos
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/apropos/tags/2.2.1/apropos.scm

    r32829 r34109  
    2121(module apropos
    2222
    23   (;export
    24     ; Extra Crispy
    25     ;apropos/environments apropos-list/environments apropos-information-list/environments
    26     ; Crispy
    27     ;apropos/environment apropos-list/environment apropos-information-list/environment
    28     ; Original
    29     apropos apropos-list apropos-information-list)
    30 
    31   (import
    32     scheme chicken foreign
    33     (only srfi-1
    34       fold
    35       reverse! append!
    36       last-pair)
    37     (only srfi-13
    38       string-trim-both string-contains string-contains-ci)
    39     (only irregex
    40       irregex irregex? irregex-search)
    41     (only data-structures
    42       sort! any?
    43       alist-ref alist-update!
    44       butlast)
    45     (only ports
    46       with-input-from-string)
    47     (only extras
    48       read-file read-line)
    49     (only csi
    50       toplevel-command)
    51     miscmacros
    52     (only memoized-string
    53       make-string*)
    54     (only symbol-utils
    55       symbol->keyword
    56       symbol-printname=? symbol-printname<?
    57       symbol-printname-length max-symbol-printname-length )
    58     (only type-checks
    59       define-check+error-type)
    60     (only type-errors
    61       define-error-type error-argument-type))
    62 
    63   (require-library
    64     srfi-1 srfi-13
    65     data-structures ports extras irregex
    66     symbol-utils miscmacros memoized-string
    67     type-checks type-errors)
    68 
    69   (declare
    70     (bound-to-procedure
    71       ##sys#symbol-has-toplevel-binding?
    72       ##sys#qualified-symbol?
    73       ##sys#macro-environment
    74       ##sys#current-environment
    75       ##sys#macro?))
     23(;export
     24  ; Extra Crispy
     25  ;apropos/environments apropos-list/environments apropos-information-list/environments
     26  ; Crispy
     27  ;apropos/environment apropos-list/environment apropos-information-list/environment
     28  ; Original
     29  apropos apropos-list apropos-information-list)
     30
     31(import scheme chicken)
     32
     33(import
     34  foreign
     35  (only csi
     36    toplevel-command))
     37
     38(import
     39  (only srfi-1
     40    fold
     41    reverse! append!
     42    last-pair)
     43  (only srfi-13
     44    string-trim-both string-contains string-contains-ci)
     45  (only irregex
     46    irregex irregex? irregex-search)
     47  (only data-structures
     48    sort! any?
     49    alist-ref alist-update!
     50    butlast)
     51  (only ports
     52    with-input-from-string)
     53  (only extras
     54    read-file read-line)
     55  miscmacros
     56  (only memoized-string
     57    make-string*)
     58  (only symbol-utils
     59    symbol->keyword
     60    symbol-printname=? symbol-printname<?
     61    symbol-printname-length max-symbol-printname-length )
     62  (only type-checks
     63    define-check+error-type)
     64  (only type-errors
     65    define-error-type error-argument-type))
     66(require-library
     67  srfi-1 srfi-13
     68  irregex data-structures ports extras
     69  symbol-utils miscmacros memoized-string
     70  type-checks type-errors)
     71
     72(declare
     73  (bound-to-procedure
     74    ##sys#symbol-has-toplevel-binding?
     75    ##sys#qualified-symbol?
     76    ##sys#macro-environment
     77    ##sys#current-environment
     78    ##sys#macro?))
    7679
    7780;;; Support
     
    137140        (if (not sym)
    138141          syms
    139           (if (pred sym)
    140             (loop (cons sym syms))
    141             (loop syms) ) ) ) ) ) )
     142          (loop (if (pred sym) (cons sym syms) syms)) ) ) ) ) )
    142143
    143144;;
     
    369370    (let ((qualified? #f))
    370371      (let loop ((args args) (envs '()))
    371         (if (null? args) (values (reverse! envs) qualified?)
     372        (if (null? args)
     373          (values (reverse! envs) qualified?)
    372374          (let ((arg (car args)))
    373375                  ;keyword argument?
     
    386388    (let ((regexp (make-apropos-matcher loc patt)))
    387389      (let loop ((envs envs) (envsyms '()))
    388         (if (null? envs) (reverse! envsyms)
     390        (if (null? envs)
     391          (reverse! envsyms)
    389392          (let* ((env (car envs))
    390393                 (macenv (macro-environment (check-environment loc env 'environment)))
     
    438441    (append!
    439442      (map scrub-gensym-taste heads)
    440       (if (null? (cdr tailing)) (list (scrub-gensym-taste (car tailing)))
     443      (if (null? (cdr tailing))
     444        (list (scrub-gensym-taste (car tailing)))
    441445        (cons
    442446          (scrub-gensym-taste (car tailing))
     
    461465    (else
    462466      (let ((val (%global-ref sym)))
    463         (if (not (procedure? val)) 'variable
     467        (if (not (procedure? val))
     468          'variable
    464469          (procedure-details val) ) ) ) ) )
    465470
     
    477482            (else     #f ) ) )
    478483        (ails (*make-information-list syms macenv)))
    479     (if lessp (sort! ails lessp) ails) ) )
     484    (if lessp
     485      (sort! ails lessp)
     486      ails) ) )
    480487
    481488(define (information-name api)
     
    513520
    514521    (define (display-symbol-information api)
    515       (let ((sym (information-name api)))
     522      (let* ((sym (information-name api))
     523             (padlen
     524              (let* ((len (symbol-printname-length sym) )
     525                     (maxlen
     526                      (if (< maxsymlen len)
     527                        maxsymlen
     528                        len ) ) )
     529                (- maxsymlen maxlen) ) ) )
    516530        (display sym)
    517         (display (make-string* (+ 2 (- maxsymlen (symbol-printname-length sym))))) )
     531        (display (make-string* (+ 2 padlen))) )
    518532      (let ((info (information-details api)))
    519533        (cond
     
    533547
    534548(define (apropos patt . args)
    535   (receive (sort-key args) (parse-sort-key-argument 'apropos args)
    536     (receive (syms macenv) (parse-arguments 'apropos patt args)
    537       (display-apropos syms macenv sort-key) ) ) )
     549  (let*-values (((sort-key args) (parse-sort-key-argument 'apropos args) )
     550                ((syms macenv) (parse-arguments 'apropos patt args) ) )
     551    (display-apropos syms macenv sort-key) ) )
    538552
    539553(define (apropos-list patt . args)
    540   (receive (syms macenv) (parse-arguments 'apropos-list patt args)
     554  (let-values (((syms macenv) (parse-arguments 'apropos-list patt args)))
    541555    syms ) )
    542556
    543557(define (apropos-information-list patt . args)
    544   (receive (sort-key args) (parse-sort-key-argument 'apropos-information-list args)
    545     (receive (syms macenv) (parse-arguments 'apropos-information-list patt args)
    546       (*make-sorted-information-list syms macenv sort-key) ) ) )
     558  (let*-values (((sort-key args) (parse-sort-key-argument 'apropos-information-list args) )
     559                ((syms macenv) (parse-arguments 'apropos-information-list patt args) ) )
     560    (*make-sorted-information-list syms macenv sort-key) ) )
    547561
    548562;; Crispy
     
    616630
    617631(define (apropos/environments patt . args)
    618   (receive (sort-key args) (parse-sort-key-argument 'apropos/environments args)
     632  (let-values (((sort-key args) (parse-sort-key-argument 'apropos/environments args)))
    619633    (let ((i 0))
    620634      (for-each
  • release/4/apropos/tags/2.2.1/apropos.setup

    r32829 r34109  
    99  (exit 1) )
    1010
    11 (setup-shared-extension-module 'apropos (extension-version "2.2.0")
     11(setup-shared-extension-module 'apropos (extension-version "2.2.1")
    1212  #:types? #t
    1313  #:inline? #t
  • release/4/apropos/trunk/apropos.scm

    r32829 r34109  
    2121(module apropos
    2222
    23   (;export
    24     ; Extra Crispy
    25     ;apropos/environments apropos-list/environments apropos-information-list/environments
    26     ; Crispy
    27     ;apropos/environment apropos-list/environment apropos-information-list/environment
    28     ; Original
    29     apropos apropos-list apropos-information-list)
    30 
    31   (import
    32     scheme chicken foreign
    33     (only srfi-1
    34       fold
    35       reverse! append!
    36       last-pair)
    37     (only srfi-13
    38       string-trim-both string-contains string-contains-ci)
    39     (only irregex
    40       irregex irregex? irregex-search)
    41     (only data-structures
    42       sort! any?
    43       alist-ref alist-update!
    44       butlast)
    45     (only ports
    46       with-input-from-string)
    47     (only extras
    48       read-file read-line)
    49     (only csi
    50       toplevel-command)
    51     miscmacros
    52     (only memoized-string
    53       make-string*)
    54     (only symbol-utils
    55       symbol->keyword
    56       symbol-printname=? symbol-printname<?
    57       symbol-printname-length max-symbol-printname-length )
    58     (only type-checks
    59       define-check+error-type)
    60     (only type-errors
    61       define-error-type error-argument-type))
    62 
    63   (require-library
    64     srfi-1 srfi-13
    65     data-structures ports extras irregex
    66     symbol-utils miscmacros memoized-string
    67     type-checks type-errors)
    68 
    69   (declare
    70     (bound-to-procedure
    71       ##sys#symbol-has-toplevel-binding?
    72       ##sys#qualified-symbol?
    73       ##sys#macro-environment
    74       ##sys#current-environment
    75       ##sys#macro?))
     23(;export
     24  ; Extra Crispy
     25  ;apropos/environments apropos-list/environments apropos-information-list/environments
     26  ; Crispy
     27  ;apropos/environment apropos-list/environment apropos-information-list/environment
     28  ; Original
     29  apropos apropos-list apropos-information-list)
     30
     31(import scheme chicken)
     32
     33(import
     34  foreign
     35  (only csi
     36    toplevel-command))
     37
     38(import
     39  (only srfi-1
     40    fold
     41    reverse! append!
     42    last-pair)
     43  (only srfi-13
     44    string-trim-both string-contains string-contains-ci)
     45  (only irregex
     46    irregex irregex? irregex-search)
     47  (only data-structures
     48    sort! any?
     49    alist-ref alist-update!
     50    butlast)
     51  (only ports
     52    with-input-from-string)
     53  (only extras
     54    read-file read-line)
     55  miscmacros
     56  (only memoized-string
     57    make-string*)
     58  (only symbol-utils
     59    symbol->keyword
     60    symbol-printname=? symbol-printname<?
     61    symbol-printname-length max-symbol-printname-length )
     62  (only type-checks
     63    define-check+error-type)
     64  (only type-errors
     65    define-error-type error-argument-type))
     66(require-library
     67  srfi-1 srfi-13
     68  irregex data-structures ports extras
     69  symbol-utils miscmacros memoized-string
     70  type-checks type-errors)
     71
     72(declare
     73  (bound-to-procedure
     74    ##sys#symbol-has-toplevel-binding?
     75    ##sys#qualified-symbol?
     76    ##sys#macro-environment
     77    ##sys#current-environment
     78    ##sys#macro?))
    7679
    7780;;; Support
     
    137140        (if (not sym)
    138141          syms
    139           (if (pred sym)
    140             (loop (cons sym syms))
    141             (loop syms) ) ) ) ) ) )
     142          (loop (if (pred sym) (cons sym syms) syms)) ) ) ) ) )
    142143
    143144;;
     
    369370    (let ((qualified? #f))
    370371      (let loop ((args args) (envs '()))
    371         (if (null? args) (values (reverse! envs) qualified?)
     372        (if (null? args)
     373          (values (reverse! envs) qualified?)
    372374          (let ((arg (car args)))
    373375                  ;keyword argument?
     
    386388    (let ((regexp (make-apropos-matcher loc patt)))
    387389      (let loop ((envs envs) (envsyms '()))
    388         (if (null? envs) (reverse! envsyms)
     390        (if (null? envs)
     391          (reverse! envsyms)
    389392          (let* ((env (car envs))
    390393                 (macenv (macro-environment (check-environment loc env 'environment)))
     
    438441    (append!
    439442      (map scrub-gensym-taste heads)
    440       (if (null? (cdr tailing)) (list (scrub-gensym-taste (car tailing)))
     443      (if (null? (cdr tailing))
     444        (list (scrub-gensym-taste (car tailing)))
    441445        (cons
    442446          (scrub-gensym-taste (car tailing))
     
    461465    (else
    462466      (let ((val (%global-ref sym)))
    463         (if (not (procedure? val)) 'variable
     467        (if (not (procedure? val))
     468          'variable
    464469          (procedure-details val) ) ) ) ) )
    465470
     
    477482            (else     #f ) ) )
    478483        (ails (*make-information-list syms macenv)))
    479     (if lessp (sort! ails lessp) ails) ) )
     484    (if lessp
     485      (sort! ails lessp)
     486      ails) ) )
    480487
    481488(define (information-name api)
     
    513520
    514521    (define (display-symbol-information api)
    515       (let ((sym (information-name api)))
     522      (let* ((sym (information-name api))
     523             (padlen
     524              (let* ((len (symbol-printname-length sym) )
     525                     (maxlen
     526                      (if (< maxsymlen len)
     527                        maxsymlen
     528                        len ) ) )
     529                (- maxsymlen maxlen) ) ) )
    516530        (display sym)
    517         (display (make-string* (+ 2 (- maxsymlen (symbol-printname-length sym))))) )
     531        (display (make-string* (+ 2 padlen))) )
    518532      (let ((info (information-details api)))
    519533        (cond
     
    533547
    534548(define (apropos patt . args)
    535   (receive (sort-key args) (parse-sort-key-argument 'apropos args)
    536     (receive (syms macenv) (parse-arguments 'apropos patt args)
    537       (display-apropos syms macenv sort-key) ) ) )
     549  (let*-values (((sort-key args) (parse-sort-key-argument 'apropos args) )
     550                ((syms macenv) (parse-arguments 'apropos patt args) ) )
     551    (display-apropos syms macenv sort-key) ) )
    538552
    539553(define (apropos-list patt . args)
    540   (receive (syms macenv) (parse-arguments 'apropos-list patt args)
     554  (let-values (((syms macenv) (parse-arguments 'apropos-list patt args)))
    541555    syms ) )
    542556
    543557(define (apropos-information-list patt . args)
    544   (receive (sort-key args) (parse-sort-key-argument 'apropos-information-list args)
    545     (receive (syms macenv) (parse-arguments 'apropos-information-list patt args)
    546       (*make-sorted-information-list syms macenv sort-key) ) ) )
     558  (let*-values (((sort-key args) (parse-sort-key-argument 'apropos-information-list args) )
     559                ((syms macenv) (parse-arguments 'apropos-information-list patt args) ) )
     560    (*make-sorted-information-list syms macenv sort-key) ) )
    547561
    548562;; Crispy
     
    616630
    617631(define (apropos/environments patt . args)
    618   (receive (sort-key args) (parse-sort-key-argument 'apropos/environments args)
     632  (let-values (((sort-key args) (parse-sort-key-argument 'apropos/environments args)))
    619633    (let ((i 0))
    620634      (for-each
  • release/4/apropos/trunk/apropos.setup

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