closure-cvs

closure-cvs@common-lisp.net

208 discussions

[closure-cvs] CVS closure/src/parse
by dlichteblau 07 Jul '07

07 Jul '07

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv31723/src/parse Modified Files: sgml-parse.lisp Log Message: Umlaute raus! --- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2007/01/21 15:25:27 1.7 +++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2007/07/07 15:03:56 1.8 @@ -187,7 +187,7 @@ (defsubst sloopy-name-rune-p (char) (or (name-rune-p char) (rune= char #/%) - (rune= char #//) ;manche schreiben ganze urls ohne Gänsefüßchen + (rune= char #//) ;manche schreiben ganze urls ohne Gaensefuesschen (rune= char #/:) (rune= char #/~) (rune= char #/#) ;farben werden auch gerne genommen

1 0

[closure-cvs] CVS closure/src/css
by dlichteblau 07 Jul '07

07 Jul '07

Update of /project/closure/cvsroot/closure/src/css In directory clnet:/tmp/cvs-serv31723/src/css Modified Files: css-properties.lisp css-selector.lisp Log Message: Umlaute raus! --- /project/closure/cvsroot/closure/src/css/css-properties.lisp 2005/03/13 18:00:58 1.8 +++ /project/closure/cvsroot/closure/src/css/css-properties.lisp 2007/07/07 15:03:56 1.9 @@ -4,7 +4,7 @@ ;;; Created: 1998-02-08 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: css-properties.lisp,v 1.8 2005/03/13 18:00:58 gbaumann Exp $ +;;; $Id: css-properties.lisp,v 1.9 2007/07/07 15:03:56 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1998-2002 by Gilbert Baumann @@ -54,7 +54,7 @@ (defparameter *normal-line-height* '1.2) (defparameter *initial-font-family* '("times")) (defparameter *initial-color* '"#000") -;; 3/2 ist eigentlich etwas bißchen heftig! +;; 3/2 ist eigentlich etwas bisschen heftig! (defparameter *font-scaling-factor* 3/2) (defparameter *medium-font-size* '(:pt . 12)) @@ -597,7 +597,7 @@ ;; wir koennten jedoch sehr leicht auch noch union(...), ;; intersection(...), difference(...), ;; everything, nothing -;; anbieten. (Könnten wir aus Spaß ja mal machen). +;; anbieten. (Koennten wir aus Spass ja mal machen). ;;; ------------------------------------------------------------------------------------------ @@ -942,6 +942,9 @@ ;; $Log: css-properties.lisp,v $ +;; Revision 1.9 2007/07/07 15:03:56 dlichteblau +;; Umlaute raus! +;; ;; Revision 1.8 2005/03/13 18:00:58 gbaumann ;; Gross license change ;; --- /project/closure/cvsroot/closure/src/css/css-selector.lisp 2006/12/29 21:29:24 1.8 +++ /project/closure/cvsroot/closure/src/css/css-selector.lisp 2007/07/07 15:03:56 1.9 @@ -149,7 +149,7 @@ ;; Diese ganze explicite Unterscheidung zwischen Author/User/Default ;; ist mir etwas zu speziell. (grade bei !important wird das alles -;; doch etwas merkwürdig!). +;; doch etwas merkwuerdig!). (defun find-style (sheet element implicit-style &optional (origin 0) (p 0)

1 0

[closure-cvs] CVS closure/src/net
by dlichteblau 07 Jul '07

07 Jul '07

Update of /project/closure/cvsroot/closure/src/net In directory clnet:/tmp/cvs-serv31657/src/net Modified Files: http.lisp Log Message: build fix for clisp --- /project/closure/cvsroot/closure/src/net/http.lisp 2007/01/02 14:30:11 1.12 +++ /project/closure/cvsroot/closure/src/net/http.lisp 2007/07/07 15:03:08 1.13 @@ -738,7 +738,7 @@ #+CLISP (defun is-directory-p (pathname) - (ignore-errors (lisp:probe-directory pathname))) + (ignore-errors (ext:probe-directory pathname))) #+CMU (defun is-directory-p (pathname)

1 0

[closure-cvs] CVS closure/src/patches
by dlichteblau 07 Jul '07

07 Jul '07

Update of /project/closure/cvsroot/closure/src/patches In directory clnet:/tmp/cvs-serv31597/src/patches Modified Files: clx-patch.lisp Log Message: build fix for clisp --- /project/closure/cvsroot/closure/src/patches/clx-patch.lisp 2005/08/25 15:14:15 1.5 +++ /project/closure/cvsroot/closure/src/patches/clx-patch.lisp 2007/07/07 15:02:53 1.6 @@ -157,7 +157,7 @@ (let ((input nil)) (unwind-protect (progn - (setf input (lisp:make-pipe-input-stream "hostname")) + (setf input (ext:make-pipe-input-stream "hostname")) (ignore-errors (read-line input))) (when input (close input))))) @@ -277,6 +277,6 @@ #+CLISP (progn (defun process-block (whostate predicate &rest predicate-args) - (apply #'mp::process-wait whostate predicate predicate-args))) + (apply #'clim-sys:process-wait whostate predicate predicate-args)))

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 07 Jul '07

07 Jul '07

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv23275 Modified Files: dep-clisp.lisp Log Message: fixed build on clisp --- /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2007/01/02 13:12:58 1.8 +++ /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2007/07/07 14:22:38 1.9 @@ -28,8 +28,6 @@ (in-package :CL-USER) -(setq lisp:*load-paths* '(#P"./")) - (defmacro glisp::with-timeout ((&rest ignore) &body body) (declare (ignore ignore)) `(progn @@ -46,8 +44,8 @@ (error "What is the string element type of the day?"))) options)) -(defun glisp:run-unix-shell-command (command) - (lisp:shell command)) +(defun glisp::run-unix-shell-command (command) + (ext:shell command)) (export 'glisp::getenv :glisp) (defun glisp::getenv (var)

1 0

[closure-cvs] CVS closure/src/gui
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv25374/src/gui Modified Files: clim-gui.lisp Log Message: Patch by Christophe Rhodes on closure-devel <87ejk2sngi.fsf(a)cantab.net> --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/06/30 14:00:04 1.32 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/07/01 12:16:43 1.33 @@ -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.32 2007/06/30 14:00:04 dlichteblau Exp $ +;;; $Id: clim-gui.lisp,v 1.33 2007/07/01 12:16:43 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,9 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.33 2007/07/01 12:16:43 dlichteblau +;; Patch by Christophe Rhodes on closure-devel <87ejk2sngi.fsf(a)cantab.net> +;; ;; Revision 1.32 2007/06/30 14:00:04 dlichteblau ;; New argument new-process to run-closure, which can be disabled to run ;; closure in a "blocking" mode. Needed for clbuild, which wants to (quit) @@ -579,7 +582,7 @@ (send-closure-command 'com-quit)))) (defvar *closure-inited-p* nil) -(defmethod clim:read-frame-command :before ((frame closure) +(defmethod clim:run-frame-top-level :before ((frame closure) &key &allow-other-keys) (unless *closure-inited-p* (setf *closure-inited-p* t)))

1 0

[closure-cvs] CVS closure/src/renderer
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv25374/src/renderer Modified Files: renderer2.lisp Log Message: Patch by Christophe Rhodes on closure-devel <87ejk2sngi.fsf(a)cantab.net> --- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2007/01/05 23:10:33 1.19 +++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2007/07/01 12:16:44 1.20 @@ -4,7 +4,7 @@ ;;; Created: somewhen late 2002 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: renderer2.lisp,v 1.19 2007/01/05 23:10:33 emarsden Exp $ +;;; $Id: renderer2.lisp,v 1.20 2007/07/01 12:16:44 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -1196,7 +1196,7 @@ (defun format-block (item x1 x2 ss before-markers #||# pos-vertical-margin neg-vertical-margin yy) (let (res) (setf (block-box-output-record item) - (clim:with-new-output-record (clim-user::*pane*) foo + (clim:with-new-output-record (clim-user::*pane*) #+nil foo (setf res (multiple-value-list (case (cooked-style-display (block-box-style item)) @@ -4983,6 +4983,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.20 2007/07/01 12:16:44 dlichteblau +;; Patch by Christophe Rhodes on closure-devel <87ejk2sngi.fsf(a)cantab.net> +;; ;; Revision 1.19 2007/01/05 23:10:33 emarsden ;; Fix rendering of preformatted content. ;;

1 0

[closure-cvs] CVS closure/src/gui
by dlichteblau 30 Jun '07

30 Jun '07

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv4927 Modified Files: clim-gui.lisp Log Message: New argument new-process to run-closure, which can be disabled to run closure in a "blocking" mode. Needed for clbuild, which wants to (quit) after the application is done. --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/02/04 15:10:01 1.31 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/06/30 14:00:04 1.32 @@ -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.31 2007/02/04 15:10:01 dlichteblau Exp $ +;;; $Id: clim-gui.lisp,v 1.32 2007/06/30 14:00:04 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,11 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.32 2007/06/30 14:00:04 dlichteblau +;; New argument new-process to run-closure, which can be disabled to run +;; closure in a "blocking" mode. Needed for clbuild, which wants to (quit) +;; after the application is done. +;; ;; Revision 1.31 2007/02/04 15:10:01 dlichteblau ;; Tabbed browsing. ;; @@ -587,7 +592,7 @@ (clim-sys:process-wait "Waiting for closure init" (lambda () *closure-inited-p*))))) -(defun run-closure () +(defun run-closure (&key (new-process t)) ;; Care for proxy (let* ((proxy (glisp:getenv "http_proxy")) (url (and proxy (url:parse-url proxy)))) @@ -618,17 +623,20 @@ :huge 24)) (gui::init-closure) ;; - (setf *closure-process* - (clim-sys:make-process - (lambda () - (unwind-protect - (progn - (setf *frame* (make-application-frame 'closure)) - (setf *pane* nil) - (run-frame-top-level *frame*)) - (ignore-errors (ws/netlib::commit-cache)) - (setf *closure-process* nil))) - :name "Closure"))) + (flet ((run-frame () + (unwind-protect + (progn + (setf *frame* (make-application-frame 'closure)) + (setf *pane* nil) + (run-frame-top-level *frame*)) + (ignore-errors (ws/netlib::commit-cache)) + (setf *closure-process* nil)))) + (cond (new-process + (setf *closure-process* + (clim-sys:make-process #'run-frame :name "Closure"))) + (t + (setf *closure-process* (clim-sys:current-process)) + (run-frame))))) (defun write-status (string) (window-clear (find-pane-named *frame* 'status))

1 0

[closure-cvs] CVS closure/src/gui
by dlichteblau 04 Feb '07

04 Feb '07

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv30785/src/gui Modified Files: clim-gui.lisp Log Message: Tabbed browsing. --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/01/07 19:32:06 1.30 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/02/04 15:10:01 1.31 @@ -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.30 2007/01/07 19:32:06 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.31 2007/02/04 15:10:01 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,9 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.31 2007/02/04 15:10:01 dlichteblau +;; Tabbed browsing. +;; ;; Revision 1.30 2007/01/07 19:32:06 emarsden ;; Follow HTTP redirects (HTML-level redirects still not supported). ;; @@ -182,14 +185,31 @@ (defvar *back-history* nil) (defvar *forw-history* nil) +(defun make-canvas (&key (height 600) (min-height 600)) + (scrolling (:width 830 + :max-height 20000 + :scroll-bar :vertical + :height height + :min-height min-height) + (make-pane 'closure-pane + :height 2000 + :width 800 + :display-time nil))) + +(defmacro canvasly (&rest spacereqs) + `(let ((tabs + (clim-tab-layout:with-tab-layout + ('clim-tab-layout:tab-page :name 'tab-layout) + ("(Untitled)" + (make-canvas ,@spacereqs))))) + (assert *frame*) + (setf (slot-value *frame* 'tabs) tabs) + tabs)) + (define-application-frame closure () - () + ((tabs)) (:menu-bar menubar-command-table) (:panes - (canvas (make-pane 'closure-pane - :height 2000 - :width 800 - :display-time nil)) (aux :application :height 300 :width 300 @@ -229,9 +249,7 @@ (default (vertically () (spacing (:thickness 5) - (scrolling (:width 830 :height 600 :min-height 400 :max-height 20000 - :scroll-bar :vertical) - canvas)) + (canvasly :height 600 :min-height 400)) (spacing (:thickness 5) interactor) (horizontally (:height 80 :min-height 80 :max-height 80) @@ -241,9 +259,7 @@ (hidden-listener (vertically () (spacing (:thickness 5) - (scrolling (:width 830 :height 600 :min-height 600 :max-height 20000 - :scroll-bar :vertical) - canvas)) + (canvasly :height 600 :min-height 600)) (horizontally (:height 80 :min-height 80 :max-height 80) wholine 2 @@ -254,8 +270,7 @@ menu-bar (horizontally () (vertically () - (climi::scrolling (:width 830 :height 600 :min-height 400 :max-height 20000) - canvas)) ) + (canvasly :height 600 :min-height 400))) (horizontally () wholine 2 @@ -279,7 +294,8 @@ (make-command-table 'file-command-table :errorp nil - :menu '(("Quit" :command com-quit))) + :menu '(("New Tab" :command com-new-tab) + ("Quit" :command com-quit))) (make-command-table 'go-command-table :errorp nil @@ -351,11 +367,22 @@ (define-presentation-type r2::pt ()) (define-presentation-type r2::hyper-link ()) +(defun scroller-child (scroller) + (car (sheet-children + (find-if (lambda (x) (typep x 'climi::viewport-pane)) + (sheet-children scroller))))) + +(defun current-page () + (clim-tab-layout:tab-layout-enabled-page (slot-value *frame* 'tabs))) + +(defun current-pane () + (scroller-child (clim-tab-layout:tab-page-pane (current-page)))) + ;; renders LHTML as per http://opensource.franz.com/xmlutils/xmlutils-dist/phtml.htm (defun render-lhtml (location lhtml) (with-simple-restart (forget "Just forget rendering this page.") (let* ((*package* (find-package :r2)) - (*pane* (find-pane-named *frame* 'canvas)) + (*pane* (current-pane)) (*medium* (sheet-medium *pane*)) (device (make-instance 'closure/clim-device::clim-device :medium *pane*)) (doc (make-instance 'r2::document @@ -380,6 +407,10 @@ ;;;; Commands ;;;; +(define-closure-command (com-remove-tab :name t) + ((page 'clim-tab-layout:tab-page :prompt "Tab page" :gesture :delete)) + (clim-tab-layout:remove-page page)) + (define-closure-command (com-show-listener :name t) () (setf (sheet-enabled-p (sheet-parent (find-pane-named *application-frame* 'interactor))) t)) @@ -398,6 +429,14 @@ (let ((*standard-output* *trace-output*)) (foo url))) +(define-gesture-name :visit-in-new-tab :pointer-button-press (:middle)) + +(define-closure-command (com-visit-url-in-new-tab :name t) + ((url 'url :gesture :visit-in-new-tab)) + (com-new-tab) + (setf *pane* (current-pane)) + (com-visit-url url)) + (define-closure-command (com-reflow :name t) () (reflow)) @@ -438,6 +477,17 @@ (define-closure-command (com-quit :name t :keystroke (#\q :control)) () (frame-exit *application-frame*)) +(defvar *open-new-tabs-in-background* nil) + +(define-closure-command (com-new-tab :name t :keystroke (#\t :control)) () + (with-look-and-feel-realization + ((frame-manager *application-frame*) *application-frame*) + (clim-tab-layout:add-page (make-instance 'clim-tab-layout:tab-page + :title "(Untitled)" + :pane (make-canvas)) + (slot-value *frame* 'tabs) + (not *open-new-tabs-in-background*)))) + (defun make-google-search-url (string) (url:merge-url (url:make-url :query (list @@ -574,7 +624,7 @@ (unwind-protect (progn (setf *frame* (make-application-frame 'closure)) - (setf *pane* (find-pane-named *frame* 'canvas)) + (setf *pane* nil) (run-frame-top-level *frame*)) (ignore-errors (ws/netlib::commit-cache)) (setf *closure-process* nil))) @@ -598,7 +648,7 @@ (lambda () (with-simple-restart (forget "Just forget rendering this page.") (let* ((*package* (find-package :r2)) - (*pane* (find-pane-named *frame* 'canvas))) + (*pane* (current-pane))) (with-sheet-medium (*medium* *pane*) (let ((device (make-instance 'closure/clim-device::clim-device :medium *pane*))) (setf (sheet-pointer-cursor *pane*) :busy) @@ -635,6 +685,8 @@ 600 ;xxx width t ;? 0) + (setf (clim-tab-layout:tab-page-title (current-page)) + (renderer::document-title *current-document*)) (write-wholine (format nil "Title: ~A~%~@[Modified: ~A~]" (renderer::document-title *current-document*) (or (netlib::get-header-field header :last-modified) @@ -656,7 +708,7 @@ (lambda () (with-simple-restart (forget "Just forget rendering this page.") (let ((*package* (find-package :r2)) - (*pane* (find-pane-named *frame* 'canvas))) + (*pane* (current-pane))) (window-clear *pane*) (with-sheet-medium (*medium* *pane*) (write-status "Rendering ...") @@ -717,7 +769,7 @@ (define-closure-command (com-page-up :name t :keystroke :prior) () - (let* ((pane (find-pane-named *frame* 'canvas)) + (let* ((pane (current-pane)) (scrollbar (slot-value (pane-scroller pane) 'climi::vscrollbar)) (current-y (gadget-value scrollbar)) (window-height (bounding-rectangle-height (pane-viewport-region pane)))) @@ -725,7 +777,7 @@ (define-closure-command (com-page-down :name t :keystroke :next) () - (let* ((pane (find-pane-named *frame* 'canvas)) + (let* ((pane (current-pane)) (scrollbar (slot-value (pane-scroller pane) 'climi::vscrollbar)) (current-y (gadget-value scrollbar)) (window-height (bounding-rectangle-height (pane-viewport-region pane)))) @@ -734,18 +786,18 @@ (define-closure-command (com-beginning-of-page :name t :keystroke (:home :control)) () - (let* ((pane (find-pane-named *frame* 'canvas)) + (let* ((pane (current-pane)) (scrollbar (slot-value (pane-scroller pane) 'climi::vscrollbar))) (scroll-extent pane 0 (gadget-min-value scrollbar)))) (define-closure-command (com-end-of-page :name t :keystroke (:end :control)) () - (let* ((pane (find-pane-named *frame* 'canvas)) + (let* ((pane (current-pane)) (scrollbar (slot-value (pane-scroller pane) 'climi::vscrollbar))) (scroll-extent pane 0 (gadget-max-value scrollbar)))) (define-closure-command (com-redraw :name t :keystroke (#\r :control)) () - (let* ((*pane* (find-pane-named *frame* 'canvas)) ) + (let* ((*pane* (current-pane))) (handle-repaint *pane* (sheet-region (pane-viewport *pane*)))) (clim-backend:port-force-output (find-port)))

1 0

[closure-cvs] CVS closure/src/parse
by dlichteblau 21 Jan '07

21 Jan '07

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv17861 Modified Files: sgml-parse.lisp Log Message: rune fix --- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2006/12/31 12:05:33 1.6 +++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2007/01/21 15:25:27 1.7 @@ -961,9 +961,9 @@ (sgml::find-element dtd name nil nil))) (defun foofoo (r) - (cond ((integerp r) (map 'rod #'char-code (prin1-to-string r))) - ((symbolp r) (map 'rod #'char-code (princ-to-string r))) - ((stringp r) (map 'rod #'char-code r)) + (cond ((integerp r) (string-rod (prin1-to-string r))) + ((symbolp r) (string-rod (princ-to-string r))) + ((stringp r) (string-rod r)) (t (error "foofoo: Hmm ~S ?!" r))))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

closure-cvs