index0001: (select-module scmxref)
0002: ;;;
0003: ;;; DICTIONARY
0004: ;;;
0005: (define documented-modules
0006: (make-parameter
0007: ;;
0008: ;; This is list of module names that has manual entry.
0009: ;; If you do not want to too much link to manual entry,
0010: ;; or find anything missing, customize the this list.
0011: ;; Especially if you do (documented-modules '())
0012: ;; you will not get any link to manual entries
0013: ;; except for R5RS syntactic keywords.
0014: ;;
0015: '(
0016: crypt.bcrypt
0017: dbm
0018: file.util
0019: gauche.array
0020: gauche.charconv
0021: gauche.cgen
0022: gauche.collection
0023: gauche.config
0024: gauche.configure
0025: gauche.dictionary
0026: gauche.fcntl
0027: gauche.generator
0028: gauche.hook
0029: gauche.interactive
0030: gauche.lazy
0031: gauche.listener
0032: gauche.logger
0033: gauche.mop.propagate
0034: gauche.mop.singleton
0035: gauche.mop.validator
0036: gauche.net
0037: gauche.parameter
0038: gauche.parseopt
0039: gauche.partcont
0040: gauche.process
0041: gauche.record
0042: gauche.regexp ; autoloaded
0043: gauche.reload
0044: gauche.selector
0045: gauche.sequence
0046: gauche.syslog
0047: gauche.termios
0048: gauche.test
0049: gauche.threads
0050: gauche.time
0051: gauche.uvector
0052: gauche.version
0053: gauche.vport
0054: srfi-1 ; List library
0055: ;srfi-2 -- and-let* is in core syntax
0056: srfi-4 ; Homogeneous vectors
0057: srfi-11 ; Let-values
0058: srfi-13 ; String library
0059: srfi-14 ; Character-set library
0060: srfi-19 ; Time data types and procedures
0061: srfi-27 ; Sources of Random Bits
0062: srfi-29 ; Localization
0063: srfi-37 ; args-fold
0064: srfi-42 ; Eager comprehensions
0065: srfi-43 ; Vecotor library
0066: srfi-55 ; Requiring extensions
0067: srfi-60 ; Integers as bits
0068: srfi-98 ; Accessing environment variables
0069: srfi-106 ; Basic socket interface
0070: binary.io
0071: binary.pack
0072: compat.norational
0073: control.job
0074: control.thread-pool
0075: crypt.bcrypt
0076: data.random
0077: dbi
0078: dbm
0079: dbm.fsdbm
0080: dbm.gdbm
0081: dbm.ndbm
0082: dbm.odbm
0083: file.filter
0084: file.util
0085: math.const
0086: math.mt-random
0087: math.prime
0088: os.windows
0089: rfc.822
0090: rfc.base64
0091: rfb.cookie
0092: rfc.ftp
0093: rfc.hmac
0094: rfc.http
0095: rfc.ip
0096: rfc.icmp
0097: rfc.json
0098: rfc.md5
0099: rfc.mime
0100: rfc.quoted-printable
0101: rfc.sha
0102: rfc.uri
0103: rfc.zlib
0104: sxml.ssax
0105: sxml.sxpath
0106: sxml.tools
0107: sxml.serializer
0108: text.csv
0109: text.diff
0110: text.gettext
0111: text.html-lite
0112: text.parse
0113: text.progress
0114: text.sql
0115: text.tr
0116: text.tree
0117: text.unicode
0118: util.combinations
0119: util.digest
0120: util.isomorph
0121: util.lcs
0122: ; util.list -- obsoleted
0123: util.match
0124: util.queue
0125: util.rbtree
0126: util.record
0127: util.relation
0128: util.sparse
0129: util.stream
0130: util.trie
0131: util.toposort
0132: www.cgi
0133: www.cgi.test
0134: )))
0135:
0136: (define *dictionary* #f)
0137:
0138: (define (dictionary-get name)
0139: (hash-table-get *dictionary* name #f))
0140:
0141: (define (dictionary-put! name type file line)
0142: (hash-table-put! *dictionary*
0143: name (make <entry> :name name :type type :file file :line line)))
0144:
0145: (define-class <entry> ()
0146: ((name :init-value #f
0147: :init-keyword :name
0148: :accessor name-of)
0149: (type :init-value #f
0150: :init-keyword :type
0151: :accessor type-of)
0152: (file :init-value #f
0153: :init-keyword :file
0154: :accessor file-of)
0155: (line :init-value 0
0156: :init-keyword :line
0157: :accessor line-of)
0158: (ref :init-value '()
0159: :accessor ref-of)
0160: ))
0161:
0162: (define (entry-ref-push! entry file line)
0163: (unless (member (list file line) (ref-of entry))
0164: (push! (ref-of entry) (list file line))))
0165:
0166: (define (dictionary-file-list)
0167: (let ((result '()))
0168: (hash-table-for-each *dictionary*
0169: (lambda (name entry)
0170: (if (and (file-of entry)
0171: (not (member (file-of entry) result)))
0172: (push! result (file-of entry)))))
0173: result))
0174:
0175: (define (dictionary-definition-list file)
0176: (let ((result '()))
0177: (hash-table-for-each *dictionary*
0178: (lambda (name entry)
0179: (if (and (file-of entry)
0180: (string=? file (file-of entry)))
0181: (push! result entry))))
0182: (sort result (lambda (x y)
0183: (< (line-of x)
0184: (line-of y))))))
0185:
0186: ;;;
0187: ;;; BUILD-DICTIONARY
0188: ;;;
0189: (define-module scmxref.used-modules)
0190:
0191: (define (read-source-file file)
0192: (guard (e (else #f))
0193: (with-input-from-file file read-source)))
0194:
0195: (define (read-source)
0196:
0197: (define (definition? exp)
0198: (and (pair? exp)
0199: (symbol? (car exp))
0200: (string-prefix-ci? "define" (symbol->string (car exp)))))
0201:
0202: (define (definition-name exp)
0203: (let lp ((second (cadr exp)))
0204: (cond ((pair? second) (lp (car second)))
0205: ((symbol? second) second)
0206: (else
0207: (display #"Warning: strange definition:(~(car exp) ~|second| ...\n"
0208: (current-error-port))))))
0209:
0210: (define (definition-type exp) (car exp))
0211:
0212: (define (putit! exp)
0213: (let* ((name (definition-name exp))
0214: (type (definition-type exp))
0215: (info (debug-source-info exp))
0216: (file (list-ref info 0))
0217: (line (list-ref info 1)))
0218:
0219: (cond ((not (symbol? name)) #t)
0220: ((dictionary-get name)
0221: =>
0222: (lambda (entry)
0223: (cond ((and (string=? file (file-of entry))
0224: (= line line (line-of entry)))
0225: 'we-already-have-it)
0226: ((and (eq? type 'define-method)
0227: (eq? (type-of entry) 'define-method))
0228: ;; XXX
0229: (dictionary-put! name type file line))
0230: (else
0231: (display #"Duplicate definition of ~|name| as ~|type| found at ~|file|:~|line|. \
0232: \nPrevisous definition: (~(type-of entry) ~(name-of entry) ...) \
0233: at ~(file-of entry):~(line-of entry).\n"
0234: (current-error-port))
0235: (dictionary-put! name type file line)))))
0236: (else
0237: (dictionary-put! name type file line)))
0238:
0239: (cond ((eq? type 'define-module)
0240: (for-each (lambda (exp)
0241: (if (use-documented-module? exp) (useit! exp)))
0242: exp)))
0243: ))
0244:
0245: (define (use-documented-module? exp)
0246: (and (pair? exp)
0247: (eq? (car exp) 'use)
0248: (memq (cadr exp) (documented-modules))))
0249:
0250: (define (useit! exp)
0251: (eval exp (find-module 'scmxref.used-modules)))
0252:
0253: (guard (e ((is-a? e <error>)
0254: (display #"read-source: ~(~ e 'message)\n"
0255: (current-error-port)))
0256: (else #f))
0257: (port-for-each
0258: (lambda (exp)
0259: (cond ((definition? exp) (putit! exp))
0260: ((use-documented-module? exp) (useit! exp))))
0261: read)))
0262:
0263: (define (build-dictionary files)
0264: (if (null? (documented-modules))
0265: (eval '(extend null) (find-module 'scmxref.used-modules))
0266: (eval '(extend user) (find-module 'scmxref.used-modules)))
0267: (set! *dictionary* (make-hash-table))
0268: (for-each read-source-file files))
0269:
0270: (provide "scmxref/dictionary")
0271:
Index