[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

Update of /project/clim-desktop/cvsroot/clim-desktop
In directory clnet:/tmp/cvs-serv12268

Modified Files:
	packages.lisp closure.lisp clhs-lookup.lisp 
Log Message:
* Added Closure bugfix.

* Added code to perform documentation lookups in the CLIM spec.


--- /project/clim-desktop/cvsroot/clim-desktop/packages.lisp	2006/03/30 10:33:55	1.1
+++ /project/clim-desktop/cvsroot/clim-desktop/packages.lisp	2006/07/27 21:59:35	1.2
@@ -6,7 +6,8 @@
   (:use :common-lisp)
   (:export :symbol-lookup
            :populate-table
-           :spec-lookup))
+           :spec-lookup
+           :climspec-lookup))
 
 (cl:defpackage :abbrev
   (:use :cl :split-sequence)
--- /project/clim-desktop/cvsroot/clim-desktop/closure.lisp	2006/07/10 22:14:19	1.1
+++ /project/clim-desktop/cvsroot/clim-desktop/closure.lisp	2006/07/27 21:59:36	1.2
@@ -32,22 +32,69 @@
 
 (in-package :climacs-lisp-syntax)
 
-(define-command (com-hyperspec-lookup :name t :command-table lisp-table)
+(define-command (com-lookup-symbol-documentation :name t :command-table lisp-table)
     ()
-  "Look up a symbol in the Common Lisp HyperSpec."
-  (let* ((name (or (symbol-name-at-mark (point (current-window))
-					(syntax (buffer (current-window))))
-		   (accept 'string :prompt "Hyperspec lookup for symbol")))
-	 (*standard-output* *debug-io*)
-	 (url (clhs-lookup:spec-lookup name)))
-    (if (null url) (esa:display-message "Symbol not found.")
-	(closure:visit url))))
-
-(esa:set-key  'com-hyperspec-lookup
-              'lisp-table
-              '((#\c :control) (#\d :control) (#\h)))
+  "Look up a symbol in the Common Lisp HyperSpec or CLIM spec."
+  (let* ((syntax (syntax (buffer (current-window))))
+         (symbol (or (token-to-object syntax (symbol-at-mark (point (current-window))
+                                                             syntax))
+                     (accept 'symbol :prompt "Lookup documentation for symbol")))
+         (name (symbol-name symbol))
+         (*standard-output* *debug-io*)
+         (url (or (clhs-lookup:spec-lookup name)
+                  (when (eq (symbol-package symbol)
+                            (find-package :clim))
+                    (clhs-lookup:climspec-lookup symbol)))))
+    (if (null url)
+        (esa:display-message "Symbol not found.")
+        (closure:visit url))))
+
+(esa:set-key 'com-lookup-symbol-documentation
+             'lisp-table
+             '((#\c :control) (#\d :control) (#\h)))
 
 (in-package :beirc)
 
 (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url"))
-  (closure:visit url))
\ No newline at end of file
+  (closure:visit url))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Let's fix bugs in Closure!
+
+(in-package :netlib)
+
+(defun http-make-request (method url header post-data)
+  "Makes a single HTTP request for the URL url;
+   Returns: io protocol-version response-code response-message response-header."
+  ;; eval hack
+  #+NIL
+  (cond ((string-equal (url:url-host url) "images.cjb.net")
+         (error "No data from images.cjb.net!")))
+  (when *trace-http-p*
+    (ignore-errors
+     (format *http-trace-output* "~&;; Making ~S request for ~S ..." method url)
+     (finish-output *http-trace-output*)))
+  (let ((host (or (url:url-host url) "localhost")))
+    (multiple-value-bind (io proxyp) (open-socket-for-http url)
+      (let ((method-string (ecase method (:GET "GET") (:POST "POST")))
+            (url-for-server (if proxyp
+                                (unparse-url-for-http/proxy url)
+                              (unparse-url-for-http url)))
+            (header (append (if (and (or *send-host-field-never-the-less-p*
+                                         proxyp)
+                                     (not (member :host header :test #'string-equal :key #'car)))
+                                ;; FIX:
+                                (list (cons "Host" (format nil "~A:~A" host (url:url-port url))))
+                              nil)
+                            (if *referer*
+                                (list (cons "Referer" (if (url:url-p *referer*)
+                                                          (url:unparse-url *referer*)
+                                                          *referer*)))
+                                nil)
+                            (if (eq method :post)
+                                (list (cons "Content-Length" (format nil "~D" (length post-data))))
+                              nil)
+                            header)))
+        (multiple-value-bind (protocol-version response-code response-message response-header)
+            (make-http-request io method-string url-for-server "HTTP/1.0" header post-data)
+          (values io protocol-version response-code response-message response-header))))))
\ No newline at end of file
--- /project/clim-desktop/cvsroot/clim-desktop/clhs-lookup.lisp	2006/03/30 10:33:55	1.3
+++ /project/clim-desktop/cvsroot/clim-desktop/clhs-lookup.lisp	2006/07/27 21:59:36	1.4
@@ -237,5 +237,9 @@
     (:read-macro
      (gethash term *read-macro-table*))))
 
+(defun climspec-lookup (term)
+  ;; HACK: Unclean. Just opens the apropos page.
+  (format nil "http://bauhh.dyndns.org:8000/clim-spec/edit/apropos?q=~A" term))
+
 (defun symbol-lookup (term)
   (spec-lookup term :type :symbol))