Changeset 34401 in project


Ignore:
Timestamp:
08/27/17 04:09:29 (3 months ago)
Author:
kon
Message:

re-flow

File:
1 edited

Legend:

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

    r34109 r34401  
    2929  apropos apropos-list apropos-information-list)
    3030
    31 (import scheme chicken)
    32 
    33 (import
    34   foreign
    35   (only csi
    36     toplevel-command))
     31(import scheme)
     32
     33(import chicken foreign (only csi toplevel-command))
    3734
    3835(import
     
    5249    with-input-from-string)
    5350  (only extras
    54     read-file read-line)
    55   miscmacros
     51    read-file read-line))
     52(require-library
     53  srfi-1 srfi-13
     54  irregex
     55  data-structures ports extras)
     56
     57(import
    5658  (only memoized-string
    5759    make-string*)
     
    6567    define-error-type error-argument-type))
    6668(require-library
    67   srfi-1 srfi-13
    68   irregex data-structures ports extras
    69   symbol-utils miscmacros memoized-string
     69  memoized-string symbol-utils
    7070  type-checks type-errors)
     71
     72(require-extension miscmacros)
    7173
    7274(declare
     
    121123{
    122124  static C_SYMBOL_TABLE *root_symbol_table = NULL;
    123   if (!root_symbol_table)
     125  if(!root_symbol_table) {
    124126    root_symbol_table = C_find_symbol_table(ROOT_SYMBOL_TABLE_NAME);
     127  }
    125128
    126129  return C_enumerate_symbols(root_symbol_table, pos);
     
    128131<#
    129132
    130 (define enumerate-root-symbol-table
    131   (foreign-lambda scheme-object "enumerate_root_symbol_table" scheme-object))
     133(define enumerate-root-symbol-table!
     134  (foreign-lambda scheme-object "enumerate_root_symbol_table" scheme-object) )
    132135
    133136(define (initial-enumerate-symbol-table-cursor)
     
    137140  (let ((cursor (initial-enumerate-symbol-table-cursor)))
    138141    (let loop ((syms '()))
    139       (let ((sym (enumerate-root-symbol-table cursor)))
     142      (let ((sym (enumerate-root-symbol-table! cursor)))
    140143        (if (not sym)
    141144          syms
     
    160163
    161164(define (search-system-environment-symbols env pred)
    162     (if env
    163       (search-list-environment-symbols env pred)
    164       (search-interaction-environment-symbols env pred) ) )
     165  (if env
     166    (search-list-environment-symbols env pred)
     167    (search-interaction-environment-symbols env pred) ) )
    165168
    166169;;
     
    213216    (search-macro-environment-symbols macenv
    214217      (lambda (sym)
    215         (and (symbol-match? sym)
    216              (pred sym)))) ) )
     218        (and
     219          (symbol-match? sym)
     220          (pred sym)))) ) )
    217221
    218222(define (*apropos-list/environment loc symbol-match? env qualified?)
     
    223227    (search-system-environment-symbols env
    224228      (lambda (sym)
    225         (and (symbol-match? sym)
    226              (pred sym)))) ) )
     229        (and
     230          (symbol-match? sym)
     231          (pred sym)))) ) )
    227232
    228233;;
     
    242247
    243248(define (make-apropos-matcher loc patt #!optional (case-insensitive? #f) (force-regexp? #f))
    244 
     249  ;
    245250  (define (gen-irregex-options-list)
    246251    (if case-insensitive? '(case-insensitive) '()) )
    247 
     252  ;
    248253  (define (gen-irregex patt)
    249254    (apply irregex patt (gen-irregex-options-list)) )
    250 
     255  ;
    251256  (define (gen-irregex-matcher patt)
    252257     (cut symbol-irregex-match? <> (gen-irregex patt)) )
    253 
     258  ;
    254259  (cond
    255260    ((symbol? patt)
     
    273278(define (keyword-argument args kwd #!optional val)
    274279  (let loop ((args args) (oargs '()))
    275     (if (null? args) (values val (reverse! oargs))
    276         (let ((arg (car args)))
    277           (cond
    278             ((eq? kwd arg)
    279               (set! val (cadr args))
    280               (loop (cddr args) oargs) )
    281             (else
    282               (loop (cdr args) (cons arg oargs)) ) ) ) ) ) )
     280    (if (null? args)
     281      (values val (reverse! oargs))
     282      (let ((arg (car args)))
     283        (cond
     284          ((eq? kwd arg)
     285            (set! val (cadr args))
     286            (loop (cddr args) oargs) )
     287          (else
     288            (loop (cdr args) (cons arg oargs)) ) ) ) ) ) )
    283289
    284290; => (values sort-key args)
    285291(define (parse-sort-key-argument loc args)
    286292  (receive (sort-key args) (keyword-argument args #:sort #:type)
    287     (check-sort-key loc sort-key #:sort)
    288     (values sort-key args) ) )
     293    (values (check-sort-key loc sort-key #:sort) args) ) )
    289294
    290295;;
     
    297302
    298303(define (parse-arguments loc patt args)
    299 
    300304  ; => (values env macenv qualified?)
    301305  (define (parse-rest-arguments)
    302     (let ((env #f #;(default-environment))
     306    (let ((env #f)        ;(default-environment)
    303307          (macenv #f)
    304308          (qualified? #f)
     
    332336              (else
    333337                (error-argument loc arg) ) ) ) ) ) ) )
    334 
     338  ;
    335339  (check-search-pattern loc patt 'pattern)
    336340  (receive (env macenv qualified? case-insensitive?) (parse-rest-arguments)
Note: See TracChangeset for help on using the changeset viewer.