From d74ebfe78c028225ee3ccb9dfce942fe3867e9e2 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 04:06:57 +0000
Subject: [PATCH 01/14] Update misc.lisp

---
 Sys/misc.lisp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Sys/misc.lisp b/Sys/misc.lisp
index 7b7e007..260aa37 100644
--- a/Sys/misc.lisp
+++ b/Sys/misc.lisp
@@ -327,7 +327,7 @@
 	(getf (get '*documentation-registry* symbol) doc-type))
 
 (defun |(SETF DOCUMENTATION)| (doc-string symbol doc-type)
-	(setf (getf (get '*documentation-registry* symbol) doc-type) doc-string)
+	(when doc-string (setf (getf (get '*documentation-registry* symbol) doc-type) doc-string))
 	doc-string)
 
 (register-setf-function 'symbol-plist '|(SETF SYMBOL-PLIST)|)
@@ -1166,4 +1166,4 @@
 		(if ret (rplacd (last ret) list) (setq ret list))
 		ret))
  
-    
\ No newline at end of file
+    

From 2335b5688ca9d5497be006db7a524316fc57c4d9 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 04:19:05 +0000
Subject: [PATCH 02/14] Update misc.lisp


From 7ef26f084843afd15c05bf7fc0c22c49cb50217b Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 04:25:23 +0000
Subject: [PATCH 03/14] Update misc.lisp


From d4012d78d2ef7383ebc466b106c7e8532b2ae1ce Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 04:26:34 +0000
Subject: [PATCH 04/14] Update misc.lisp


From 7c6961ae1fda2b9f150130c2fd915b1cf9d51299 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 04:51:51 +0000
Subject: [PATCH 05/14] Update setf.lisp

---
 Sys/setf.lisp | 42 +++++++++++++++++++-----------------------
 1 file changed, 19 insertions(+), 23 deletions(-)

diff --git a/Sys/setf.lisp b/Sys/setf.lisp
index 077f44d..436e35b 100644
--- a/Sys/setf.lisp
+++ b/Sys/setf.lisp
@@ -131,7 +131,7 @@
 ;;	This redefines the built-in special form.
 ;;
 (defmacro defun (name lambda-list &rest forms)
-  (let ((doc-form nil) 
+  (let ((doc nil)
         (lambda-form nil) 
         (declarations nil)
         (setf-form nil)
@@ -148,18 +148,21 @@
         ;; look for declarations and doc string
         (do* ((f forms (cdr f)))
             ((null f) (setq forms f))
-            (if (and (typep (car f) 'string) (null doc-form) (cdr f))
-                (setq doc-form `((setf (documentation ',name 'function) ,(car f))))
+            (if (and (typep (car f) 'string) (null doc) (cdr f))
+                (setq doc (car f))
                 (if (and (consp (car f)) (eq (caar f) 'declare))
                     (push (car f) declarations)
                     (progn (setq forms f) (return)))))
         (setq lambda-form 
             `(lambda ,lambda-list ,@(nreverse declarations) (block ,block-name ,@forms)))
 
-        `(progn ,@doc-form
-            (setf (symbol-function ',name) (function ,lambda-form))
-            ,@(when setf-form `((cl::register-setf-function ',setf-form ',name))) ',original-name)))
+        `(progn (setf (symbol-function ',name) (function ,lambda-form))
+                    ,@(when setf-form `((cl::register-setf-function ',setf-form ',name)))
+                    ,@(when doc `((setf (ccl::function-documentation (symbol-function ',name)) ,doc)))
+                    (setf (documentation ',name 'function) ,doc) ',original-name)))
 
+(defun ccl::function-documentation ())
+(defun (setf ccl::function-documentation) (val fun) (setf (getf (uref (uref fun function-code-buffer-offset) compiled-code-info-offset) 'documentation) val))
 (defun ccl::macro-lambda-list () nil)
 (defun (setf ccl::macro-lambda-list) (val list) (declare (ignore val list)) nil)
  
@@ -168,7 +171,7 @@
 ;;	This redefines the built-in special form.
 ;;
 (defmacro defmacro (name lambda-list &rest forms)
-	(let ((doc-form nil) 
+	(let ((doc nil)
 		  (lambda-form nil)
 		  (declarations nil)
 		  (setf-form nil))
@@ -182,9 +185,8 @@
 		;; look for declarations and doc string
 		(do* ((f forms (cdr f)))
 			((null f) (setq forms f))
-			(if (and (typep (car f) 'string) (null doc-form) (cdr f))
-				(setq doc-form 
-					`((setf (documentation ',name 'function) ,(car f))))
+			(if (and (typep (car f) 'string) (null doc) (cdr f))
+				(setq doc (car f))
 				(if (and (consp (car f)) (eq (caar f) 'declare))
 					(push (car f) declarations)
 					(progn (setq forms f) (return)))))
@@ -195,19 +197,13 @@
 				(macro-bind ,lambda-list 
 					form
 					,@(nreverse declarations) 
-					(block ,name ,@forms)))) 
+					(block ,name ,@forms))))
 		
-		(if setf-form 		
-			`(progn
-				,@doc-form
-				(setf (macro-function ',name) (function ,lambda-form))
-				(register-setf-function ',setf-form ',name)
-				',name) 
-			`(progn
-				,@doc-form
-				(setf (macro-function ',name) (function ,lambda-form))
-				(setf (ccl::macro-lambda-list (symbol-function ',name)) ',lambda-list)
-				',name)))) 
+		`(progn (setf (macro-function ',name) (function ,lambda-form))
+                                     ,@(when setf-form `((register-setf-function ',setf-form ',name)))
+                                     (setf (ccl::macro-lambda-list (symbol-function ',name)) ',lambda-list)
+                                     ,@(when doc `((setf (ccl::function-documentation (symbol-function ',name)) ,doc)))
+                                     (setf (documentation ',name 'function) ,doc) ',name)))
 
 (defmacro defsetf (sym first &rest rest)
 	(if (symbolp first) ;; if short form
@@ -378,4 +374,4 @@
 	#| we don't currently do anything with these |#
 	val)
 
-			
\ No newline at end of file
+			

From fc494431ad61d987ab902a92614ca05bc4524a77 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 05:04:37 +0000
Subject: [PATCH 06/14] Update structures.lisp

---
 Sys/structures.lisp | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/Sys/structures.lisp b/Sys/structures.lisp
index 9751bbd..34fdc7d 100644
--- a/Sys/structures.lisp
+++ b/Sys/structures.lisp
@@ -13,8 +13,8 @@
 (provide :structures)
 (in-package :common-lisp)
 
-(defun intern-structure-class (name superclasses) 
-	(declare (ignore name superclasses))) ;; redefined by CLOS
+(defun intern-structure-class (name superclass doc)
+	(declare (ignore name superclass doc))) ;; redefined by CLOS
 
 (defun define-struct-template (name class type base initial-offset num-slots &rest fields)
 	(apply 'vector name class type base initial-offset num-slots fields))
@@ -503,8 +503,8 @@
 						(push inline struct-template-info)))
 				(t (error "Invalid slot option: ~A~%" opt))))
 
-		(setq struct-template 
-			(apply #'define-struct-template name (intern-structure-class name (mapcar 'find-class base-list)) struct-type 
+		(setq struct-template
+			(apply #'define-struct-template name (unless struct-type (intern-structure-class name base doc-string)) struct-type
 					base-list initial-offset slot-count (reverse struct-template-info)))
 
 		;; install template		
@@ -613,7 +613,11 @@
 
 		(push `',name expressions)	
 		`(progn
-			(let* ((,struct-template-sym ,struct-template)) 
+			(let* ((,struct-template-sym
+                                                            (apply 'define-struct-template ',name
+                            ,(unless struct-type `(intern-structure-class ',name ',base ,doc-string))
+                            ',struct-type 
+						',base-list ,initial-offset ,slot-count ',(reverse struct-template-info)))) 
 				,@(reverse struct-template-expressions))
 			,@(nreverse expressions))))
 

From a89e96757764438879e708a4f88c893e5c40192b Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 05:10:22 +0000
Subject: [PATCH 07/14] Update hash-table.lisp

---
 Sys/hash-table.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Sys/hash-table.lisp b/Sys/hash-table.lisp
index adf0b9b..1cf6beb 100644
--- a/Sys/hash-table.lisp
+++ b/Sys/hash-table.lisp
@@ -735,7 +735,7 @@
 	(getf (gethash symbol *documentation-registry*) doc-type))
 
 (defun |(SETF DOCUMENTATION)| (doc-string symbol doc-type)
-	(setf (getf (gethash symbol *documentation-registry*) doc-type) doc-string)
+	(when doc-string (setf (getf (gethash symbol *documentation-registry*) doc-type) doc-string))
 	doc-string)
 
 ;; now clear the property list

From 08631a9c9d8872c79b62c622286cf039647ff43a Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 05:16:36 +0000
Subject: [PATCH 08/14] Update compiler.lisp

---
 Sys/compiler.lisp | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/Sys/compiler.lisp b/Sys/compiler.lisp
index 00cb094..4ec0a22 100644
--- a/Sys/compiler.lisp
+++ b/Sys/compiler.lisp
@@ -52,7 +52,7 @@
 ;;;	Common Lisp DEFINE-COMPILER-MACRO macro.
 ;;;
 (defmacro define-compiler-macro (name lambda-list &rest forms)
-	(let ((doc-form nil) 
+	(let ((doc nil)
 		  (lambda-form nil)
 		  (declarations nil)
 		  (form-sym (gensym))
@@ -61,9 +61,8 @@
 		;; look for declarations and doc string
 		(do* ((f forms (cdr f)))
 			((null f) (setq forms f))
-			(if (and (stringp (car f)) (null doc-form) (cdr f))
-				(setq doc-form 
-					`((setf (documentation ',name 'macro) ,(car f))))
+			(if (and (stringp (car f)) (null doc) (cdr f))
+				(setq doc (car f))
 				(if (and (consp (car f)) (eq (caar f) 'declare))
 					(push (car f) declarations)
 					(progn (setq forms f) (return)))))
@@ -74,11 +73,11 @@
 				(cl::macro-bind ,lambda-list 
 					(if (eq (car ,form-sym) 'funcall) (cdr ,form-sym) ,form-sym)
 					,@(nreverse declarations) 
-					(block ,name ,@forms)))) 
-		`(progn
-			,@doc-form
-			(setf (compiler-macro-function ',name) (function ,lambda-form))
-			',name))) 
+					(block ,name ,@forms))))
+		`(progn (setf (compiler-macro-function ',name) (function ,lambda-form))
+                                     (setf (ccl::macro-lambda-list (compiler-macro-function ',name)) ',lambda-list)
+                                     ,@(when doc `((setf (ccl::function-documentation (compiler-macro-function ',name)) ,doc)))
+			 (setf (documentation ',name 'compiler-macro) ,doc) ',name)))
 
 ;;;
 ;;; Corman Lisp (non-standard) CODE-GENERATOR-FUNCTION function.

From ff0ffe0c8c6b7a5d9ffcfd5baad7ea7b7b7c9e7e Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 06:39:47 +0000
Subject: [PATCH 09/14] Update defpackage.lisp for Issue-33

---
 Sys/defpackage.lisp | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/Sys/defpackage.lisp b/Sys/defpackage.lisp
index b0f41da..c6ce8fb 100644
--- a/Sys/defpackage.lisp
+++ b/Sys/defpackage.lisp
@@ -156,7 +156,7 @@
 				(:documentation
                     (when documentation
                         (error "More than one :documentation option specified."))
-                    (setq documentation (car value)))
+                    (setq documentation (list (car value)))) ; distinguish from nil
                 (otherwise (error "Bad defpackage option: ~A." (car p)))))
         (unless use-supplied-p
                   (setq use default-packages))
@@ -185,8 +185,8 @@
 		(when export
 		  (dolist (sym export)
 			(push `(export-create ,sym ',name) forms)))
-		(when documentation
-		  (push `(setf (documentation ',(intern (string name)) 'package) ,documentation) forms))
+		(when documentation ; doc should be attached to package but could't find room. Assign to a unique keyword instead
+		  (push `(setf (documentation ',(intern (string name) :keyword) 'package) ',(car documentation)) forms))
 		(push `(find-package ',name) forms)
 		`(eval-when (:load-toplevel :compile-toplevel :execute)
 			,@(nreverse forms))))

From 56ad82258a342d0179bee1e3cb55ad23faa19a02 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 06:52:47 +0000
Subject: [PATCH 10/14] Update misc-features.lisp for Issue-33

---
 Sys/misc-features.lisp | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/Sys/misc-features.lisp b/Sys/misc-features.lisp
index d519dbd..fea8388 100644
--- a/Sys/misc-features.lisp
+++ b/Sys/misc-features.lisp
@@ -573,6 +573,9 @@
 (defun function-lambda (func) (getf (function-info-list func) 'cl::lambda))
 (defun function-source-file (func) (getf (function-info-list func) 'ccl:*source-file*))
 (defun function-source-line (func) (getf (function-info-list func) 'ccl:*source-line*))
+(defun function-documentation (func) (getf (function-info-list func) 'documentation))
+(defun (setf function-documentation) (val func)
+   (if val (setf (getf (function-info-list func) 'documentation) val) (remf (function-info-list func) 'documentation)) val)
 (defun macro-lambda-list (func) (getf (function-info-list func) 'cl::macro-lambda-list))
 (defun (setf macro-lambda-list) (val func) 
 	(setf (getf (function-info-list func) 'cl::macro-lambda-list)

From 34928452e85f6c4ab341dd2b97d3f2b02f386463 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 07:29:03 +0000
Subject: [PATCH 11/14] Update clos.lisp for Issue-33 and other minor fixes

---
 Sys/clos.lisp | 70 +++++++++++++++++++++++----------------------------
 1 file changed, 32 insertions(+), 38 deletions(-)

diff --git a/Sys/clos.lisp b/Sys/clos.lisp
index 38a6fc4..d7438f2 100644
--- a/Sys/clos.lisp
+++ b/Sys/clos.lisp
@@ -19,6 +19,10 @@
 ;;;;
 ;;;;                RGC  9/19/03  Incorporated Frank Adrian's modification to DEFGENERIC to support :documentation option.
 ;;;;                RGC  8/17/06  Modified method generation to handle &AUX in argument lists
+;;;;                LC    9/6/17  Lower EQL specializer overhead and name EQL specializers to their "intern form" for display purposes.
+;;;;                LC   2/19/18  Class redefinition with propagation to subclasses and instances, :documentation and :default-initargs
+;;;;                              DEFCLASS options, Forward-referenced-class, Built-in-class and other AMOP Metaobjects and guidelines.
+;;;;                LC    3/3/18  Shared slot fixes.
 ;;;;
 ;;;; Note from Roger Corman, 7/29/2001:
 ;;;; This file has been hacked and modified for over 5 years by
@@ -546,7 +550,6 @@
 (defun class-name (class) (std-slot-value class 'name))
 (defun (setf class-name) (new-value class) (setf (slot-value class 'name) new-value))
 
-; ANSI CL generic DOCUMENTATION not available yet
 (defun class-documentation (class) (slot-value class 'documentation))
 (defun (setf class-documentation) (new-value class)
     (setf (slot-value class 'documentation) new-value))
@@ -649,14 +652,12 @@
        `(find-class ',(cadr option))))
     (:documentation (list ':documentation `',(cadr option)))
     (:default-initargs
-      (list 
+      (list
        ':direct-default-initargs
-       `(list ,@(mapcar
-                  #'(lambda (x) x)
-                  (mapplist
-                    #'(lambda (key value)
-                        `(list ',key ',value #'(lambda () ,value)))
-                    (cdr option))))))
+       `(list ,@(mapplist
+                        #'(lambda (key value)
+                               `(list ',key ',value #'(lambda () ,value)))
+                        (cdr option)))))
     (t (list `',(car option) `',(cdr option)))))
 
 ;;; find-class
@@ -711,7 +712,7 @@
 		class))
 
 (defun std-after-initialization-for-classes (class 
-		&key direct-superclasses direct-slots &allow-other-keys)
+		&key direct-superclasses direct-slots (documentation nil supp) &allow-other-keys)
 	;; update class hierarchy
 	(let ((supers
 				(or direct-superclasses
@@ -734,6 +735,8 @@
 				(add-writer-method
 					class writer (slot-definition-name direct-slot)))))
 
+            (when (and supp (or (stringp documentation) (not documentation))) (setf (documentation (class-name class) 'type) documentation))
+
 	(values))
 
 ;;; Slot definition metaobjects
@@ -809,7 +812,7 @@
 
 (defun finalize-inheritance (class) (std-finalize-inheritance class))
 
-; Delete either the slot class-shared-slot-definitions or class-shared-slots as shared slots are in slot-definitions as well
+; Delete either the slot class-shared-slot-definitions or class-shared-slots as shared slots are in both
 ; but leave for compatibility and speed? for now. 
 (defun std-finalize-inheritance (class)
   (setf (class-precedence-list class) (compute-class-precedence-list class))
@@ -833,7 +836,7 @@
              (class-shared (mapcar #'slot-definition-name class-shared-slot-definitions)))
         (setf (std-instance-slots instance) (allocate-slot-storage (length class-local) secret-unbound-value))
         (setf (std-instance-signature instance)
-                (list class-effective-slots class-shared-slot-definitions)) ; we'll next use setf
+                (list class-effective-slots class-shared-slot-definitions)) ; we'll next use setf on slot-value
         (dolist (slot class-local)
             (multiple-value-bind (ignore val foundp) (get-properties p-slot-value (list slot)) (declare (ignore ignore))
                 (and foundp (setf (slot-value instance slot) val))))
@@ -1175,13 +1178,13 @@
                 (documentation-form
                     (let ((doc-string (cadr (find-if #'(lambda (opt) (eq (car opt) :documentation)) non-method-options))))
                         (when doc-string `(setf (documentation ',function-name 'function) ,doc-string)))))            
-            `(progn 
+            `(prog1
                 (ensure-generic-function
                     ',function-name 
                     :lambda-list ',lambda-list
                     ,@(canonicalize-defgeneric-options non-method-options))
-                 ,(when documentation-form documentation-form)
-                 ,@method-definitions
+                ,(when documentation-form documentation-form)
+                ,@method-definitions
                  ))))
 
 (defun canonicalize-defgeneric-options (options)
@@ -1493,7 +1496,7 @@
 	
 	;; as soon as we define one method with an EQL specifier, we assume
 	;; methods of that generic function may specify this way
-	;(if eql-specializers ** redundantly too soon as add-method has to for it can bee called by the user
+	;(if eql-specializers ** redundantly too soon as add-method has to, for it can be called by the user
 	;	(setf (method-table-eql-specializers (classes-to-emf-table gf)) t))
 	
 	(let ((new-method
@@ -1547,7 +1550,7 @@
         (setf (method-table-eql-specializers (classes-to-emf-table gf)) t)) ; set to t to recalculate eqls
     (pushnew method (class-direct-methods specializer)))
   (finalize-generic-function gf)
-  gf) ; method should return gf.
+  gf) ; add-method should return gf.
 
 (defun remove-method (gf method)
   (setf (generic-function-methods gf)
@@ -1559,7 +1562,7 @@
     (setf (class-direct-methods class)
           (remove method (class-direct-methods class))))
   (finalize-generic-function gf)
-  gf) ; method should return gf. Bug when trying to print a deleted method.
+  gf) ; remove-method should return gf. Bug when trying to print a deleted method.
 
 (defun find-method (gf qualifiers specializers
                     &optional (errorp t))
@@ -2295,6 +2298,7 @@
 (defclass integer (number) ())
 (defclass float (number) ())
 (defclass ratio (number) ())
+
 ;; 10. Define the other standard metaobject classes.
 ;;; redefine to add type support for TYPEP
 (defmacro defclass (name direct-superclasses slot-definitions
@@ -2674,11 +2678,7 @@
     class)
 
 (defmethod ensure-class-using-class ((class null) name &rest all-keys &key (metaclass the-class-standard-class) &allow-other-keys)
-    (let ((class (apply #'make-instance metaclass :name name all-keys)))
-        (setf (find-class name) class)
-        (when (stringp (class-documentation class))
-            (setf (documentation name 'type) (class-documentation class)))
-        class))
+    (setf (find-class name) (apply #'make-instance metaclass :name name all-keys)))
 
 ;;; add forward-referenced-class functionality
 
@@ -2691,8 +2691,10 @@
 ;;; we should consider the more general case by defining a generic function say, default-direct-superclass.
 (defmethod compute-class-precedence-list ((class standard-class))
     (let ((list (call-next-method)))
-        (when (forward-referenced-class-p (car (last list))) (push-on-end #.(find-class 'standard-object) list) (push-on-end #.(find-class t) list))
-        list))
+        (if (forward-referenced-class-p (car (last list)))
+            (nconc (remove-if #'(lambda (x) (member x '#.(list (find-class 'standard-object) (find-class t)))) list)
+		   (list #.(find-class 'standard-object) #.(find-class t)))
+	    list)))
 
 (defmethod finalize-inheritance ((class forward-referenced-class)) (error "Cannot finalize ~a." class))
 
@@ -2747,25 +2749,18 @@
 					(nreverse slots))
 				,@forms))))
 		
-(defun intern-structure-class (name superclasses)
-    (setq superclasses (list (if superclasses (car superclasses) #.(find-class 'structure-object))))
-    (let ((class (find-class name nil)) structp)
-        (if (and class (setq structp (eq (class-of class) #.(find-class 'structure-class)))
-                    (equal superclasses (class-direct-superclasses class)))
-            class
-            (progn (and class (not structp) (cerror "Continue anyway." "The Symbol ~a already names the ~a" name class))
-                       (ensure-class name
-                           :direct-superclasses superclasses
+(defun intern-structure-class (name superclass doc)
+    (ensure-class name
+                           :direct-superclasses (list (or (and superclass (find-class superclass)) #.(find-class 'structure-object)))
                            :metaclass 'structure-class
-                           :direct-slots nil
-                           :shared-slots nil)))))
+                           :documentation doc))
 
 (defun struct-template (struct-name)
 	(get struct-name :struct-template))
 
 (defun patch-clos (struct-name)
 	(setf (elt (struct-template struct-name) 1) 
-		(intern-structure-class struct-name nil)))
+		(intern-structure-class struct-name nil (documentation struct-name 'structure))))
 	
 ;; make sure the following common lisp structures (which are defined before
 ;; this module is loaded) have CLOS definitions
@@ -2779,7 +2774,7 @@
 ;;; EQL specializer support
 
 ;;; Returns a CLOS class representing a type that is specific
-;;;	for the object. Used in method dispatch to implement EQL 
+;;;	for the object. Used in defmethod to implement EQL 
 ;;;	specialisers.
 
 (defun intern-eql-specializer (object &optional (intern-form object))
@@ -2791,7 +2786,6 @@
                                                                        :name intern-form :direct-superclasses (list (or singleton (class-of object))))))
                         (setf (slot-value newsingle 'object) object (gethash object *clos-singleton-specializers*) newsingle)))))
 
-
 ;; need to restore warning here
 (setq *COMPILER-WARN-ON-UNDEFINED-FUNCTION* t)	;; restore warnings
 

From a96732aa88e037620fd02edea9b2a908213d1394 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 15:58:30 +0000
Subject: [PATCH 12/14] Update documentation.lisp for Issue-33

---
 Sys/documentation.lisp | 115 +++++++++++++++++++++++++++++------------
 1 file changed, 83 insertions(+), 32 deletions(-)

diff --git a/Sys/documentation.lisp b/Sys/documentation.lisp
index f5123ad..e2cc37a 100644
--- a/Sys/documentation.lisp
+++ b/Sys/documentation.lisp
@@ -6,40 +6,91 @@
 ;;;;	File:		documentation.lisp
 ;;;;	Contents:	Corman Lisp DOCUMENTATION function.
 ;;;;	History:	2/11/99  RGC  Created.
+;;;;                    6/28/18  LC   DOCUMENTATION and (SETF DOCUMENTATION) generic functions
 ;;;;
 (in-package :common-lisp)
 
 ;;;
-;;;	Corman Lisp  DOCUMENTATION function
+;;;	Common Lisp  DOCUMENTATION and (SETF DOCUMENTATION) standard generic functions
 ;;;
-(defun documentation (symbol &optional (type 'function))
-	(if (eq (symbol-package symbol) (find-package :common-lisp))
-		(unless (and (boundp 'pl::*hyperspec-loaded*) pl::*hyperspec-loaded*)
-			(load (concatenate 'string pl:*cormanlisp-directory* "/sys/hyperspec.lisp"))))
-
-	(let ((doclist (gethash symbol *documentation-registry*))
-		  doc-clause)
-		
-		(if (eq (symbol-package symbol) (find-package :common-lisp))
-			(unless (and (boundp 'pl::*hyperspec-loaded*) pl::*hyperspec-loaded*)
-				(load (concatenate 'string pl:*cormanlisp-directory* "/sys/hyperspec.lisp"))))
-
-		;; if the requested symbol is in the common-lisp package, and
-		;; has documentation of type hyperspec as the first type, then
-		;; use a special algorithm to display the information from the hyperspec
-		(if (and (eq (car doclist) ':hyperspec) 
-				(eq (symbol-package symbol) (find-package 'common-lisp)))
-			(setq type ':hyperspec))
-		(setq doc-clause (getf doclist type))
-		(unless doc-clause 
-			(return-from documentation (format nil "No documentation available for ~A ~A" type symbol)))
-		(if (eq type ':hyperspec)
-			(progn (pl:hyperspec symbol) (values))
-			;; else just return the doc string
-			doc-clause
-		#|
-			(progn
-				(win::message-box-ok doc-clause 
-					(format nil "Documentation for ~A ~A" type symbol))
-				(values))
-		|# )))
+
+(defgeneric documentation (x doc-type) (:documentation "
+Method Signature Extensions:
+
+(x function) (doc-type ignored as if t or function)
+(x symbol) (doc-type :hyperspec)
+(x metaobject) (doc-type ignored as if t or type)
+(x standard-class) (doc-type t or slot-name)
+(x package) (doc-type ignored as if t)
+"))
+
+(defgeneric (setf documentation) (new-value x doc-type))
+
+;;; before
+(defmethod (setf documentation) :before (new-value x doc-type) (declare (ignore x doc-type))
+    (unless (typep new-value '(or string null)) (error "~a not a STRING or NIL." new-value)))
+
+;;; function
+(defmethod documentation ((x function) doc-type) (declare (ignore doc-type))
+    (or (ccl::function-documentation x) (values (parse-doc-decls-body (cddr (ccl:function-lambda x))))))
+
+(defmethod (setf documentation) (new-value (x function) doc-type) (declare (ignore doc-type))
+    (setf (ccl::function-documentation x) new-value))
+
+;;; list
+(defmethod documentation ((x list) doc-type)
+    (and (eq 'setf (car x)) (eq 2 (ignore-errors (length x))) (symbolp (cadr x)) (documentation (setf-function-symbol x) doc-type))) 
+
+(defmethod (setf documentation) (new-value (x list) doc-type)
+    (and (eq 'setf (car x)) (eq 2 (ignore-errors (length x))) (symbolp (cadr x))
+            (setf (documentation (setf-function-symbol x) doc-type) new-value)))
+
+;;; symbol
+(defmethod documentation ((x symbol) doc-type) (getf (gethash x *documentation-registry*) doc-type))
+
+(defmethod (setf documentation) ((new-value string) (x symbol) doc-type)
+    (setf (getf (gethash x *documentation-registry*) doc-type) new-value))
+
+(defmethod (setf documentation) ((new-value null) (x symbol) doc-type)
+    (when (documentation x doc-type)
+              (remf (gethash x *documentation-registry*) doc-type)
+              (unless (gethash x *documentation-registry*) (remhash x *documentation-registry*)))
+    nil)
+
+;;; metaobject. standard-generic-function standard-method standard-class structure-class
+(defmethod documentation ((x metaobject) doc-type) (declare (ignore doc-type)) (class-documentation x))
+
+(defmethod (setf documentation) (new-value (x metaobject) doc-type) (declare (ignore doc-type))
+    (setf (class-documentation x) new-value))
+
+;;; package. doc attached to the keyword with name package-name
+(defmethod documentation ((x package) doc-type) (declare (ignore doc-type))
+    (documentation (intern (package-name x) :keyword) 'package))
+
+(defmethod (setf documentation) (new-value (x package) doc-type) (declare (ignore doc-type))
+    (setf (documentation (intern (package-name x) :keyword) 'package) new-value))
+
+;;; standard-class
+(defmethod documentation ((x standard-class) doc-type)
+    (if (eq doc-type t) (call-next-method) (slot-definition-documentation (find doc-type (class-slots x) :key #'slot-definition-name))))
+
+(defmethod (setf documentation) (new-value (x standard-class) doc-type)
+    (if (eq doc-type t) (call-next-method)
+        (setf (slot-definition-documentation (find doc-type (class-slots x) :key #'slot-definition-name)) new-value)))
+
+;;; :hyperspec
+(defun win::documentation-selection ()) ; defined later
+
+(defmethod documentation ((x symbol) (doc-type (eql :hyperspec)))
+    (when (eq (symbol-package x) #.(find-package :cl)) (ignore-errors (win::documentation-selection x :hyperspec))))
+
+(setf (documentation '(setf documentation) 'function) "
+Method Signature Extensions:
+
+(new-value string or nil)
+
+(x function) (doc-type ignored as if t or function)
+(x metaobject) (doc-type ignored as if t or type)
+(x standard-class) (doc-type t or slot-name)
+(x package) (doc-type ignored as if t)
+" (documentation (fdefinition '(setf documentation)) t) (documentation '(setf documentation) 'function))

From 51e5da9b65ea58088254e8bd6bcdbd3918ea63d4 Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 16:12:25 +0000
Subject: [PATCH 13/14] Update context-manu.lisp for Issue-33

---
 Sys/context-menu.lisp | 33 ++++++++++++++++++++++++++++++++-
 1 file changed, 32 insertions(+), 1 deletion(-)

diff --git a/Sys/context-menu.lisp b/Sys/context-menu.lisp
index b860c42..36fea1f 100644
--- a/Sys/context-menu.lisp
+++ b/Sys/context-menu.lisp
@@ -63,6 +63,37 @@ WINUSERAPI BOOL WINAPI AttachThreadInput(DWORD idAttach, DWORD idAttachTo, BOOL
 		  (*print-pretty* t))
 		(cl::editor-replace-selection (format nil "~S" form))))
 
+;;
+;; adding documentation to the context menu
+;;
+(defun documentation-selection (symbol &optional (type 'function))
+    (if (eq (symbol-package symbol) (find-package :common-lisp))
+        (unless (and (boundp 'pl::*hyperspec-loaded*) pl::*hyperspec-loaded*)
+            (load (concatenate 'string pl:*cormanlisp-directory* "/sys/hyperspec.lisp"))))
+    
+    (let ((doclist (gethash symbol cl::*documentation-registry*))
+           doc-clause)
+        
+        ;; if the requested symbol is in the common-lisp package, and
+        ;; has documentation of type hyperspec as the first type (LC: Is this convenient?), then
+        ;; use a special algorithm to display the information from the hyperspec
+        (if (and (eq (car doclist) ':hyperspec) 
+                (eq (symbol-package symbol) (find-package 'common-lisp)))
+            (setq type ':hyperspec))
+        (setq doc-clause (getf doclist type))
+        (unless doc-clause 
+            (return-from documentation-selection (format nil "No documentation available for ~A ~A" type symbol)))
+        (if (eq type ':hyperspec)
+            (progn (pl:hyperspec symbol) (values))
+            ;; else just return the doc string
+            doc-clause
+            #|
+            (progn
+            (win::message-box-ok doc-clause 
+            (format nil "Documentation for ~A ~A" type symbol))
+            (values))
+            |# )))
+
 ;; eps,
 ;; adding macroexpand to the context menu
 ;;
@@ -106,7 +137,7 @@ WINUSERAPI BOOL WINAPI AttachThreadInput(DWORD idAttach, DWORD idAttachTo, BOOL
             (+ 1 (length func-list))
 			(ct:create-c-string (format nil "Documentation for ~A" selected-form)))
 		(push #'(lambda () 
-                (format *terminal-io* "~%~A~%" (documentation selected-form))
+                (format *terminal-io* "~%~A~%" (documentation-selection selected-form))
                 (force-output *terminal-io*)) func-list))
     func-list)
 

From e60aa9cf2b098268dab1901436a7c56e159fad7b Mon Sep 17 00:00:00 2001
From: Luis-Cervantes <31120494+Luis-Cervantes@users.noreply.github.com>
Date: Mon, 16 Jul 2018 16:56:09 +0000
Subject: [PATCH 14/14] Update hyperspec.lisp for Issue-33

and added (defvar *use-external-browser* nil) for future IDE configuration option.
---
 Sys/hyperspec.lisp | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/Sys/hyperspec.lisp b/Sys/hyperspec.lisp
index f6804ba..066472d 100644
--- a/Sys/hyperspec.lisp
+++ b/Sys/hyperspec.lisp
@@ -22,6 +22,8 @@
 
 (defvar *hyperspec-internet-path* "www.lispworks.com/documentation/HyperSpec/")
 
+(defvar *use-external-browser* nil)
+
 (defun win::install-hyperspec () #| place holder |#)
 
 (defun hyperspec (sym)
@@ -46,15 +48,16 @@
 		   (hyperspec-ref (getf doc-list ':hyperspec))
 		   (path (if *hyperspec-local-path* 
 					*hyperspec-local-path* 
-					*hyperspec-internet-path*)))
+					*hyperspec-internet-path*))
+	       (url (concatenate 'string
+				 (when *hyperspec-local-path* "file:///") ; intriguingly needed for some browsers (at least Chrome and Firefox).
+                                 (namestring path) 
+                                 "Body/" 
+                                 hyperspec-ref 
+                                 (if (= *hyperspec-version* 4) ".html" ""))))
 		(if hyperspec-ref
-			(cl::display-url 
-				(concatenate 'string 
-					(namestring path) 
-					"Body/" 
-					hyperspec-ref 
-					(if (= *hyperspec-version* 4) ".html" "")))
-			(error "The symbol ~A does not have a hyperspec location registered" sym))))
+		    (if *use-external-browser* (win::shell-execute url "") (cl::display-url url))
+		    (error "The symbol ~A does not have a hyperspec location registered" sym))))
  
  
 (defvar hyperspec-refs