climacs-cvs May 2006

climacs-cvs@common-lisp.net

3 participants
68 discussions

[climacs-cvs] CVS esa
by crhodes 10 May '06

10 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv29181 Added Files: .cvsignore Log Message: cvsignore *.fasl --- /project/climacs/cvsroot/esa/.cvsignore 2006/05/10 09:36:15 NONE +++ /project/climacs/cvsroot/esa/.cvsignore 2006/05/10 09:36:15 1.1 *.fasl

1 0

[climacs-cvs] CVS esa
by crhodes 10 May '06

10 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv18087 Modified Files: esa.lisp Log Message: implement numeric arguments for keyboard macros --- /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 18:32:38 1.12 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/05/10 08:41:49 1.13 @@ -804,14 +804,15 @@ (define-command (com-call-last-kbd-macro :name t :command-table keyboard-macro-table) - () + ((count 'integer :prompt "How many times?")) "Run the last keyboard macro that was defined. Use C-x ( to start and C-x ) to finish recording a keyboard macro." (setf (remaining-keys *application-frame*) - (recorded-keys *application-frame*)) + (loop repeat count append (recorded-keys *application-frame*))) (setf (executingp *application-frame*) t)) -(set-key 'com-call-last-kbd-macro 'keyboard-macro-table '((#\x :control) #\e)) +(set-key `(com-call-last-kbd-macro ,*numeric-argument-marker*) + 'keyboard-macro-table '((#\x :control) #\e)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS climacs
by dmurray 07 May '06

07 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv28753 Modified Files: file-commands.lisp Log Message: find-file now takes an optional readonlyp argument, meaning find-file-read-only (which had got out of sync/date) can go. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 15:40:47 1.14 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/07 20:11:20 1.15 @@ -228,7 +228,7 @@ (and (or (null name) (eql name :unspecific)) (or (null type) (eql type :unspecific))))) -(defun find-file (filepath) +(defun find-file (filepath &optional readonlyp) (cond ((null filepath) (display-message "No file name given.") (beep)) @@ -238,38 +238,45 @@ (t (let ((existing-buffer (find filepath (buffers *application-frame*) :key #'filepath :test #'equal))) - (if existing-buffer + (if (and existing-buffer (if readonlyp (read-only-p existing-buffer) t)) (switch-to-buffer existing-buffer) - (let ((buffer (make-buffer)) - (pane (current-window))) - ;; Clear the pane's cache; otherwise residue from the - ;; previously displayed buffer may under certain - ;; circumstances be displayed. - (clear-cache pane) - (setf (syntax buffer) nil) - (setf (offset (point (buffer pane))) (offset (point pane))) - (setf (buffer (current-window)) buffer) - ;; Don't want to create the file if it doesn't exist. - (when (probe-file filepath) - (with-open-file (stream filepath :direction :input) - (input-from-stream stream buffer 0)) - (setf (file-write-time buffer) (file-write-date filepath)) - ;; A file! That means we may have a local options - ;; line to parse. - (evaluate-attributes-line buffer)) - ;; If the local options line didn't set a syntax, do - ;; it now. - (when (null (syntax buffer)) - (setf (syntax buffer) - (make-instance (syntax-class-name-for-filepath filepath) - :buffer buffer))) - (setf (filepath buffer) filepath - (name buffer) (filepath-filename filepath) - (needs-saving buffer) nil) - (beginning-of-buffer (point pane)) - (update-syntax buffer (syntax buffer)) - (clear-modify buffer) - buffer)))))) + (progn + (when readonlyp + (unless (probe-file filepath) + (beep) + (display-message "No such file: ~A" filepath) + (return-from find-file nil))) + (let ((buffer (make-buffer)) + (pane (current-window))) + ;; Clear the pane's cache; otherwise residue from the + ;; previously displayed buffer may under certain + ;; circumstances be displayed. + (clear-cache pane) + (setf (syntax buffer) nil) + (setf (offset (point (buffer pane))) (offset (point pane))) + (setf (buffer (current-window)) buffer) + ;; Don't want to create the file if it doesn't exist. + (when (probe-file filepath) + (with-open-file (stream filepath :direction :input) + (input-from-stream stream buffer 0)) + (setf (file-write-time buffer) (file-write-date filepath)) + ;; A file! That means we may have a local options + ;; line to parse. + (evaluate-attributes-line buffer)) + ;; If the local options line didn't set a syntax, do + ;; it now. + (when (null (syntax buffer)) + (setf (syntax buffer) + (make-instance (syntax-class-name-for-filepath filepath) + :buffer buffer))) + (setf (filepath buffer) filepath + (name buffer) (filepath-filename filepath) + (needs-saving buffer) nil + (read-only-p buffer) readonlyp) + (beginning-of-buffer (point pane)) + (update-syntax buffer (syntax buffer)) + (clear-modify buffer) + buffer))))))) (defun directory-of-buffer (buffer) "Extract the directory part of the filepath to the file in BUFFER. @@ -294,42 +301,6 @@ 'buffer-table '((#\x :control) (#\f :control))) -(defun find-file-read-only (filepath) - (cond ((null filepath) - (display-message "No file name given.") - (beep)) - ((directory-pathname-p filepath) - (display-message "~A is a directory name." filepath) - (beep)) - (t - (let ((existing-buffer (find filepath (buffers *application-frame*) - :key #'filepath :test #'equal))) - (if (and existing-buffer (read-only-p existing-buffer)) - (switch-to-buffer existing-buffer) - (if (probe-file filepath) - (let ((buffer (make-buffer)) - (pane (current-window))) - (setf (offset (point (buffer pane))) (offset (point pane))) - (setf (buffer (current-window)) buffer) - (setf (syntax buffer) - (make-instance (syntax-class-name-for-filepath filepath) - :buffer (buffer (point pane)))) - (with-open-file (stream filepath :direction :input) - (input-from-stream stream buffer 0)) - (setf (filepath buffer) filepath - (name buffer) (filepath-filename filepath) - (needs-saving buffer) nil - (read-only-p buffer) t) - (beginning-of-buffer (point pane)) - ;; this one is needed so that the buffer modification protocol - ;; resets the low and high marks after redisplay - (redisplay-frame-panes *application-frame*) - buffer) - (progn - (display-message "No such file: ~A" filepath) - (beep) - nil))))))) - (define-command (com-find-file-read-only :name t :command-table buffer-table) () "Prompt for a filename then open that file readonly. If a buffer is already visiting that file, switch to that buffer. If the filename given does not name an existing file, signal an error." @@ -337,7 +308,7 @@ :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname :insert-default t))) - (find-file-read-only filepath))) + (find-file filepath t))) (set-key 'com-find-file-read-only 'buffer-table

1 0

[climacs-cvs] CVS climacs
by dmurray 07 May '06

07 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv23067 Modified Files: pane.lisp Log Message: Added the missing cases to highlight-region. --- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 20:40:10 1.40 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/07 06:40:19 1.41 @@ -615,6 +615,24 @@ (multiple-value-bind (mark-x mark-y) (offset-to-screen-position offset2 pane) (cond + ;; mark and point are above the screen + ((and (null cursor-y) (null mark-y) + (null cursor-x) (null mark-x)) + nil) + ;; mark and point are below the screen + ((and (null cursor-y) (null mark-y) + cursor-x mark-x) + nil) + ;; mark or point is above the screen, and point or mark below it + ((and (null cursor-y) (null mark-y) + (or (and cursor-x (null mark-x)) + (and (null cursor-x) mark-y))) + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + 0 0 + (stream-text-margin pane) (bounding-rectangle-height + (window-viewport pane)) + :ink ink))) ;; mark is above the top of the screen ((and (null mark-y) (null mark-x)) (updating-output (pane :unique-id -3)

1 0

[climacs-cvs] CVS climacs
by dmurray 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv15173 Modified Files: pane.lisp Log Message: Generalised region highlighting. There is now a (as yet unexported) gf in pane.lisp that will highlight between two points (marks or offsets) in a buffer, with a given ink: highlight-region pane mark1 offset2 &optional ink --- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 19:51:04 1.39 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 20:40:10 1.40 @@ -601,10 +601,19 @@ (defgeneric display-region (pane syntax)) (defmethod display-region ((pane climacs-pane) (syntax basic-syntax)) + (highlight-region pane (point pane) (mark pane))) + +(defgeneric highlight-region (pane mark1 offset2 &optional ink)) + +(defmethod highlight-region ((pane climacs-pane) (offset1 integer) (offset2 integer) + &optional (ink (compose-in +green+ (make-opacity .1)))) + ;; FIXME stream-vertical-spacing between lines + ;; FIXME note sure updating output is working properly... + ;; we'll call offset1 CURSOR and offset2 MARK (multiple-value-bind (cursor-x cursor-y line-height) - (offset-to-screen-position (offset (point pane)) pane) + (offset-to-screen-position offset1 pane) (multiple-value-bind (mark-x mark-y) - (offset-to-screen-position (offset (mark pane)) pane) + (offset-to-screen-position offset2 pane) (cond ;; mark is above the top of the screen ((and (null mark-y) (null mark-x)) @@ -612,13 +621,11 @@ (draw-rectangle* pane 0 0 (stream-text-margin pane) cursor-y - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane 0 cursor-y cursor-x (+ cursor-y line-height) - :ink (compose-in +green+ - (make-opacity .1))))) + :ink ink))) ;; mark is below the bottom of the screen ((and (null mark-y) mark-x) (updating-output (pane :unique-id -3) @@ -626,13 +633,11 @@ 0 (+ cursor-y line-height) (stream-text-margin pane) (bounding-rectangle-height (window-viewport pane)) - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane cursor-x cursor-y (stream-text-margin pane) (+ cursor-y line-height) - :ink (compose-in +green+ - (make-opacity .1))))) + :ink ink))) ;; mark is at point ((and (= mark-x cursor-x) (= mark-y cursor-y)) nil) @@ -642,44 +647,49 @@ (draw-rectangle* pane mark-x mark-y cursor-x (+ cursor-y line-height) - :ink (compose-in +green+ - (make-opacity .1))))) + :ink ink))) ;; mark and point are both visible, mark above point ((< mark-y cursor-y) (updating-output (pane :unique-id -3) (draw-rectangle* pane mark-x mark-y (stream-text-margin pane) (+ mark-y line-height) - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane 0 cursor-y cursor-x (+ cursor-y line-height) - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane 0 (+ mark-y line-height) (stream-text-margin pane) cursor-y - :ink (compose-in +green+ - (make-opacity .1))))) + :ink ink))) ;; mark and point are both visible, point above mark (t (updating-output (pane :unique-id -3) (draw-rectangle* pane cursor-x cursor-y (stream-text-margin pane) (+ cursor-y line-height) - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane 0 mark-y mark-x (+ mark-y line-height) - :ink (compose-in +green+ - (make-opacity .1))) + :ink ink) (draw-rectangle* pane 0 (+ cursor-y line-height) (stream-text-margin pane) mark-y - :ink (compose-in +green+ - (make-opacity .1))))))))) + :ink ink))))))) + +(defmethod highlight-region ((pane climacs-pane) (mark1 mark) (mark2 mark) + &optional (ink (compose-in +green+ (make-opacity .1)))) + (highlight-region pane (offset mark1) (offset mark2) ink)) + +(defmethod highlight-region ((pane climacs-pane) (mark1 mark) (offset2 integer) + &optional (ink (compose-in +green+ (make-opacity .1)))) + (highlight-region pane (offset mark1) offset2 ink)) + +(defmethod highlight-region ((pane climacs-pane) (offset1 integer) (mark2 mark) + &optional (ink (compose-in +green+ (make-opacity .1)))) + (highlight-region pane offset1 (offset mark2) ink)) (defun offset-to-screen-position (offset pane) "Returns the position of offset as a screen position.

1 0

[climacs-cvs] CVS climacs
by dmurray 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv9866 Modified Files: cl-syntax.lisp fundamental-syntax.lisp html-syntax.lisp lisp-syntax.lisp misc-commands.lisp packages.lisp pane.lisp prolog-syntax.lisp slidemacs.lisp ttcn3-syntax.lisp Log Message: Changed mark-visibility to region visibility. Turn it on and off with Visible Region, for now. --- /project/climacs/cvsroot/climacs/cl-syntax.lisp 2006/03/03 19:38:57 1.17 +++ /project/climacs/cvsroot/climacs/cl-syntax.lisp 2006/05/06 19:51:04 1.18 @@ -1141,7 +1141,7 @@ do (let ((token (lexeme lexer start-token-index))) (display-parse-tree token syntax pane)) (incf start-token-index)))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p))) --- /project/climacs/cvsroot/climacs/fundamental-syntax.lisp 2005/08/15 23:31:22 1.2 +++ /project/climacs/cvsroot/climacs/fundamental-syntax.lisp 2006/05/06 19:51:04 1.3 @@ -185,7 +185,7 @@ :cache-value line :cache-test #'eq) (display-line pane (start-mark (element* lines i)))))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- /project/climacs/cvsroot/climacs/html-syntax.lisp 2005/08/15 23:31:22 1.32 +++ /project/climacs/cvsroot/climacs/html-syntax.lisp 2006/05/06 19:51:04 1.33 @@ -798,6 +798,6 @@ do (let ((token (lexeme lexer start-token-index))) (display-parse-tree token syntax pane)) (incf start-token-index)))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p))) --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 17:23:33 1.65 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 19:51:04 1.66 @@ -1590,7 +1590,7 @@ (let ((*current-faces* *standard-faces*)) (with-slots (stack-top) syntax (display-parse-tree stack-top syntax pane))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 15:38:42 1.10 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 19:51:04 1.11 @@ -1538,7 +1538,6 @@ 'marking-table '((#\h :control :meta))) -(define-command (com-visible-mark :name t :command-table marking-table) () - "Toggle the visibility of the mark in the current pane. -This is particularly (only?) useful for experimenting with marking commands." - (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window))))) +(define-command (com-visible-region :name t :command-table marking-table) () + "Toggle the visibility of the region in the current pane." + (setf (region-visible-p (current-window)) (not (region-visible-p (current-window))))) --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 06:27:14 1.92 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 19:51:04 1.93 @@ -152,7 +152,7 @@ #:clear-cache #:redisplay-pane #:full-redisplay #:display-cursor - #:display-mark + #:display-region #:page-down #:page-up #:top #:bot #:tab-space-count #:space-width #:tab-width @@ -163,7 +163,7 @@ #:isearch-mode #:isearch-states #:isearch-previous-string #:query-replace-state #:string1 #:string2 #:query-replace-mode - #:mark-visible-p + #:region-visible-p #:with-undo #:url #:climacs-textual-view #:+climacs-textual-view+)) --- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 06:27:14 1.38 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 19:51:04 1.39 @@ -280,7 +280,7 @@ (isearch-previous-string :initform nil :accessor isearch-previous-string) (query-replace-mode :initform nil :accessor query-replace-mode) (query-replace-state :initform nil :accessor query-replace-state) - (mark-visible-p :initform nil :accessor mark-visible-p) + (region-visible-p :initform nil :accessor region-visible-p) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil) @@ -564,7 +564,7 @@ (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax basic-syntax) current-p) (display-cache pane) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p)) (defgeneric redisplay-pane (pane current-p)) @@ -589,43 +589,118 @@ (defgeneric display-cursor (pane syntax current-p)) (defmethod display-cursor ((pane climacs-pane) (syntax basic-syntax) current-p) - (with-slots (top) pane - (let* ((cursor-line (number-of-lines-in-region top (point pane))) - (style (medium-text-style pane)) - (ascent (text-style-ascent style pane)) - (descent (text-style-descent style pane)) - (height (+ ascent descent)) - (cursor-y (+ (* cursor-line (+ height (stream-vertical-spacing pane))))) - (cursor-column - (buffer-display-column - (buffer (point pane)) (offset (point pane)) - (round (tab-width pane) (space-width pane)))) - (cursor-x (* cursor-column (text-style-width (medium-text-style pane) pane)))) + (let ((point (point pane))) + (multiple-value-bind (cursor-x cursor-y line-height) + (offset-to-screen-position (offset point) pane) (updating-output (pane :unique-id -1) (draw-rectangle* pane (1- cursor-x) cursor-y - (+ cursor-x 2) (+ cursor-y ascent descent) + (+ cursor-x 2) (+ cursor-y line-height) :ink (if current-p +red+ +blue+)))))) -(defgeneric display-mark (pane syntax)) +(defgeneric display-region (pane syntax)) -(defmethod display-mark ((pane climacs-pane) (syntax basic-syntax)) +(defmethod display-region ((pane climacs-pane) (syntax basic-syntax)) + (multiple-value-bind (cursor-x cursor-y line-height) + (offset-to-screen-position (offset (point pane)) pane) + (multiple-value-bind (mark-x mark-y) + (offset-to-screen-position (offset (mark pane)) pane) + (cond + ;; mark is above the top of the screen + ((and (null mark-y) (null mark-x)) + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + 0 0 + (stream-text-margin pane) cursor-y + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink (compose-in +green+ + (make-opacity .1))))) + ;; mark is below the bottom of the screen + ((and (null mark-y) mark-x) + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + (stream-text-margin pane) (bounding-rectangle-height + (window-viewport pane)) + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + cursor-x cursor-y + (stream-text-margin pane) (+ cursor-y line-height) + :ink (compose-in +green+ + (make-opacity .1))))) + ;; mark is at point + ((and (= mark-x cursor-x) (= mark-y cursor-y)) + nil) + ;; mark and point are on the same line + ((= mark-y cursor-y) + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + mark-x mark-y + cursor-x (+ cursor-y line-height) + :ink (compose-in +green+ + (make-opacity .1))))) + ;; mark and point are both visible, mark above point + ((< mark-y cursor-y) + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + mark-x mark-y + (stream-text-margin pane) (+ mark-y line-height) + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + 0 (+ mark-y line-height) + (stream-text-margin pane) cursor-y + :ink (compose-in +green+ + (make-opacity .1))))) + ;; mark and point are both visible, point above mark + (t + (updating-output (pane :unique-id -3) + (draw-rectangle* pane + cursor-x cursor-y + (stream-text-margin pane) (+ cursor-y line-height) + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + 0 mark-y + mark-x (+ mark-y line-height) + :ink (compose-in +green+ + (make-opacity .1))) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + (stream-text-margin pane) mark-y + :ink (compose-in +green+ + (make-opacity .1))))))))) + +(defun offset-to-screen-position (offset pane) + "Returns the position of offset as a screen position. +Returns X Y LINE-HEIGHT CHAR-WIDTH as values if offset is on the screen, +NIL if offset is before the beginning of the screen, +and T if offset is after the end of the screen." (with-slots (top bot) pane - (let ((mark (mark pane))) - (when (<= (offset top) (offset mark) (offset bot)) - (let* ((mark-line (number-of-lines-in-region top mark)) - (style (medium-text-style pane)) - (ascent (text-style-ascent style pane)) - (descent (text-style-descent style pane)) - (height (+ ascent descent)) - (mark-y (+ (* mark-line (+ height (stream-vertical-spacing pane))))) - (mark-column - (buffer-display-column - (buffer mark) (offset mark) - (round (tab-width pane) (space-width pane)))) - (mark-x (* mark-column (text-style-width (medium-text-style pane) pane)))) - (updating-output (pane :unique-id -2) - (draw-rectangle* pane - (1- mark-x) mark-y - (+ mark-x 2) (+ mark-y ascent descent) - :ink +green+))))))) \ No newline at end of file + (cond + ((< offset (offset top)) nil) + ((< (offset bot) offset) t) + (t + (let* ((line (number-of-lines-in-region top offset)) + (style (medium-text-style pane)) + (style-width (text-style-width style pane)) + (ascent (text-style-ascent style pane)) + (descent (text-style-descent style pane)) + (height (+ ascent descent)) + (y (+ (* line (+ height (stream-vertical-spacing pane))))) + (column + (buffer-display-column + (buffer pane) offset + (round (tab-width pane) (space-width pane)))) + (x (* column style-width))) + (values x y height style-width)))))) \ No newline at end of file --- /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/03/03 19:38:57 1.26 +++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/05/06 19:51:04 1.27 @@ -1310,7 +1310,7 @@ do (let ((token (lexeme lexer start-token-index))) (display-parse-tree token syntax pane)) (incf start-token-index)))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p))) #| --- /project/climacs/cvsroot/climacs/slidemacs.lisp 2006/03/03 19:38:57 1.8 +++ /project/climacs/cvsroot/climacs/slidemacs.lisp 2006/05/06 19:51:04 1.9 @@ -454,5 +454,5 @@ do (let ((token (lexeme lexer start-token-index))) (display-parse-tree token syntax pane)) (incf start-token-index)))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p))) --- /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/03/03 19:38:57 1.4 +++ /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/05/06 19:51:04 1.5 @@ -452,6 +452,6 @@ do (let ((token (lexeme lexer start-token-index))) (display-parse-tree token syntax pane)) (incf start-token-index)))))))) - (when (mark-visible-p pane) (display-mark pane syntax)) + (when (region-visible-p pane) (display-region pane syntax)) (display-cursor pane syntax current-p)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24921 Modified Files: lisp-syntax.lisp Log Message: Now calling `buffer-substring' and `token-string' instead of `buffer-subsequence'. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 11:57:23 1.64 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 17:23:33 1.65 @@ -1141,29 +1141,22 @@ (let ((package-name (typecase package-form (token-mixin - (coerce (buffer-sequence - buffer - (start-offset package-form) - (end-offset package-form)) - 'string)) + (token-string syntax package-form)) (complete-string-form - (coerce (buffer-sequence - buffer - (1+ (start-offset package-form)) - (1- (end-offset package-form))) - 'string)) + (buffer-substring + buffer + (1+ (start-offset package-form)) + (1- (end-offset package-form)))) (quote-form - (coerce (buffer-sequence - buffer - (start-offset (second-noncomment (children package-form))) - (end-offset (second-noncomment (children package-form)))) - 'string)) + (buffer-substring + buffer + (start-offset (second-noncomment (children package-form))) + (end-offset (second-noncomment (children package-form))))) (uninterned-symbol-form - (coerce (buffer-sequence - buffer - (start-offset (second-noncomment (children package-form))) - (end-offset (second-noncomment (children package-form)))) - 'string)) + (buffer-substring + buffer + (start-offset (second-noncomment (children package-form))) + (end-offset (second-noncomment (children package-form))))) (t 'nil)))) (when package-name (let ((package-symbol (parse-token package-name))) @@ -1430,10 +1423,7 @@ (defmethod display-parse-tree ((parse-symbol token-mixin) (syntax lisp-syntax) pane) (if (> (the fixnum (end-offset parse-symbol)) (the fixnum (start-offset parse-symbol))) - (let ((string (coerce (buffer-sequence (buffer syntax) - (start-offset parse-symbol) - (end-offset parse-symbol)) - 'string))) + (let ((string (token-string syntax parse-symbol))) (multiple-value-bind (symbol status) (token-to-object syntax parse-symbol) (with-output-as-presentation @@ -1471,10 +1461,7 @@ (with-slots (ink face) parser-symbol (setf ink (medium-ink (sheet-medium pane)) face (text-style-face (medium-text-style (sheet-medium pane)))) - (let ((string (coerce (buffer-sequence (buffer syntax) - (start-offset parser-symbol) - (end-offset parser-symbol)) - 'string))) + (let ((string (token-string syntax parser-symbol))) (present string 'string :stream pane)))))) (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) (syntax lisp-syntax) pane) @@ -1487,10 +1474,9 @@ (defmethod display-parse-tree ((parse-symbol complete-string-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) (if (third children) - (let ((string (coerce (buffer-sequence (buffer syntax) - (start-offset (second children)) - (end-offset (car (last children 2)))) - 'string))) + (let ((string (buffer-substring (buffer syntax) + (start-offset (second children)) + (end-offset (car (last children 2)))))) (with-output-as-presentation (pane string 'lisp-string :single-box :highlighting) (display-parse-tree (pop children) syntax pane) @@ -1504,10 +1490,9 @@ (defmethod display-parse-tree ((parse-symbol incomplete-string-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) (if (second children) - (let ((string (coerce (buffer-sequence (buffer syntax) - (start-offset (second children)) - (end-offset (car (last children)))) - 'string))) + (let ((string (buffer-substring (buffer syntax) + (start-offset (second children)) + (end-offset (car (last children)))))) (with-output-as-presentation (pane string 'lisp-string :single-box :highlighting) (display-parse-tree (pop children) syntax pane) @@ -1553,10 +1538,7 @@ "The KEYWORD package.") (defmethod eval-feature-conditional ((conditional token-mixin) (syntax lisp-syntax)) - (let* ((string (coerce (buffer-sequence (buffer syntax) - (start-offset conditional) - (end-offset conditional)) - 'string)) + (let* ((string (token-string syntax conditional)) (symbol (parse-symbol string :package +keyword-package+))) (member symbol *features*))) @@ -1572,10 +1554,7 @@ (remove-if #'(lambda (child) (typep child 'comment)) children)))) - (type-string (coerce (buffer-sequence (buffer syntax) - (start-offset type) - (end-offset type)) - 'string)) + (type-string (token-string syntax type)) (type-symbol (parse-symbol type-string :package +keyword-package+))) (case type-symbol (:and (funcall #'every #'eval-fc conditionals)) @@ -1781,10 +1760,7 @@ when (and (mark<= (start-offset form) mark) (mark<= mark (end-offset form))) do (return (eval (read-from-string - (coerce (buffer-sequence (buffer syntax) - (start-offset form) - (end-offset form)) - 'string))))))) + (token-string syntax form))))))) (defmethod beginning-of-definition (mark (syntax lisp-syntax)) (with-slots (stack-top) syntax @@ -1962,10 +1938,9 @@ (defun token-string (syntax token) "Return the string that specifies `token' in the buffer of `syntax'." - (coerce (buffer-sequence (buffer syntax) - (start-offset token) - (end-offset token)) - 'string)) + (buffer-substring (buffer syntax) + (start-offset token) + (end-offset token))) (defun parse-symbol (string &key (package *package*) (case (readtable-case *readtable*))) "Find the symbol named STRING.

1 0

[climacs-cvs] CVS climacs
by thenriksen 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv12519 Modified Files: file-commands.lisp Log Message: Fixed typo. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 15:38:42 1.13 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 15:40:47 1.14 @@ -486,7 +486,7 @@ (set-key 'com-save-buffer 'buffer-table -n '((#\x :control) (#\s :control))) + '((#\x :control) (#\s :control))) (defmethod frame-exit :around ((frame climacs) #-mcclim &key) (loop for buffer in (buffers frame)

1 0

[climacs-cvs] CVS climacs
by thenriksen 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv12374 Modified Files: misc-commands.lisp file-commands.lisp Log Message: Made `find-file' use `evaluate-attributes-line' and removed the now obsolete `com-reload-local-options-line'. --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/04 20:30:29 1.9 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 15:38:42 1.10 @@ -28,13 +28,6 @@ (in-package :climacs-gui) -(define-command (com-reload-local-options-line - :name t - :command-table buffer-table) - () - "Reload the local options line." - (evaluate-local-options-line (current-buffer))) - (define-command (com-overwrite-mode :name t :command-table editing-table) () "Toggle overwrite mode for the current mode. When overwrite is on, an object entered on the keyboard will replace the object after the point. When overwrite is off (the default), objects are inserted at point. In both cases point is positioned after the new object." --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 11:41:57 1.12 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 15:38:42 1.13 @@ -256,7 +256,7 @@ (setf (file-write-time buffer) (file-write-date filepath)) ;; A file! That means we may have a local options ;; line to parse. - (evaluate-local-options-line buffer)) + (evaluate-attributes-line buffer)) ;; If the local options line didn't set a syntax, do ;; it now. (when (null (syntax buffer)) @@ -486,7 +486,7 @@ (set-key 'com-save-buffer 'buffer-table - '((#\x :control) (#\s :control))) +n '((#\x :control) (#\s :control))) (defmethod frame-exit :around ((frame climacs) #-mcclim &key) (loop for buffer in (buffers frame)

1 0

[climacs-cvs] CVS climacs
by dmurray 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv12867 Modified Files: syntax.lisp lisp-syntax.lisp Log Message: Fixed some string-upcasing issues with my earlier changes. Made lisp-syntax accept attribute-line specified packages that aren't in the image yet (like IN-PACKAGE handling does). --- /project/climacs/cvsroot/climacs/syntax.lisp 2006/05/02 19:59:21 1.63 +++ /project/climacs/cvsroot/climacs/syntax.lisp 2006/05/06 11:57:23 1.64 @@ -218,7 +218,7 @@ (defmethod eval-option :around (syntax (name string) value) ;; Convert the name to a keyword symbol... - (eval-option syntax (intern name (find-package :keyword)) + (eval-option syntax (intern (string-upcase name) (find-package :keyword)) value)) (defmacro define-option-for-syntax --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/03 16:14:27 1.63 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 11:57:23 1.64 @@ -50,7 +50,7 @@ (option-specified-package :accessor option-specified-package :initform nil :documentation "The package - specified in the local options + specified in the attribute line (may be overridden by (in-package) forms).")) (:name "Lisp") @@ -59,8 +59,7 @@ (define-option-for-syntax lisp-syntax "Package" (syntax package-name) (let ((specified-package (find-package package-name))) - (when specified-package - (setf (option-specified-package syntax) specified-package)))) + (setf (option-specified-package syntax) (or specified-package package-name)))) (define-option-for-syntax lisp-syntax "Base" (syntax base) (let ((integer-base (parse-integer base :junk-allowed t)))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs May 2006