closure-cvs December 2006

closure-cvs@common-lisp.net

2 participants
53 discussions

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv12757 Modified Files: closure.asd Log Message: "so that non-GUI parts of Closure don't have to depend on CLIM anymore" ... make it so. --- /project/closure/cvsroot/closure/closure.asd 2006/12/31 15:42:40 1.12 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 15:45:30 1.13 @@ -60,8 +60,7 @@ (make-pathname :name nil :type nil :defaults *load-truename*)) :default-component-class closure-source-file - :depends-on (:cxml :mcclim - ;; uncomment this if we actually need gray streams: + :depends-on (:cxml ;; uncomment this if we actually need gray streams: ;; :trivial-gray-streams #+sbcl :sb-bsd-sockets) :components

1 0

[closure-cvs] CVS closure/src/html
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/html In directory clnet:/tmp/cvs-serv11810/src/html Modified Files: html-style.lisp Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/src/html/html-style.lisp 2006/12/31 12:05:33 1.9 +++ /project/closure/cvsroot/closure/src/html/html-style.lisp 2006/12/31 15:42:41 1.10 @@ -378,13 +378,13 @@ (make-hash-table :test #'equalp)) (defparameter *style-sheet-cache*/lock - (mp/make-lock :name "*style-sheet-cache*")) + (bordeaux-threads:make-lock "*style-sheet-cache*")) (defun maybe-parse-style-sheet-from-url (url &key (name "anonymous") (supersheet nil) (media-type :all)) (multiple-value-bind (looked presentp) - (mp/with-lock (*style-sheet-cache*/lock) + (bordeaux-threads:with-recursive-lock-held (*style-sheet-cache*/lock) (gethash url *style-sheet-cache*)) (cond (presentp (format *debug-io* "~&;; Serving style sheet ~S [at ~S] from cache.~%" @@ -398,7 +398,7 @@ :name name :supersheet supersheet :media-type media-type))) - (mp/with-lock (*style-sheet-cache*/lock) + (bordeaux-threads:with-recursive-lock-held (*style-sheet-cache*/lock) (setf (gethash url *style-sheet-cache*) res)) res)))))

1 0

[closure-cvs] CVS closure/src/net
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/net In directory clnet:/tmp/cvs-serv11810/src/net Modified Files: ftp.lisp http.lisp Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/src/net/ftp.lisp 2005/03/13 18:02:19 1.2 +++ /project/closure/cvsroot/closure/src/net/ftp.lisp 2006/12/31 15:42:41 1.3 @@ -683,11 +683,11 @@ ||# (defvar *connection-pool* nil) -(defvar *connection-pool-lock* (mp/make-lock :name "FTP connections pool lock")) +(defvar *connection-pool-lock* (bordeaux-threads:make-lock "FTP connections pool lock")) (defmacro with-ftp-connection-pool (dummy &body body) dummy - `(mp/with-lock (*connection-pool-lock*) + `(bordeaux-threads:with-recursive-lock-held (*connection-pool-lock*) ,@body)) (defun put-ftp-connection-into-pool (connection) --- /project/closure/cvsroot/closure/src/net/http.lisp 2006/11/06 19:41:56 1.9 +++ /project/closure/cvsroot/closure/src/net/http.lisp 2006/12/31 15:42:41 1.10 @@ -414,7 +414,7 @@ (cond ((probe-file fn) (with-open-file (stream fn :direction :input) (let ((*package* (symbol-package 'http-cache-entry))) - (let ((res (make-http-cache :lock (mp/make-lock :name "HTTP cache lock") + (let ((res (make-http-cache :lock (bordeaux-threads:make-lock "HTTP cache lock") :directory directory :entries (make-hash-table :test #'equal)))) (setf (http-cache-serial res) (read stream)) @@ -424,13 +424,13 @@ (put-hce res x)) res)))) (t - (make-http-cache :lock (mp/make-lock :name "HTTP cache lock") + (make-http-cache :lock (bordeaux-threads:make-lock "HTTP cache lock") :directory directory :entries (make-hash-table :test #'equal) :serial 0)) ))) (defun commit-cache (&optional (cache (http-cache))) - (mp/with-lock ((http-cache-lock cache)) + (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache)) (with-open-file (sink (merge-pathnames "index" (http-cache-directory cache)) :direction :output :if-exists :new-version) (let ((*print-pretty* nil) @@ -443,15 +443,15 @@ (http-cache-entries cache)) ))) ) (defun invent-cache-filename (cache) - (mp/with-lock ((http-cache-lock cache)) + (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache)) (format nil "~5,'0D" (incf (http-cache-serial cache))))) (defun get-hce (cache url) - (mp/with-lock ((http-cache-lock cache)) + (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache)) (gethash url (http-cache-entries cache)))) (defun put-hce (cache hce) - (mp/with-lock ((http-cache-lock cache)) + (bordeaux-threads:with-recursive-lock-held ((http-cache-lock cache)) ;; if there was already an entry for that URL with under a different filename, ;; delete the old file (let ((old-ce (gethash (hce-url hce) (http-cache-entries cache))))

1 0

[closure-cvs] CVS closure/src/renderer
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv11810/src/renderer Modified Files: document.lisp Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/src/renderer/document.lisp 2005/07/19 20:42:09 1.5 +++ /project/closure/cvsroot/closure/src/renderer/document.lisp 2006/12/31 15:42:41 1.6 @@ -39,8 +39,10 @@ ;; list of all processes working for this document (processes :initform nil :accessor document-processes) - (processes/lock :initform (mp/make-lock :name "doc-proc-list Lock") + (processes/lock :initform (bordeaux-threads:make-lock "doc-proc-list Lock") :accessor document-processes/lock) ;this needs a lock + (processes/cv :initform (bordeaux-threads:make-condition-variable) + :accessor document-processes/cv) (processes-hooks ;; a list of hooks to call when ever the value of processes changes. :initform nil @@ -89,33 +91,44 @@ ;; Runs a process on behalf of a document, `continuation' is the ;; function to be run within the new process. ;; Returns the new process created. - (mp/with-lock ((document-processes/lock document)) + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) (let (new-process) (setf new-process - (mp/process-run-function - name + (bordeaux-threads:make-thread ;; << child (lambda () - (unwind-protect - (funcall continuation) - ;; remove myself from the list of processes - (progn - (mp/with-lock ((document-processes/lock document)) - (setf (document-processes document) - (delete new-process (document-processes document)))) ))) + (catch 'quit-dce-process + (unwind-protect + (funcall continuation) + ;; remove myself from the list of processes + (progn + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (setf (document-processes document) + (delete new-process (document-processes document))) + (bordeaux-threads:condition-notify + (document-processes/cv document))))))) ;; >> - )) + :name name)) ;; add new process to list of process (push new-process (document-processes document)) new-process))) +;; bordeaux-threads says that kill-thread might not unwind cleanly. +;; Let's use interrupt-thread then. +(defun kill-dce-thread (thread) + (bordeaux-threads:interrupt-thread + thread + (lambda () (throw 'quit-dce-process nil)))) + (defun kill-all-document-processes (document) (setf (document-dead-p document) t) - (mp/with-lock ((document-processes/lock document)) - (mapc #'mp/process-kill (document-processes document))) - (mp/process-wait "Waiting for documents processes dying." - (lambda () - (null (document-processes document)))) + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (mapc #'kill-dce-thread (document-processes document))) + (loop + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (unless (document-processes document) + (return)) + (bordeaux-threads:condition-wait (document-processes/cv document)))) (values)) (defstruct image-entry

1 0

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv11810 Modified Files: INSTALL closure.asd Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/INSTALL 2006/12/29 22:09:37 1.4 +++ /project/closure/cvsroot/closure/INSTALL 2006/12/31 15:42:40 1.5 @@ -17,10 +17,11 @@ [Debian package gif2png] - 4. McCLIM, Closure XML, and their dependencies + 4. McCLIM, Closure XML, Bordeaux Threads, and their dependencies [ http://common-lisp.net/project/mcclim/ - http://common-lisp.net/project/cxml/ ] + http://common-lisp.net/project/cxml/ + http://common-lisp.net/project/bordeaux-threads/ ] Compile closure using ASDF: Register closure.asd in your central --- /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:11:44 1.11 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 15:42:40 1.12 @@ -86,7 +86,8 @@ (asdf:defsystem closure :depends-on (:clim :clim-clx - :glisp) + :glisp + :bordeaux-threads) :default-component-class closure-source-file :components ((:module src

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv11810/src/glisp Modified Files: dep-acl.lisp dep-clisp.lisp dep-cmucl.lisp dep-gcl.lisp dep-openmcl.lisp dep-sbcl.lisp dep-scl.lisp package.lisp Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp 2006/12/31 12:14:36 1.3 +++ /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp 2006/12/31 15:42:40 1.4 @@ -29,14 +29,6 @@ (export 'glisp::read-byte-sequence :glisp) (export 'glisp::read-char-sequence :glisp) (export 'glisp::run-unix-shell-command :glisp) -(export 'glisp::mp/process-run-function :glisp) -(export 'glisp::mp/process-kill :glisp) -(export 'glisp::mp/seize-lock :glisp) -(export 'glisp::mp/release-lock :glisp) -(export 'glisp::mp/transfer-lock-owner :glisp) -(export 'glisp::mp/current-process :glisp) -(export 'glisp::mp/process-yield :glisp) -(export 'glisp::mp/process-wait :glisp) (export 'glisp::getenv :glisp) (defun glisp::read-byte-sequence (&rest ap) @@ -67,13 +59,6 @@ ) ||# -(defun glisp::mp/make-lock (&key name) - (mp:make-process-lock :name name)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(mp:with-process-lock (,lock) - ,@body)) - (defmacro glisp::with-timeout ((&rest options) &body body) `(mp:with-timeout ,options . ,body)) @@ -83,32 +68,5 @@ (defun glisp:run-unix-shell-command (cmd) (excl:shell cmd)) -(defun glisp:mp/process-run-function (name fn &rest args) - (apply #'mp:process-run-function name fn args)) - -(defun glisp:mp/process-kill (proc) - (mp:process-kill proc)) - -(defun glisp:mp/current-process () - sys:*current-process*) - -(defun glisp::mp/seize-lock (lock &key whostate) - whostate - (mp:process-lock lock)) - -(defun glisp::mp/transfer-lock-owner (lock old-process new-process) - (assert (eql (mp:process-lock-locker lock) old-process)) - (setf (mp:process-lock-locker lock) new-process) - ) - -(defun glisp::mp/release-lock (lock) - (mp:process-unlock lock)) - -(defun glisp::mp/process-yield (&optional process-to-run) - (mp:process-allow-schedule process-to-run)) - -(defun glisp::mp/process-wait (whostate predicate) - (mp:process-wait whostate predicate)) - (defun glisp::getenv (string) (sys:getenv string)) --- /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2006/12/31 12:14:36 1.3 +++ /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2006/12/31 15:42:40 1.4 @@ -123,54 +123,3 @@ (export 'glisp::getenv :glisp) (defun glisp::getenv (var) (sys::getenv var)) - - - -(export 'glisp::mp/process-run-function :glisp) -(defun glisp:mp/process-run-function (name fn &rest args) - (apply #'mp:process-run-function name fn args)) - -(export 'glisp::mp/process-kill :glisp) -(defun glisp:mp/process-kill (proc) - (mp:process-kill proc)) - -(export 'glisp::mp/current-process :glisp) -(defun glisp:mp/current-process () - (mp:current-process)) - -(export 'glisp::mp/seize-lock :glisp) -(defun glisp::mp/seize-lock (lock &key whostate) - whostate - (mp:process-lock lock)) - -(export 'glisp::mp/release-lock :glisp) -(defun glisp::mp/release-lock (lock) - (mp:process-unlock lock)) - -(export 'glisp::mp/process-yield :glisp) -(defun glisp::mp/process-yield (&optional process-to-run) - process-to-run - (mp:process-allow-schedule)) - -(export 'glisp::mp/process-wait :glisp) -(defun glisp::mp/process-wait (whostate predicate) - (mp::process-wait whostate predicate)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(mp:with-process-lock (,lock) - ,@body)) - -(defun glisp::mp/make-lock (&key name) - (mp:make-process-lock :name name)) - - - - - - - - - - - - --- /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2006/12/31 12:14:36 1.3 +++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2006/12/31 15:42:40 1.4 @@ -192,7 +192,7 @@ On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from: target:code/run-program.lisp Created: Saturday, 6/20/98 07:13:08 pm [-1] - Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $ + Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.4 2006/12/31 15:42:40 dlichteblau Exp $ ||# ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil)) @@ -200,41 +200,5 @@ (defun glisp:run-unix-shell-command (command) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil))) -;;; MP - -(export 'glisp::mp/process-yield :glisp) -(export 'glisp::mp/process-wait :glisp) -(export 'glisp::mp/process-run-function :glisp) -(export 'glisp::mp/make-lock :glisp) -(export 'glisp::mp/current-process :glisp) -(export 'glisp::mp/process-kill :glisp) - -(defun glisp::mp/make-lock (&key name) - (mp:make-lock name)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(mp:with-lock-held (,lock) - ,@body)) - -(defun glisp::mp/process-yield (&optional process-to-run) - (declare (ignore process-to-run)) - (mp:process-yield)) - -(defun glisp::mp/process-wait (whostate predicate) - (mp:process-wait whostate predicate)) - -(defun glisp::mp/process-run-function (name fun &rest args) - (mp:make-process - (lambda () - (apply fun args)) - :name name)) - -(defun glisp::mp/current-process () - mp:*current-process*) - -(defun glisp::mp/process-kill (process) - (mp:destroy-process process)) - (defun glisp::getenv (string) (cdr (assoc string ext:*environment-list* :test #'string-equal))) - --- /project/closure/cvsroot/closure/src/glisp/dep-gcl.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-gcl.lisp 2006/12/31 15:42:40 1.3 @@ -100,15 +100,6 @@ index) value)) -(defun glisp::mp/make-lock (&key name) - name - nil) - -(defmacro glisp::mp/with-lock ((lock) &body body) - (declare (ignore lock)) - `(progn - ,@body)) - (defmacro glisp::with-timeout ((&rest ignore) &body body) (declare (ignore ignore)) `(progn --- /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp 2006/12/31 12:14:36 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp 2006/12/31 15:42:40 1.3 @@ -145,41 +145,6 @@ (ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))) -;;; MP - -(export 'glisp::mp/process-yield :glisp) -(export 'glisp::mp/process-wait :glisp) -(export 'glisp::mp/process-run-function :glisp) -(export 'glisp::mp/make-lock :glisp) -(export 'glisp::mp/current-process :glisp) -(export 'glisp::mp/process-kill :glisp) - -(defun glisp::mp/make-lock (&key name) - (clim-sys::make-lock name)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(clim-sys:with-lock-held (,lock) - ,@body)) - -(defun glisp::mp/process-yield (&optional process-to-run) - (declare (ignore process-to-run)) - (clim-sys:process-yield)) - -(defun glisp::mp/process-wait (whostate predicate) - (clim-sys:process-wait whostate predicate)) - -(defun glisp::mp/process-run-function (name fun &rest args) - (clim-sys:make-process - (lambda () - (apply fun args)) - :name name)) - -(defun glisp::mp/current-process () - (clim-sys:current-process)) - -(defun glisp::mp/process-kill (process) - (clim-sys:destroy-process process)) - (defun glisp::getenv (string) (ccl::getenv string)) \ No newline at end of file --- /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp 2006/12/31 12:14:36 1.4 +++ /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp 2006/12/31 15:42:40 1.5 @@ -100,41 +100,5 @@ (sb-ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil))) -;;; MP - -(export 'glisp::mp/process-yield :glisp) -(export 'glisp::mp/process-wait :glisp) -(export 'glisp::mp/process-run-function :glisp) -(export 'glisp::mp/make-lock :glisp) -(export 'glisp::mp/current-process :glisp) -(export 'glisp::mp/process-kill :glisp) - -(defun glisp::mp/make-lock (&key name) - (clim-sys::make-lock name)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(clim-sys:with-lock-held (,lock) - ,@body)) - -(defun glisp::mp/process-yield (&optional process-to-run) - (declare (ignore process-to-run)) - (clim-sys:process-yield)) - -(defun glisp::mp/process-wait (whostate predicate) - (clim-sys:process-wait whostate predicate)) - -(defun glisp::mp/process-run-function (name fun &rest args) - (clim-sys:make-process - (lambda () - (apply fun args)) - :name name)) - -(defun glisp::mp/current-process () - (clim-sys:current-process)) - -(defun glisp::mp/process-kill (process) - (clim-sys:destroy-process process)) - (defun glisp::getenv (string) (sb-ext:posix-getenv string)) - --- /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 13:11:44 1.1 +++ /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 15:42:40 1.2 @@ -161,7 +161,7 @@ On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from: target:code/run-program.lisp Created: Saturday, 6/20/98 07:13:08 pm [-1] - Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.1 2006/12/31 13:11:44 dlichteblau Exp $ + Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.2 2006/12/31 15:42:40 dlichteblau Exp $ ||# ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil)) @@ -172,41 +172,5 @@ ;;; MP -(export 'glisp::mp/process-yield :glisp) -(export 'glisp::mp/process-wait :glisp) -(export 'glisp::mp/process-run-function :glisp) -(export 'glisp::mp/make-lock :glisp) -(export 'glisp::mp/current-process :glisp) -(export 'glisp::mp/process-kill :glisp) - -(defun glisp::mp/make-lock (&key name) - (pthread::make-lock name)) - -(defmacro glisp::mp/with-lock ((lock) &body body) - `(pthread::with-lock-held (,lock) - ,@body)) - -(defun glisp::mp/process-yield (&optional process-to-run) - (declare (ignore process-to-run)) - (PTHREAD:SCHED-YIELD)) - -(defun glisp::mp/process-wait (whostate predicate) - (do () - ((funcall predicate)) - (sleep .1))) - -(defun glisp::mp/process-run-function (name fun &rest args) - (pthread::thread-create - (lambda () - (apply fun args)) - :name name)) - -(defun glisp::mp/current-process () - 'blah) - -(defun glisp::mp/process-kill (process) - (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL.")) - (defun glisp::getenv (string) (cdr (assoc string ext:*environment-list* :test #'string-equal))) - --- /project/closure/cvsroot/closure/src/glisp/package.lisp 2006/12/31 12:35:18 1.7 +++ /project/closure/cvsroot/closure/src/glisp/package.lisp 2006/12/31 15:42:40 1.8 @@ -32,8 +32,6 @@ (:use :cl) (:export "DEFSUBST" "G/MAKE-STRING" - "MP/MAKE-LOCK" - "MP/WITH-LOCK" "WITH-TIMEOUT" "OPEN-INET-SOCKET" ;; util.lisp :

1 0

[closure-cvs] CVS closure/src/gui
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv11810/src/gui Modified Files: clim-gui.lisp clue-gui.lisp dce-and-pce.lisp Log Message: Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore. - Removed all mp/ functions from glisp. - Use condition variables instead of process-wait. --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/31 13:26:23 1.26 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/31 15:42:40 1.27 @@ -4,7 +4,7 @@ ;;; Created: 2002-07-22 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.27 2006/12/31 15:42:40 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,14 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.27 2006/12/31 15:42:40 dlichteblau +;; Use Bordeaux Threads for all threading primitives, so that non-GUI parts of +;; Closure don't have to depend on CLIM anymore. +;; +;; - Removed all mp/ functions from glisp. +;; +;; - Use condition variables instead of process-wait. +;; ;; Revision 1.26 2006/12/31 13:26:23 emarsden ;; - add basic wholine support (currently title & last-modified information) ;; - add "TeX mode On" and "TeX mode Off" commands (experimental) @@ -445,7 +453,7 @@ (defmacro with-closure (ignore &body body) (declare (ignore ignore)) - `(clim-sys:with-lock-held (*closure-lock*) + `(clim-sys:with-recursive-lock-held (*closure-lock*) ,@body)) (defun parse-url* (url) --- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2006/12/31 11:48:18 1.5 +++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2006/12/31 15:42:40 1.6 @@ -41,7 +41,7 @@ (in-package :clue-gui2) (defparameter *dcache* nil) -(defparameter *dcache-lock* (mp/make-lock :name "dcache")) +(defparameter *dcache-lock* (bordeaux-threads:make-lock "dcache")) (defparameter *pixmap-cache* nil) --- /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp 2005/03/13 18:01:37 1.3 +++ /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp 2006/12/31 15:42:40 1.4 @@ -47,27 +47,28 @@ &key lazy-p callback) (let ((url (if (url:url-p url) (url:unparse-url url) url))) (let* ((dce - (mp/with-lock (*dcache-lock*) + (bordeaux-threads:with-recursive-lock-held (*dcache-lock*) (or (find-if (lambda (el) (and (equal (dce-url el) url) (eq (dce-presentation el) presentation))) *dcache*) - (let ((new-dce (make-dce :url url - :presentation presentation - :data :work-in-progress - :lock (mp/make-lock :name "dce lock"))) - (flag nil)) - (r2::run-process-on-behalf-of-document - document - (lambda () - (mp/with-lock ((dce-lock new-dce)) - (setf flag t) - (setf (dce-data new-dce) - (dcache-generate-presentation presentation document url)) ))) - (mp/process-wait "foo" - (lambda () flag)) - (push new-dce *dcache*) + (let* ((lock (bordeaux-threads:make-lock "dce lock")) + (new-dce (make-dce :url url + :presentation presentation + :data :work-in-progress + :lock lock)) + (flag (bordeaux-threads:make-condition-variable))) + (bordeaux-threads:with-recursive-lock-held (lock) + (r2::run-process-on-behalf-of-document + document + (lambda () + (bordeaux-threads:with-recursive-lock-held (lock) + (bordeaux-threads:condition-notify flag) + (setf (dce-data new-dce) + (dcache-generate-presentation presentation document url)) ))) + (bordeaux-threads:condition-wait flag lock) + (push new-dce *dcache*)) new-dce))))) (if lazy-p (progn @@ -75,10 +76,10 @@ document (lambda () (funcall callback - (mp/with-lock ((dce-lock dce)) + (bordeaux-threads:with-recursive-lock-held ((dce-lock dce)) (dce-data dce))))) nil) - (mp/with-lock ((dce-lock dce)) + (bordeaux-threads:with-recursive-lock-held ((dce-lock dce)) (dce-data dce)) )))) (defmethod dcache-generate-presentation ((presentation (eql :aimage)) document url)

1 0

[closure-cvs] CVS closure/src/gui
by emarsden 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv18515/src/gui Modified Files: clim-gui.lisp Log Message: - add basic wholine support (currently title & last-modified information) - add "TeX mode On" and "TeX mode Off" commands (experimental) --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/30 15:13:54 1.25 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/31 13:26:23 1.26 @@ -4,7 +4,7 @@ ;;; Created: 2002-07-22 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: clim-gui.lisp,v 1.25 2006/12/30 15:13:54 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,10 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.26 2006/12/31 13:26:23 emarsden +;; - add basic wholine support (currently title & last-modified information) +;; - add "TeX mode On" and "TeX mode Off" commands (experimental) +;; ;; Revision 1.25 2006/12/30 15:13:54 emarsden ;; - use CL from Closure packages ;; - minor rod fixes @@ -183,7 +187,7 @@ :height 20 :min-height 20 :max-height 20 - :width 200 + :width 300 :background +black+ :foreground +white+) (interactor @@ -536,6 +540,13 @@ (write-string string (find-pane-named *frame* 'status)) (clim-backend:port-force-output (find-port))) +(defun write-wholine (string) + (let ((wholine (find-pane-named *frame* 'wholine))) + (window-clear wholine) + (write-string string wholine) + (clim-backend:port-force-output (find-port)))) + + (defun foo (url) (let ((*standard-output* *trace-output*)) (clim-sys:make-process @@ -553,8 +564,7 @@ (write-status "Fetching Document ...") (let* ((doc (make-instance 'r2::document :processes-hooks nil - :location - (r2::parse-url* url) + :location (r2::parse-url* url) :http-header header :pt (clue-gui2::make-pt-from-input io @@ -576,6 +586,10 @@ 600 ;xxx width t ;? 0) + (write-wholine (format nil "Title: ~A~%~@[Modified: ~A~]" + (renderer::document-title *current-document*) + (or (netlib::get-header-field header :last-modified) + (netlib::get-header-field header :date)))) (let ((x2 (bounding-rectangle-max-x (stream-output-history *pane*))) (y2 (bounding-rectangle-max-y (stream-output-history *pane*)))) (setf y2 (max y2 r2::*document-height*)) @@ -600,7 +614,7 @@ (let ((closure-protocol:*document-language* (if (sgml::pt-p (r2::document-pt *current-document*)) (make-instance 'r2::html-4.0-document-language) - (make-instance 'r2::xml-style-document-language) )) + (make-instance 'r2::xml-style-document-language))) (closure-protocol:*user-agent* nil) (r2::*canvas-width* (bounding-rectangle-width (sheet-parent *pane*)))) @@ -675,3 +689,15 @@ (handle-repaint *pane* (sheet-region (pane-viewport *pane*)))) (clim-backend:port-force-output (find-port))) +(define-closure-command (com-tex-mode-on :name t) () + (setq renderer:*tex-mode-p* t) + (setq renderer:*hyphenate-p* t) + (send-closure-command 'com-reflow)) + +(define-closure-command (com-tex-mode-off :name t) () + (setq renderer:*tex-mode-p* nil) + (setq renderer:*hyphenate-p* nil) + (send-closure-command 'com-reflow)) + + +;; EOF

1 0

[closure-cvs] CVS closure/src/parse
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv18356 Modified Files: pt.lisp Log Message: rune fixes --- /project/closure/cvsroot/closure/src/parse/pt.lisp 2005/03/13 18:02:40 1.4 +++ /project/closure/cvsroot/closure/src/parse/pt.lisp 2006/12/31 13:24:49 1.5 @@ -150,7 +150,13 @@ (defun ppt (pt &optional (prefix "") (barp nil)) (cond ((eq (pt-name pt) :pcdata) - (let ((s (map 'string #'(lambda (x) (if (eql x 10) #\space (code-char x))) (progn (pt-attrs pt)))) flag) + (let ((s (map 'string + #'(lambda (x) + (if (eql x #/U+000a) + #\space + (rune-char x))) + (progn (pt-attrs pt)))) + flag) (if (and (> (- 120 (length prefix)) 0) (> (length s) (- 120 (length prefix)))) (setq s (concatenate 'string (subseq s 0 (- 120 (length prefix)))) @@ -188,7 +194,7 @@ value) (t (warn "~S: prop=~S." 'pt-attr prop) - (map 'string (lambda (x) (or (code-char x) #\?)) value))))) + (map 'string (lambda (x) (or (rune-char x) #\?)) value))))) (defun (setf pt-attr) (value pt prop) (setf (getf (pt-attrs pt) prop) value)) @@ -216,7 +222,7 @@ (cond ((typep tree 'rod) (sgml::make-pt :name :pcdata :attrs tree)) ((stringp tree) - (sgml::make-pt :name :pcdata :attrs (map '(vector (unsigned-byte 16)) #'char-code tree))) + (sgml::make-pt :name :pcdata :attrs (string-rod tree))) ((sgml::pt-p tree) tree) ((and (consp tree) (keywordp (car tree))) (let ((attrs nil)

1 0

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv15409 Modified Files: closure.asd Log Message: Based on the assumption that (and cmucl pthread) is actually code for Scieneer CL, rename dep-cmucl-dtc to dep-scl. --- /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:00:03 1.10 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:11:44 1.11 @@ -68,9 +68,9 @@ ((:file dependent :pathname #+CLISP "dep-clisp" - #+(AND :CMU (NOT :PTHREAD)) "dep-cmucl" + #+(AND :CMU (NOT SCL)) "dep-cmucl" #+sbcl "dep-sbcl" - #+(AND :CMU :PTHREAD) "dep-cmucl-dtc" + #+SCL "dep-scl" #+ALLEGRO "dep-acl" #+GCL "dep-gcl" #+OPENMCL "dep-openmcl"

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

closure-cvs December 2006