clim-desktop-cvs

clim-desktop-cvs@common-lisp.net

70 discussions

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 28 Jul '06

28 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv22906 Modified Files: packages.lisp closure.lisp clhs-lookup.lisp Log Message: Fixed Closure patch and added symbol documentation lookup for CLX. --- /project/clim-desktop/cvsroot/clim-desktop/packages.lisp 2006/07/27 21:59:35 1.2 +++ /project/clim-desktop/cvsroot/clim-desktop/packages.lisp 2006/07/28 10:56:51 1.3 @@ -7,7 +7,8 @@ (:export :symbol-lookup :populate-table :spec-lookup - :climspec-lookup)) + :climspec-lookup + :clxdoc-lookup)) (cl:defpackage :abbrev (:use :cl :split-sequence) --- /project/clim-desktop/cvsroot/clim-desktop/closure.lisp 2006/07/27 21:59:36 1.2 +++ /project/clim-desktop/cvsroot/clim-desktop/closure.lisp 2006/07/28 10:56:51 1.3 @@ -44,7 +44,10 @@ (url (or (clhs-lookup:spec-lookup name) (when (eq (symbol-package symbol) (find-package :clim)) - (clhs-lookup:climspec-lookup symbol))))) + (clhs-lookup:climspec-lookup symbol)) + (when (eq (symbol-package symbol) + (find-package :xlib)) + (clhs-lookup:clxdoc-lookup symbol))))) (if (null url) (esa:display-message "Symbol not found.") (closure:visit url)))) @@ -84,7 +87,9 @@ proxyp) (not (member :host header :test #'string-equal :key #'car))) ;; FIX: - (list (cons "Host" (format nil "~A:~A" host (url:url-port url)))) + (if (and (numberp (url:url-port url)) (not (= (url:url-port url) 80))) + (list (cons "Host" (format nil "~A:~A" host (url:url-port url)))) + (list (cons "Host" host))) nil) (if *referer* (list (cons "Referer" (if (url:url-p *referer*) --- /project/clim-desktop/cvsroot/clim-desktop/clhs-lookup.lisp 2006/07/27 21:59:36 1.4 +++ /project/clim-desktop/cvsroot/clim-desktop/clhs-lookup.lisp 2006/07/28 10:56:51 1.5 @@ -241,5 +241,9 @@ ;; HACK: Unclean. Just opens the apropos page. (format nil "http://bauhh.dyndns.org:8000/clim-spec/edit/apropos?q=~A" term)) +(defun clxdoc-lookup (term) + ;; HACK: Unclean. Just opens the apropos page. + (format nil "~A~A" "http://www.stud.uni-karlsruhe.de/~unk6/clxman/doc-index.cgi?q=" term)) + (defun symbol-lookup (term) (spec-lookup term :type :symbol))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 28 Jul '06

28 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv23869 Modified Files: clim-launcher.lisp EDITME.lisp Log Message: Fixes: move the CLIM debugger setup around, change climacs-gui:climacs-rv til climacs:climacs-rv. --- /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/21 04:38:15 1.6 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/28 08:10:40 1.7 @@ -67,7 +67,7 @@ (add-app "Listener" (lambda () (clim-listener:run-listener))) (add-app "Climacs" (lambda () (climacs:climacs))) -(add-app "Climacs (RV)" (lambda () (climacs-gui::climacs-rv))) +(add-app "Climacs (RV)" (lambda () (climacs:climacs-rv))) (defun start () "Start the CLIM Launcher program." --- /project/clim-desktop/cvsroot/clim-desktop/EDITME.lisp 2006/03/30 10:33:55 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/EDITME.lisp 2006/07/28 08:10:40 1.6 @@ -11,8 +11,6 @@ ;;; LOAD THE CLIM DEBUGGER (load (merge-pathnames "Apps/Debugger/clim-debugger.lisp" *mcclim-directory*)) -#+sbcl (setf *debugger-hook* #'clim-debugger:debugger) -#+cmucl (setf *debug-hook* #'clim-debugger:debugger) ;;; LOAD THE EXPERIMENTAL POINTER DOCUMENTATION (load (merge-pathnames "Experimental/pointer-doc-hack.lisp" *mcclim-directory*))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 27 Jul '06

27 Jul '06

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

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv3963 Modified Files: clim-launcher.lisp Log Message: Remove explicit presentation type definition for `clim-app'. Apparently caused some problems... --- /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/20 20:15:47 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/21 04:38:15 1.6 @@ -17,8 +17,6 @@ ((name :initarg :name :accessor name :initform "") (entry :initarg :entry :accessor entry :initform (lambda (x) (format t "~A was called~%" x))))) -(define-presentation-type clim-app ()) - (defmethod display-commands ((frame launcher) stream) (loop for app being the hash-values of *apps* do (present app 'clim-app :stream stream)))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 20 Jul '06

20 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv1764 Modified Files: clim-launcher.lisp Log Message: Use climacs:climacs instead of climacs-gui:climacs. --- /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/10 22:14:19 1.4 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/20 20:15:47 1.5 @@ -68,7 +68,7 @@ (object) (list object)) (add-app "Listener" (lambda () (clim-listener:run-listener))) -(add-app "Climacs" (lambda () (climacs-gui::climacs))) +(add-app "Climacs" (lambda () (climacs:climacs))) (add-app "Climacs (RV)" (lambda () (climacs-gui::climacs-rv))) (defun start ()

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 11 Jul '06

11 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv19436 Modified Files: clim-desktop.asd clim-desktop-minimal.asd Log Message: Fixed bug - the CLIM Debugger must be loaded before any other files are. --- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/07/10 22:14:19 1.6 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/07/10 22:26:12 1.7 @@ -22,11 +22,11 @@ :licence "" :components ((:file "packages") (:file "EDITME" :depends-on ("packages")) - (:file "abbrev" :depends-on ("packages")) + (:file "abbrev" :depends-on ("EDITME")) (:file "clhs-lookup" :depends-on ("abbrev")) (:file "beirc" :depends-on ("clim-launcher")) (:file "closure" :depends-on ("beirc" "clim-launcher" "clhs-lookup")) (:file "climacs" :depends-on ("EDITME")) (:file "debugger" :depends-on ("EDITME")) (:file "listener") - (:file "clim-launcher" :depends-on ("packages")))) + (:file "clim-launcher" :depends-on ("EDITME")))) --- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop-minimal.asd 2006/07/10 22:14:19 1.1 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop-minimal.asd 2006/07/10 22:26:12 1.2 @@ -20,8 +20,8 @@ :licence "" :components ((:file "packages") (:file "EDITME" :depends-on ("packages")) - (:file "abbrev" :depends-on ("packages")) - (:file "climacs" :depends-on ("packages")) + (:file "abbrev" :depends-on ("EDITME")) + (:file "climacs" :depends-on ("EDITME")) (:file "debugger" :depends-on ("EDITME")) (:file "listener") - (:file "clim-launcher" :depends-on ("packages" "EDITME")))) \ No newline at end of file + (:file "clim-launcher" :depends-on ("EDITME")))) \ No newline at end of file

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 11 Jul '06

11 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv17645 Modified Files: climacs.lisp clim-launcher.lisp clim-desktop.asd beirc.lisp Added Files: closure.lisp clim-desktop-minimal.asd Removed Files: swine-cmds.lisp misc.lisp Log Message: Added a CLIM-DESKTOP-MINIMAL system for people who are not interested in Beirc or Clouseau. Also removed some unused files and moved a few things around. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/07/05 14:14:38 1.13 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/07/10 22:14:19 1.14 @@ -1,9 +1,5 @@ (in-package :climacs-gui) -(define-command (com-browse-url :name t :command-table base-table) () - (let ((url (accept 'url :prompt "Browse URL"))) - (closure:visit url))) - (define-command (com-inspect-buffer :name "Inspect Buffer" :command-table base-table) () (clouseau:inspector (buffer (current-window)))) @@ -171,3 +167,19 @@ :documentation "Edit File") (object) (list object)) + +;; Translator for clicky goodness in Lisp Syntax: + +(define-command (com-inspect-symbol :name t :command-table climacs-lisp-syntax::lisp-table) + ((symbol 'symbol :prompt "Inspect symbol")) + (clouseau:inspector symbol :new-process t)) + +(define-presentation-to-command-translator inspect-symbol + (symbol com-inspect-symbol climacs-lisp-syntax::lisp-table + :gesture :inspect + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'climacs-lisp-syntax::unknown-symbol))) + :documentation "Inspect") + (object) + (list object)) --- /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/06/06 13:46:58 1.3 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/07/10 22:14:19 1.4 @@ -1,9 +1,5 @@ ;; -*- Mode: lisp -*- -;;(asdf:oos 'asdf:load-op :mcclim) -;;(asdf:oos 'asdf:load-op :clim-listener) -;;(asdf:oos 'asdf:load-op :climacs) - (in-package :clim-launcher) (define-application-frame launcher () @@ -21,6 +17,8 @@ ((name :initarg :name :accessor name :initform "") (entry :initarg :entry :accessor entry :initform (lambda (x) (format t "~A was called~%" x))))) +(define-presentation-type clim-app ()) + (defmethod display-commands ((frame launcher) stream) (loop for app being the hash-values of *apps* do (present app 'clim-app :stream stream))) @@ -70,8 +68,6 @@ (object) (list object)) (add-app "Listener" (lambda () (clim-listener:run-listener))) -(add-app "Closure" 'closure:start) -(add-app "Beirc" 'beirc:beirc) (add-app "Climacs" (lambda () (climacs-gui::climacs))) (add-app "Climacs (RV)" (lambda () (climacs-gui::climacs-rv))) @@ -82,7 +78,7 @@ ;; Get some support for launching apps into the CLIM Listener: -(defmethod display-commands ((frame clim-listener::listener) stream) +(defmethod display-applications ((frame clim-listener::listener) stream) (loop for app being the hash-values of *apps* do (present app 'clim-app :stream stream))) @@ -91,7 +87,7 @@ :command-table clim-listener::show-commands :menu t) () - (display-commands *application-frame* (frame-standard-output *application-frame*))) + (display-applications *application-frame* (frame-standard-output *application-frame*))) (define-command (com-launch-application :name t --- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/07/05 14:05:01 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/07/10 22:14:19 1.6 @@ -6,9 +6,8 @@ (in-package :clim-desktop-system) -(defsystem "clim-desktop" - :depends-on (:swank - :mcclim +(defsystem :clim-desktop + :depends-on (:mcclim :split-sequence :cl-ppcre :clim-listener @@ -16,18 +15,18 @@ :closure :clouseau :climacs) - :description "clim-desktop" - :version "0" + :description "System providing integration between a range of CLIM +applications." + :version "0.2" :author "Dwight Holman" :licence "" :components ((:file "packages") (:file "EDITME" :depends-on ("packages")) (:file "abbrev" :depends-on ("packages")) (:file "clhs-lookup" :depends-on ("abbrev")) - (:file "misc") - (:file "beirc") - (:file "climacs" :depends-on ("swine-cmds")) + (:file "beirc" :depends-on ("clim-launcher")) + (:file "closure" :depends-on ("beirc" "clim-launcher" "clhs-lookup")) + (:file "climacs" :depends-on ("EDITME")) (:file "debugger" :depends-on ("EDITME")) (:file "listener") - (:file "clim-launcher" :depends-on ("packages")) - (:file "swine-cmds" :depends-on ("clhs-lookup" "debugger")))) + (:file "clim-launcher" :depends-on ("packages")))) --- /project/clim-desktop/cvsroot/clim-desktop/beirc.lisp 2006/06/01 23:02:22 1.2 +++ /project/clim-desktop/cvsroot/clim-desktop/beirc.lisp 2006/07/10 22:14:19 1.3 @@ -1,7 +1,6 @@ (in-package :beirc) -(define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url")) - (closure:visit url)) +(clim-launcher:add-app "Beirc" 'beirc:beirc) (define-beirc-command (com-edit-user-init-file :name t) () --- /project/clim-desktop/cvsroot/clim-desktop/closure.lisp 2006/07/10 22:14:19 NONE +++ /project/clim-desktop/cvsroot/clim-desktop/closure.lisp 2006/07/10 22:14:19 1.1 ;;; -*- Mode: Lisp; Package: CLIM-DESKTOP; -*- ;;; (c) copyright 2005-2006 by ;;; Robert Strandh (strandh(a)labri.fr) ;;; David Murray (splittist(a)yahoo.com) ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. ;;; Try to integrate Closure with some CLIM applications... (clim-launcher:add-app "Closure" 'closure:start) (in-package :climacs-gui) (define-command (com-browse-url :name t :command-table base-table) () (let ((url (accept 'url :prompt "Browse URL"))) (closure:visit url))) (in-package :climacs-lisp-syntax) (define-command (com-hyperspec-lookup :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))) (in-package :beirc) (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url")) (closure:visit url))--- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop-minimal.asd 2006/07/10 22:14:19 NONE +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop-minimal.asd 2006/07/10 22:14:19 1.1 ;; -*- Mode: Lisp -*- (cl:defpackage :clim-desktop-minimal-system (:use :common-lisp :asdf)) (in-package :clim-desktop-minimal-system) (defsystem :clim-desktop-minimal :depends-on (:mcclim :split-sequence :cl-ppcre :clim-listener :clouseau :climacs) :description "Minimal CLIM Desktop without Beirc and Closure (IRC client and webbrowser)." :version "0.2" :author "Dwight Holman" :licence "" :components ((:file "packages") (:file "EDITME" :depends-on ("packages")) (:file "abbrev" :depends-on ("packages")) (:file "climacs" :depends-on ("packages")) (:file "debugger" :depends-on ("EDITME")) (:file "listener") (:file "clim-launcher" :depends-on ("packages" "EDITME"))))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 05 Jul '06

05 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv28298 Modified Files: climacs.lisp Log Message: Added global translator for editing files denoted by pathnames in Climacs. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/06/02 09:25:09 1.12 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/07/05 14:14:38 1.13 @@ -163,4 +163,11 @@ :gesture :edit :documentation "Edit Definition Of Command") (object) - (list (command-name object))) \ No newline at end of file + (list (command-name object))) + +(define-presentation-to-command-translator global-edit-pathname-translator + (pathname com-edit-in-climacs global-command-table + :gesture :edit + :documentation "Edit File") + (object) + (list object))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 05 Jul '06

05 Jul '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv27813 Modified Files: swine-cmds.lisp clim-desktop.asd Removed Files: swine.lisp Log Message: Most of Swine has been moved to Climacs, so remove it from this repo. --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/04 22:25:15 1.22 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/07/05 14:05:01 1.23 @@ -25,155 +25,6 @@ (in-package :climacs-lisp-syntax) -(define-command (com-eval-last-expression :name t :command-table lisp-table) - ((insertp 'boolean :prompt "Insert?")) - "Evaluate the expression before point." - (let* ((syntax (syntax (buffer (current-window)))) - (mark (point (current-window))) - (token (form-before syntax (offset mark)))) - (if token - (with-syntax-package syntax mark (package) - (let ((*package* package)) - (climacs-gui::com-eval-expression - (read-from-string (token-string syntax token)) - insertp))) - (esa:display-message "Nothing to evaluate.")))) - -(esa:set-key `(com-eval-last-expression ,esa:*numeric-argument-p*) - 'lisp-table - '((#\c :control) (#\e :control))) - -(define-command (com-macroexpand-1 :name t :command-table lisp-table) - () - "Macroexpand-1 the expression at point. - -The expanded expression will be displayed in a -\"*Macroexpansion*\"-buffer." - (let* ((syntax (syntax (buffer (current-window)))) - (token (expression-at-mark (point (current-window)) syntax))) - (if token - (macroexpand-token syntax token) - (esa:display-message "Nothing to expand at point.")))) - -(esa:set-key 'com-macroexpand-1 - 'lisp-table - '((#\c :control) (#\Newline))) - -(esa:set-key 'com-macroexpand-1 - 'lisp-table - '((#\c :control) (#\m :control))) - -(define-command (com-macroexpand-all :name t :command-table lisp-table) - () - "Completely macroexpand the expression at point. - -The expanded expression will be displayed in a -\"*Macroexpansion*\"-buffer." - (let* ((syntax (syntax (buffer (current-window)))) - (token (expression-at-mark (point (current-window)) syntax))) - (if token - (macroexpand-token syntax token t) - (esa:display-message "Nothing to expand at point.")))) - -(define-command (com-eval-region :name t :command-table lisp-table) - () - "Evaluate the current region." - (let ((mark (mark (current-window))) - (point (point (current-window)))) - (when (mark> mark point) - (rotatef mark point)) - (evaluating-interactively - (eval-region mark point - (syntax (buffer (current-window))))))) - -(esa:set-key 'com-eval-region - 'lisp-table - '((#\c :control) (#\r :control))) - -(define-command (com-compile-definition :name t :command-table lisp-table) - () - "Compile and load definition at point." - (evaluating-interactively - (compile-definition-interactively (point (current-window)) - (current-window) - (syntax (buffer (current-window)))))) - -(esa:set-key 'com-compile-definition - 'lisp-table - '((#\c :control) (#\c :control))) - -(define-command (com-compile-and-load-file :name t :command-table lisp-table) - () - "Compile and load the current file. - -Compiler notes will be displayed in a seperate buffer." - (compile-file-interactively (buffer (current-window)) t)) - -(esa:set-key 'com-compile-and-load-file - 'lisp-table - '((#\c :control) (#\k :control))) - -(define-command (com-compile-file :name t :command-table lisp-table) - () - "Compile the file open in the current buffer. - -This command does not load the file after it has been compiled." - (compile-file-interactively (buffer (current-window)) nil)) - -(esa:set-key 'com-compile-file - 'lisp-table - '((#\c :control) (#\k :meta))) - -(define-command (com-goto-location :name t :command-table lisp-table) - ((note 'compiler-note)) - "Move point to the part of a given file that caused the -compiler note. - -If the file is not already open, a new buffer will be opened with -that file." - (goto-location (location note))) - -(define-presentation-to-command-translator compiler-note-to-goto-location-translator - (compiler-note com-goto-location lisp-table) - (presentation) - (list (presentation-object presentation))) - -(define-command (com-goto-xref :name t :command-table lisp-table) - ((xref 'xref)) - "Go to the referenced location of a code cross-reference." - (goto-location xref)) - -(define-presentation-to-command-translator xref-to-goto-location-translator - (xref com-goto-xref lisp-table) - (presentation) - (list (presentation-object presentation))) - -(define-command (com-edit-this-definition :command-table lisp-table) - () - "Edit definition of the symbol at point. -If there is no symbol at point, this is a no-op." - (let* ((buffer (buffer (current-window))) - (point (point (current-window))) - (syntax (syntax buffer)) - (token (this-form point syntax)) - (this-symbol (when token (token-to-object syntax token)))) - (when (and this-symbol (symbolp this-symbol)) - (edit-definition this-symbol)))) - -(esa:set-key `(com-edit-this-definition) - 'lisp-table - '((#\. :meta))) - -(define-command (com-return-from-definition :name t :command-table lisp-table) - () - "Return point to where it was before the previous Edit -Definition command was issued." - (pop-find-definition-stack)) - -(esa:set-key 'com-return-from-definition - 'lisp-table - '((#\, :meta))) - (define-command (com-hyperspec-lookup :name t :command-table lisp-table) () "Look up a symbol in the Common Lisp HyperSpec." @@ -189,99 +40,6 @@ 'lisp-table '((#\c :control) (#\d :control) (#\h))) -(define-command (com-lookup-arglist-for-this-symbol :command-table lisp-table) - () - "Show argument list for symbol at point." - (let* ((pane (current-window)) - (buffer (buffer pane)) - (syntax (syntax buffer)) - (mark (point pane)) - (token (this-form mark syntax))) - (if (and token (typep token 'complete-token-lexeme)) - (com-lookup-arglist (token-to-object syntax token)) - (esa:display-message "Could not find symbol at point.")))) - -(define-command (com-lookup-arglist :name t :command-table lisp-table) - ((symbol 'symbol :prompt "Symbol")) - "Show argument list for a given symbol." - (show-arglist symbol)) - -(esa:set-key `(com-lookup-arglist-for-this-symbol) - 'lisp-table - '((#\c :control) (#\d :control) (#\a))) - -(define-command (com-space :command-table lisp-table) - () - "Insert a space and display argument hints in the minibuffer." - (let* ((window (current-window)) - (mark (point window)) - (syntax (syntax (buffer window)))) - ;; It is important that the space is inserted before we look up - ;; any symbols, but at the same time, there must not be a space - ;; between the mark and the symbol. - (insert-character #\Space) - (backward-object mark) - ;; We must update the syntax in order to reflect any changes to - ;; the parse tree our insertion of a space character may have - ;; done. - (update-syntax (buffer syntax) syntax) - (show-arglist-for-form-at-mark mark syntax) - (forward-object mark) - (clear-completions))) - -(esa:set-key 'com-space - 'lisp-table - '((#\Space))) - -(define-command (com-complete-symbol :name t :command-table lisp-table) () - "Attempt to complete the symbol at mark. - -If more than one completion is available, a list of possible -completions will be displayed." - (let* ((pane (current-window)) - (buffer (buffer pane)) - (syntax (syntax buffer)) - (point-current-window (point pane)) - (name (symbol-name-at-mark point-current-window - syntax))) - (when name - (with-syntax-package syntax point-current-window (package) - (let ((completion (show-completions name package)) - (mark (clone-mark point-current-window))) - (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion))))))) - -(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) () - "Attempt to fuzzily complete the abbreviation at mark. - -Fuzzy completion tries to guess which symbol is abbreviated. If -the abbreviation is ambiguous, a list of possible completions -will be displayed." - (let* ((pane (current-window)) - (buffer (buffer pane)) - (syntax (syntax buffer)) - (point-current-window (point pane)) - (name (symbol-name-at-mark point-current-window - syntax))) - (when name - (with-syntax-package syntax point-current-window (package) - (let ((completion (show-fuzzy-completions name package)) - (mark (clone-mark point-current-window))) - (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion))))))) - -(esa:set-key 'com-complete-symbol - 'lisp-table - '((#\Tab :meta))) - -(esa:set-key 'com-fuzzily-complete-symbol - 'lisp-table - '((#\c :control) (#\i :meta))) - ;; Translators for clicky goodness: (define-command (com-inspect-symbol :name t :command-table lisp-table) @@ -297,13 +55,3 @@ :documentation "Inspect") (object) (list object)) - -(define-presentation-to-command-translator lookup-symbol-arglist - (symbol com-lookup-arglist lisp-table - :gesture :describe - :tester ((object presentation) - (declare (ignore object)) - (not (eq (presentation-type presentation) 'unknown-symbol))) - :documentation "Lookup arglist") - (object) - (list object)) \ No newline at end of file --- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/05/18 21:32:15 1.4 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/07/05 14:05:01 1.5 @@ -30,5 +30,4 @@ (:file "debugger" :depends-on ("EDITME")) (:file "listener") (:file "clim-launcher" :depends-on ("packages")) - (:file "swine") - (:file "swine-cmds" :depends-on ("swine" "clhs-lookup" "debugger")))) + (:file "swine-cmds" :depends-on ("clhs-lookup" "debugger"))))

1 0

[clim-desktop-cvs] CVS clim-desktop
by thenriksen 06 Jun '06

06 Jun '06

Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv12631 Modified Files: clim-launcher.lisp Log Message: Added support for launching applications to the Listener. --- /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/03/30 10:33:55 1.2 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-launcher.lisp 2006/06/06 13:46:58 1.3 @@ -4,8 +4,6 @@ ;;(asdf:oos 'asdf:load-op :clim-listener) ;;(asdf:oos 'asdf:load-op :climacs) - - (in-package :clim-launcher) (define-application-frame launcher () @@ -39,9 +37,9 @@ (define-launcher-command com-launch-app ((appl 'clim-app)) - ;; SBCL doesn't keep dynamic bindings from the parent thread when - ;; invoking a new thread, so we'll have to create the threads and - ;; the bindings ourselves. + ;; KLUDGE: SBCL doesn't keep dynamic bindings from the parent thread + ;; when invoking a new thread, so we'll have to create the threads + ;; and the bindings ourselves. (flet ((run () (let #+sbcl ((sb-ext:*invoke-debugger-hook* #'clim-debugger:debugger) (*debugger-hook* #'clim-debugger:debugger)) @@ -80,4 +78,71 @@ (defun start () "Start the CLIM Launcher program." #+:cmucl (multiprocessing::startup-idle-and-top-level-loops) - (run-frame-top-level (make-application-frame 'clim-launcher::launcher))) \ No newline at end of file + (run-frame-top-level (make-application-frame 'clim-launcher::launcher))) + +;; Get some support for launching apps into the CLIM Listener: + +(defmethod display-commands ((frame clim-listener::listener) stream) + (loop for app being the hash-values of *apps* + do (present app 'clim-app :stream stream))) + +(define-command (com-list-applications + :name t + :command-table clim-listener::show-commands + :menu t) + () + (display-commands *application-frame* (frame-standard-output *application-frame*))) + +(define-command (com-launch-application + :name t + :command-table clim-listener::lisp-commands + :menu t) + ((appl 'clim-app)) + ;; KLUDGE: SBCL doesn't inherit local dynamic bindings from the + ;; parent thread, so we'll have to create the threads and the + ;; bindings ourselves. + (flet ((run () + (let #+sbcl ((sb-ext:*invoke-debugger-hook* #'clim-debugger:debugger) + (*debugger-hook* #'clim-debugger:debugger)) + #-sbcl nil + (funcall (entry appl))))) + (clim-sys:make-process #'run :name (name appl)))) + +(define-presentation-to-command-translator launch-application-translator + (clim-app com-launch-application clim-listener::lisp-commands + :gesture :select + :documentation "Launch Application") + (object) + (list object)) + +(define-presentation-to-command-translator edit-application-translator + (clim-app climacs-gui::com-edit-function-definition clim-listener::lisp-commands + :gesture :edit + :tester ((object presentation) + (declare (ignore presentation)) + (symbolp (entry object))) + :documentation "Edit Application") + (object) + (list (entry object))) + +(define-presentation-method accept + ((type clim-app) stream view &key (default nil defaultp) + (default-type type)) + (multiple-value-bind (object success string) + (complete-input stream + (lambda (so-far action) + (complete-from-possibilities + so-far + (loop for val being the hash-values of *apps* + collecting val) + '() + :action action + :name-key #'name + :value-key #'identity)) + :partial-completers '(#\Space) + :allow-any-input t) + (cond (success + (values object type)) + ((and (zerop (length string)) defaultp) + (values default default-type)) + (t (values string 'string))))) \ No newline at end of file

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

clim-desktop-cvs