X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fdoc.lisp;h=534d61d14aabc037f5ae3a174bda5c7cd4c3d596;hb=2375dc21aed5764dc2ecbccdd6665d6db0596731;hp=b4ecd694b493f992cb37909e943e4c366a988c75;hpb=648b48d2406f6d6f2bf341bf8ed350aac85398d0;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/doc.lisp b/contrib/sb-bsd-sockets/doc.lisp index b4ecd69..534d61d 100644 --- a/contrib/sb-bsd-sockets/doc.lisp +++ b/contrib/sb-bsd-sockets/doc.lisp @@ -1,3 +1,8 @@ +;;;; the old documentation extracted / generator for db-sockets / sb-bsd-sockets +;;;; +;;;; Not used anymore as the documentation is now integrated into the user manual, +;;;; but I didn't have heart yet to delete this. -- NS 20040801 + (eval-when (:load-toplevel :compile-toplevel :execute) (defpackage :db-doc (:use :cl :asdf #+sbcl :sb-ext #+cmu :ext ))) (in-package :db-doc) @@ -26,53 +31,53 @@ do cross-references and stuff (and symbol (eql (symbol-package symbol) *package*) (or (ignore-errors (find-class symbol)) - (boundp symbol) (fboundp symbol)))) + (boundp symbol) (fboundp symbol)))) (defun linkable-symbol-p (word) (labels ((symbol-char (c) (or (upper-case-p c) (digit-char-p c) - (eql c #\-)))) + (eql c #\-)))) (and (every #'symbol-char word) - (some #'upper-case-p word) - (worth-documenting-p (find-symbol word))))) + (some #'upper-case-p word) + (worth-documenting-p (find-symbol word))))) (defun markup-word (w) (if (symbolp w) (setf w (princ-to-string w))) - (cond ((linkable-symbol-p w) - (format nil "~A" - w w)) - ((and (> (length w) 0) - (eql (elt w 0) #\_) - (eql (elt w (1- (length w))) #\_)) - (format nil "~A" (subseq w 1 (1- (length w))))) - (t w))) + (cond ((linkable-symbol-p w) + (format nil "~A" + w w)) + ((and (> (length w) 0) + (eql (elt w 0) #\_) + (eql (elt w (1- (length w))) #\_)) + (format nil "~A" (subseq w 1 (1- (length w))))) + (t w))) (defun markup-space (w) (let ((para (search (coerce '(#\Newline #\Newline) 'string) w))) (if para - (format nil "~A
~A" - (subseq w 0 (1+ para)) - (markup-space (subseq w (1+ para) nil))) - w))) + (format nil "~A
~A" + (subseq w 0 (1+ para)) + (markup-space (subseq w (1+ para) nil))) + w))) (defun text-markup (text) (let ((start-word 0) (end-word 0)) (labels ((read-word () - (setf end-word - (position-if - (lambda (x) (member x '(#\Space #\, #\. #\Newline))) - text :start start-word)) - (subseq text start-word end-word)) - (read-space () - (setf start-word - (position-if-not - (lambda (x) (member x '(#\Space #\, #\. #\Newline))) - text :start end-word )) - (subseq text end-word start-word))) + (setf end-word + (position-if + (lambda (x) (member x '(#\Space #\, #\. #\Newline))) + text :start start-word)) + (subseq text start-word end-word)) + (read-space () + (setf start-word + (position-if-not + (lambda (x) (member x '(#\Space #\, #\. #\Newline))) + text :start end-word )) + (subseq text end-word start-word))) (with-output-to-string (o) - (loop for inword = (read-word) - do (princ (markup-word inword) o) - while (and start-word end-word) - do (princ (markup-space (read-space)) o) - while (and start-word end-word)))))) + (loop for inword = (read-word) + do (princ (markup-word inword) o) + while (and start-word end-word) + do (princ (markup-space (read-space)) o) + while (and start-word end-word)))))) (defun do-defpackage (form stream) @@ -81,7 +86,7 @@ do cross-references and stuff (when (string-equal name (package-name *package*)) (format stream "
Class: ~A~%" - name name) - #+nil (format stream "
Superclasses: ~{~A ~}~%" - (mapcar (lambda (x) (text-markup (class-name x))) - (mop:class-direct-superclasses class))) - (if (documentation class 'type) - (format stream "
~A~%" - (text-markup (documentation class 'type)))) - (when slots - (princ "
Slots:
Class: ~A~%" + name name) + #+nil (format stream "
Superclasses: ~{~A ~}~%" + (mapcar (lambda (x) (text-markup (class-name x))) + (mop:class-direct-superclasses class))) + (if (documentation class 'type) + (format stream "
~A~%" + (text-markup (documentation class 'type)))) + (when slots + (princ "
Slots:
(~A ~A) | ~A |
~A~%" - (text-markup doc))) + (text-markup doc))) t))) (defun do-defun (form stream) (do-defunlike form "Function" stream)) @@ -150,38 +155,38 @@ do cross-references and stuff (pushnew (symbol-name lisp-name) *symbols*) (do-defunlike `(defun ,lisp-name ((socket socket) argument) - ,(format nil "Return the value of the ~A socket option for SOCKET. This can also be updated with SETF." (symbol-name c-name) ) 'empty) + ,(format nil "Return the value of the ~A socket option for SOCKET. This can also be updated with SETF." (symbol-name c-name) ) 'empty) "Accessor" stream))) - + (defun do-form (form output-stream) (cond ((not (listp form)) nil) - ((string= (symbol-name (car form)) "DEFINE-SOCKET-OPTION-BOOL") - (do-boolean-sockopt form output-stream)) - ((eq (car form) 'defclass) - (do-defclass form output-stream)) - ((eq (car form) 'eval-when) - (do-form (third form) output-stream)) - ((eq (car form) 'defpackage) - (do-defpackage form output-stream)) - ((eq (car form) 'defun) - (do-defun form output-stream)) - ((eq (car form) 'defmethod) - (do-defmethod form output-stream)) - ((eq (car form) 'defgeneric) - (do-defgeneric form output-stream)) - (t nil))) + ((string= (symbol-name (car form)) "DEFINE-SOCKET-OPTION-BOOL") + (do-boolean-sockopt form output-stream)) + ((eq (car form) 'defclass) + (do-defclass form output-stream)) + ((eq (car form) 'eval-when) + (do-form (third form) output-stream)) + ((eq (car form) 'defpackage) + (do-defpackage form output-stream)) + ((eq (car form) 'defun) + (do-defun form output-stream)) + ((eq (car form) 'defmethod) + (do-defmethod form output-stream)) + ((eq (car form) 'defgeneric) + (do-defgeneric form output-stream)) + (t nil))) (defun do-file (input-stream output-stream) "Read in a Lisp program on INPUT-STREAM and make semi-pretty HTML on OUTPUT-STREAM" (let ((eof-marker (gensym))) - (if (< 0 - (loop for form = (read input-stream nil eof-marker) - until (eq form eof-marker) - if (do-form form output-stream) - count 1 #| and - do (princ "
") - for c = (read-char s t nil t) - until (and (eql c #\|) - (eql (peek-char nil s t nil t) #\#)) - collect c - finally (read-char s t nil t)) - 'string))) - (funcall *standard-sharpsign-reader* s c n)))) + (princ + (text-markup + (coerce + (loop with discard = (read-char s t nil t) + ;initially (princ "
") + for c = (read-char s t nil t) + until (and (eql c #\|) + (eql (peek-char nil s t nil t) #\#)) + collect c + finally (read-char s t nil t)) + 'string))) + (funcall *standard-sharpsign-reader* s c n)))) (dolist (c (cclan:all-components 'sb-bsd-sockets)) (when (and (typep c 'cl-source-file) - (not (typep c 'sb-bsd-sockets-system::constants-file))) - (with-open-file (in (component-pathname c) :direction :input) - (do-file in *standard-output*)))))) + (not (typep c 'sb-bsd-sockets-system::constants-file))) + (with-open-file (in (component-pathname c) :direction :input) + (do-file in *standard-output*)))))) (defun start () (with-open-file (*standard-output* "index.html" :direction :output)