phemlock-cvs

Download

phemlock-cvs@common-lisp.net

December 2004

3 participants
12 discussions

[Phemlock-cvs] CVS update: phemlock/src/core/htext2.lisp
by crhodes＠common-lisp.net 15 Dec '04

15 Dec '04

Update of /project/phemlock/cvsroot/phemlock/src/core In directory common-lisp.net:/tmp/cvs-serv9153/src/core Modified Files: htext2.lisp Log Message: Make %print-before-mark and %print-after-mark always work, even on open lines. Date: Wed Dec 15 13:13:26 2004 Author: crhodes Index: phemlock/src/core/htext2.lisp diff -u phemlock/src/core/htext2.lisp:1.3 phemlock/src/core/htext2.lisp:1.4 --- phemlock/src/core/htext2.lisp:1.3 Tue Aug 10 14:47:07 2004 +++ phemlock/src/core/htext2.lisp Wed Dec 15 13:13:26 2004 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; #+CMU (ext:file-comment - "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext2.lisp,v 1.3 2004/08/10 12:47:07 rstrandh Exp $") + "$Header: /project/phemlock/cvsroot/phemlock/src/core/htext2.lisp,v 1.4 2004/12/15 12:13:26 crhodes Exp $") ;;; ;;; ********************************************************************** ;;; @@ -371,47 +371,49 @@ (defun %print-before-mark (mark stream) (if (mark-line mark) - (let* ((line (mark-line mark)) - (chars (line-chars line)) - (charpos (mark-charpos mark)) - (length (line-length line))) - (declare (simple-string chars)) - (cond ((or (> charpos length) (< charpos 0)) - (write-string "{bad mark}" stream)) - ((eq line open-line) - (cond ((< charpos left-open-pos) - (write-string open-chars stream :end charpos)) - (t - (write-string open-chars stream :end left-open-pos) - (let ((p (+ charpos (- right-open-pos left-open-pos)))) - (write-string open-chars stream :start right-open-pos - :end p))))) - (t - (write-string chars stream :end charpos)))) + (let ((line (mark-line mark)) + (charpos (mark-charpos mark))) + (cond + ((eq line open-line) + (cond ((< charpos left-open-pos) + (write-string open-chars stream :end charpos)) + (t + (write-string open-chars stream :end left-open-pos) + (let ((p (+ charpos (- right-open-pos left-open-pos)))) + (write-string open-chars stream :start right-open-pos + :end p))))) + (t (let ((chars (line-chars line)) + (length (line-length line))) + (declare (simple-string chars)) + (cond ((or (> charpos length) (< charpos 0)) + (write-string "{bad mark}" stream)) + (t + (write-string chars stream :end charpos))))))) (write-string "{deleted mark}" stream))) (defun %print-after-mark (mark stream) (if (mark-line mark) - (let* ((line (mark-line mark)) - (chars (line-chars line)) - (charpos (mark-charpos mark)) - (length (line-length line))) - (declare (simple-string chars)) - (cond ((or (> charpos length) (< charpos 0)) - (write-string "{bad mark}" stream)) - ((eq line open-line) - (cond ((< charpos left-open-pos) - (write-string open-chars stream :start charpos - :end left-open-pos) - (write-string open-chars stream :start right-open-pos - :end line-cache-length)) - (t - (let ((p (+ charpos (- right-open-pos left-open-pos)))) - (write-string open-chars stream :start p - :end line-cache-length))))) - (t - (write-string chars stream :start charpos :end length)))) + (let ((line (mark-line mark)) + (charpos (mark-charpos mark))) + (cond + ((eq line open-line) + (cond ((< charpos left-open-pos) + (write-string open-chars stream :start charpos + :end left-open-pos) + (write-string open-chars stream :start right-open-pos + :end line-cache-length)) + (t + (let ((p (+ charpos (- right-open-pos left-open-pos)))) + (write-string open-chars stream :start p + :end line-cache-length))))) + (t (let ((chars (line-chars line)) + (length (line-length line))) + (declare (simple-string chars)) + (cond ((or (> charpos length) (< charpos 0)) + (write-string "{bad mark}" stream)) + (t + (write-string chars stream :start charpos :end length))))))) (write-string "{deleted mark}" stream))) (defmethod print-object ((structure line) stream)

1 0

[Phemlock-cvs] CVS update: phemlock/INSTALL phemlock/hemlock.asd phemlock/hemlock.system
by abakic＠common-lisp.net 15 Dec '04

15 Dec '04

Update of /project/phemlock/cvsroot/phemlock In directory common-lisp.net:/tmp/cvs-serv7398 Modified Files: INSTALL hemlock.asd hemlock.system Log Message: A pathname fix in hemlock.asd, and a minor improvement in INSTALL. Date: Wed Dec 15 01:51:37 2004 Author: abakic Index: phemlock/INSTALL diff -u phemlock/INSTALL:1.4 phemlock/INSTALL:1.5 --- phemlock/INSTALL:1.4 Mon Nov 1 23:16:11 2004 +++ phemlock/INSTALL Wed Dec 15 01:51:35 2004 @@ -5,21 +5,21 @@ are lucky you just can fire up your Lisp and say CMUCL/MK: - ; (require 'defsystem) - (mk:load-system :hemlock) + ; (require '#:defsystem) + ; (load "../McCLIM/system.lisp") + (mk:load-system :hemlock) ; or (mk:compile-system :hemlock) SBCL/ASDF: ; (require 'asdf) ; (require 'sb-bsd-sockets) ; (asdf:oos 'asdf:load-op :clx) + ; (load "../McCLIM/system.lisp") (asdf:oos 'adsf:load-op :hemlock) (cl-user::hemlock) If you want to try the CLIM backend, which not yet is fully operational, try: - ; (load "../McCLIM/system.lisp") - ; (mk:load-system :clim-clx) ; CMUCL/MK, might already be a dependency ; (asdf:oos 'asdf:load-op :clim-clx) ; SBCL/ASDF (clim-hemlock::clim-hemlock) Index: phemlock/hemlock.asd diff -u phemlock/hemlock.asd:1.4 phemlock/hemlock.asd:1.5 --- phemlock/hemlock.asd:1.4 Mon Nov 22 22:38:06 2004 +++ phemlock/hemlock.asd Wed Dec 15 01:51:35 2004 @@ -67,7 +67,8 @@ ((:module core-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "core"))) + :directory '(:relative "src" "core")) + *hemlock-base-directory*) :components ((:file "package") ;; Lisp implementation specific stuff goes into one of the next @@ -83,7 +84,8 @@ (:module bitmap-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "bitmap"))) + :directory '(:relative "src" "bitmap")) + *hemlock-base-directory*) :depends-on (core-1) :components ((:file "keysym-defs") ; hmm. @@ -92,7 +94,8 @@ (:module core-2 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "core"))) + :directory '(:relative "src" "core")) + *hemlock-base-directory*) :depends-on (bitmap-1) :components ((:file "rompsite") @@ -122,7 +125,8 @@ (:module tty-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "tty"))) + :directory '(:relative "tty")) + *hemlock-base-directory*) :components (#+port-tty-termcap (:file "termcap") #+port-tty-tty-disp-rt (:file "tty-disp-rt") @@ -130,20 +134,23 @@ (:module root-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src"))) + :directory '(:relative "src")) + *hemlock-base-directory*) :depends-on (core-2) :components ((:file "pop-up-stream"))) (:module tty-2 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "tty"))) + :directory '(:relative "tty")) + *hemlock-base-directory*) :components (#+port-tty-tty-screen (:file "tty-screen"))) (:module root-2 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src"))) + :directory '(:relative "src")) + *hemlock-base-directory*) :depends-on (root-1) :components ((:file "font") @@ -154,7 +161,8 @@ (:module user-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "user"))) + :directory '(:relative "src" "user")) + *hemlock-base-directory*) :depends-on (root-2) :components ((:file "echocoms") @@ -215,7 +223,8 @@ (:module bitmap-2 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "bitmap"))) + :directory '(:relative "src" "bitmap")) + *hemlock-base-directory*) :depends-on (user-1) :components ((:file "rompsite") @@ -226,7 +235,8 @@ (:module clim-1 :pathname #.(merge-pathnames (make-pathname - :directory '(:relative "src" "clim"))) + :directory '(:relative "src" "clim")) + *hemlock-base-directory*) :depends-on (bitmap-2) :components ((:file "patch") Index: phemlock/hemlock.system diff -u phemlock/hemlock.system:1.4 phemlock/hemlock.system:1.5 --- phemlock/hemlock.system:1.4 Sat Oct 16 21:28:19 2004 +++ phemlock/hemlock.system Wed Dec 15 01:51:35 2004 @@ -211,5 +211,5 @@ :depends-on (bitmap-2) :components ((:file "patch") - (:file "foo") + #+port-clim-foo (:file "foo") (:file "exp-syntax")))))

1 0