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))