Changeset 13795 in project


Ignore:
Timestamp:
03/17/09 04:06:08 (11 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/4/apropos
Files:
2 edited

Legend:

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

    r13748 r13795  
    1717;;
    1818;; - The Chicken 'environment' object does not hold the (syntactic) bindings
    19 ;; for all syntactic keywords from the R5RS. The public API of 'apropos'
     19;; for any syntactic keywords from the R5RS. The public API of 'apropos'
    2020;; attempts to hide this fact.
    2121
     
    3838;;
    3939
    40 (cond-expand
    41   (unsafe
    42     (include "chicken-primitive-object-inlines") )
    43   (else ) )
    44 
    4540;; Argument Checking
    4641
    4742(define-inline (%check-search-pattern loc obj argnam)
    48   (cond-expand
    49     (unsafe
    50       (unless (or (%keyword? obj) (%symbol? obj) (%string? obj) (regexp? obj))
    51         (error-invalid-search loc obj argnam) ) )
    52     (else
    53       (unless (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj))
    54         (error-invalid-search loc obj argnam) ) ) ) )
     43  (unless (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj))
     44    (error-invalid-search loc obj argnam) ) )
    5545
    5646#; ;UNUSED
     
    111101
    112102(define (symbol=? x y)
    113   (cond-expand
    114     (unsafe
    115       (%string=? (%symbol-string x) (%symbol-string y)) )
    116     (else
    117       (let ((sx (##sys#symbol->string x))
    118             (sy (##sys#symbol->string y))
    119             (px (##sys#qualified-symbol-prefix x))
    120             (py (##sys#qualified-symbol-prefix y)))
    121         (cond (px (and py (string=? px py) (string=? sx sy)))
    122               (py (or (not px) (and (string=? px py) (string=? sx sy))))
    123               (else (string=? sx sy) ) ) ) ) ) )
     103  (let ((sx (##sys#symbol->string x))
     104        (sy (##sys#symbol->string y))
     105        (px (##sys#qualified-symbol-prefix x))
     106        (py (##sys#qualified-symbol-prefix y)))
     107    (cond (px (and py (string=? px py) (string=? sx sy)))
     108          (py (or (not px) (and (string=? px py) (string=? sx sy))))
     109          (else (string=? sx sy) ) ) ) )
    124110
    125111(define (symbol<? x y)
    126   (cond-expand
    127     (unsafe
    128       (%string<? (%symbol-string x) (%symbol-string y)) )
    129     (else
    130       (let ((sx (##sys#symbol->string x))
    131             (sy (##sys#symbol->string y))
    132             (px (##sys#qualified-symbol-prefix x))
    133             (py (##sys#qualified-symbol-prefix y)))
    134         (cond (px (and py (string<? px py) (string<? sx sy)))
    135               (py (or (not px) (and (string<? px py) (string<? sx sy))))
    136               (else (string<? sx sy) ) ) ) ) ) )
     112  (let ((sx (##sys#symbol->string x))
     113        (sy (##sys#symbol->string y))
     114        (px (##sys#qualified-symbol-prefix x))
     115        (py (##sys#qualified-symbol-prefix y)))
     116    (cond (px (and py (string<? px py) (string<? sx sy)))
     117          (py (or (not px) (and (string<? px py) (string<? sx sy))))
     118          (else (string<? sx sy) ) ) ) )
    137119
    138120(define (symbol-print-length sym)
    139   (cond-expand
    140     (unsafe
    141       (let ((siz (%string-size (%symbol-string sym))))
    142               ; assumes keyword style is not #:none
    143         (cond ((%keyword? sym) siz)
    144               ; compensate for the '##'
    145               ((%qualified-symbol? sym) (%fx+ siz 2))
    146               ; plain old string
    147               (else siz) ) ) )
    148     (else
    149       (let ([len (string-length (##sys#symbol->qualified-string sym))])
    150         (if (keyword? sym) (- len 2) ; compensate for leading '###' when only a ':' is printed
    151             len ) ) ) ) )
     121  (let ([len (string-length (##sys#symbol->qualified-string sym))])
     122    (if (keyword? sym) (- len 2) ; compensate for leading '###' when only a ':' is printed
     123        len ) ) )
    152124
    153125(define (max-symbol-print-width syms)
     
    157129
    158130(define (symbol-match? sym regexp)
    159   (cond-expand
    160     (unsafe
    161       (string-search regexp (%symbol-string sym)) )
    162     (else
    163       (string-search regexp (symbol->string sym)) ) ) )
     131  (string-search regexp (symbol->string sym)) )
    164132
    165133;; Environment Search
     
    353321      (newline) )
    354322
    355     (let ((lessp
    356             (case sortkey
    357               ((#:name) apropos-information-name<? )
    358               ((#:kind) apropos-information<? )
    359               (else     #f ) ) )
     323    (let ((lessp (case sortkey
     324                   ((#:name) apropos-information-name<? )
     325                   ((#:kind) apropos-information<? )
     326                   (else     #f ) ) )
    360327          (ail (*apropos-information-list syms macenv)))
    361328      (for-each display-symbol-information (if lessp (sort ail lessp) ail)) ) ) )
  • release/4/apropos/trunk/apropos.scm

    r13753 r13795  
    1717;;
    1818;; - The Chicken 'environment' object does not hold the (syntactic) bindings
    19 ;; for all syntactic keywords from the R5RS. The public API of 'apropos'
     19;; for any syntactic keywords from the R5RS. The public API of 'apropos'
    2020;; attempts to hide this fact.
    2121
     
    321321      (newline) )
    322322
    323     (let ((lessp
    324             (case sortkey
    325               ((#:name) apropos-information-name<? )
    326               ((#:kind) apropos-information<? )
    327               (else     #f ) ) )
     323    (let ((lessp (case sortkey
     324                   ((#:name) apropos-information-name<? )
     325                   ((#:kind) apropos-information<? )
     326                   (else     #f ) ) )
    328327          (ail (*apropos-information-list syms macenv)))
    329328      (for-each display-symbol-information (if lessp (sort ail lessp) ail)) ) ) )
Note: See TracChangeset for help on using the changeset viewer.