[cldoc-cvs] CVS cldoc/src

ihatchondo ihatchondo at common-lisp.net
Wed Dec 6 22:50:27 UTC 2006


Update of /project/cldoc/cvsroot/cldoc/src
In directory clnet:/tmp/cvs-serv7833

Modified Files:
	cludg.lisp 
Log Message:
Fixed: bug reported by Joshua. And minor doc glitches.


--- /project/cldoc/cvsroot/cldoc/src/cludg.lisp	2006/01/08 16:12:17	1.5
+++ /project/cldoc/cvsroot/cldoc/src/cludg.lisp	2006/12/06 22:50:27	1.6
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*-
-;;; $Id: cludg.lisp,v 1.5 2006/01/08 16:12:17 ihatchondo Exp $
+;;; $Id: cludg.lisp,v 1.6 2006/12/06 22:50:27 ihatchondo Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: Common Lisp Universal Documentation Generator
 ;;;   Created: 2005 10 23 12:30
@@ -124,6 +124,10 @@
       (string-upcase string)
       (string-downcase string)))
 
+(defun cludg-mksym (&rest parts)
+   "Returns a symbol name made from the concatenation of the given parts."
+   (apply #'concatenate 'string (mapcar #'string parts)))
+
 ;;;;
 ;;;; API for form handling.
 ;;;;
@@ -183,12 +187,12 @@
       (let ((ll-doc (find :documentation ll-options :key #'car))
 	    (sp-doc (find :documentation sp-options :key #'car)))
 	`(progn 
-	   (defun ,(intern (format nil "~a" s-purger)) (string)
+	   (defun ,(intern (cludg-mksym s-purger)) (string)
 	     ,@(when sp-doc (cdr sp-doc))
 	     (with-output-to-string (stream)
 	       (loop for c across string
 		     do (remap-char c stream , at sp-clauses))))
-	   (defun ,(intern (format nil "~a" ll-purger)) (lambda-list)
+	   (defun ,(intern (cludg-mksym ll-purger)) (lambda-list)
 	     ,@(when ll-doc (cdr ll-doc))
 	     (flet ((make-word ()
 		      (make-array 10 :adjustable t :fill-pointer 0
@@ -309,17 +313,17 @@
    (name :type string :initarg :name :reader name)
    (type :type string :initarg :type :reader desc-type)
    (doc :type (or null string) :initarg :doc :reader doc))
-  (:documentation "This is a protocol class and so must note be instancied."))
+  (:documentation "This is a protocol class and so must not be instancied."))
 
 (defclass structured-object-descriptor (symbol-descriptor)
   ((inheritence :type list :initarg :inheritence :reader inheritence)
    (slots :type list :initarg :slots :reader slots)
    (slot-accessors :type list :reader slot-accessors :initform nil))
-  (:documentation "This is a protocol class and so must note be instancied."))
+  (:documentation "This is a protocol class and so must not be instancied."))
 
 (defclass param-descriptor (symbol-descriptor)
   ((value :type list :initarg :value :reader value))
-  (:documentation "This is a protocol class and so must note be instancied."))
+  (:documentation "This is a protocol class and so must not be instancied."))
 
 (defclass lambda-descriptor (symbol-descriptor)
   ((lambda-list
@@ -331,7 +335,7 @@
      :initform nil
      :initarg :qualifiers
      :reader method-qualifiers))
-  (:documentation "This is a protocol class and so must note be instancied."))
+  (:documentation "This is a protocol class and so must not be instancied."))
 
 (defclass slot-descriptor (symbol-descriptor) 
   ((cname :type string :initarg :class-name :reader cname)
@@ -615,7 +619,7 @@
 ;;;
 
 (defun mk-fname (s1 s2 &aux (pkg (find-package-caseless *current-package*)))
-  (with-standard-io-syntax (intern (format nil "~a~a" s1 s2) pkg)))
+  (with-standard-io-syntax (intern (cludg-mksym s1 s2) pkg)))
 
 (defun make-defun (name lambda-list &rest docs)
   (when name




More information about the Cldoc-cvs mailing list