[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