From nsiivola at common-lisp.net Sat Feb 28 11:32:05 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 28 Feb 2004 06:32:05 -0500 Subject: [Linedit-cvs] CVS update: src/command-functions.lisp src/editor.lisp src/utility-functions.lisp src/utility-macros.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv21472 Modified Files: command-functions.lisp editor.lisp utility-functions.lisp utility-macros.lisp version.lisp-expr Log Message: Fixed word-selection algorithms. Date: Sat Feb 28 06:32:05 2004 Author: nsiivola Index: src/command-functions.lisp diff -u src/command-functions.lisp:1.7 src/command-functions.lisp:1.8 --- src/command-functions.lisp:1.7 Mon Oct 20 14:14:31 2003 +++ src/command-functions.lisp Sat Feb 28 06:32:05 2004 @@ -59,7 +59,7 @@ (defun delete-word-backwards (chord editor) (declare (ignore chord)) (with-editor-point-and-string ((point string) editor) - (let ((i (editor-word-start editor))) + (let ((i (editor-previous-word-start editor))) (setf (get-string editor) (concat (subseq string 0 i) (subseq string point)) (get-point editor) i)))) @@ -72,10 +72,12 @@ (flet ((frob-case (frob editor) (with-editor-point-and-string ((point string) editor) - (let ((end (editor-word-end editor))) - (setf (get-string editor) (concat (subseq string 0 point) - (funcall frob (subseq string point end)) - (subseq string end)) + (let ((end (editor-next-word-end editor))) + (setf (get-string editor) (concat + (subseq string 0 point) + (funcall frob + (subseq string point end)) + (subseq string end)) (get-point editor) end))))) (defun upcase-word (chord editor) @@ -106,11 +108,11 @@ (defun move-word-backwards (chord editor) (declare (ignore chord)) - (setf (get-point editor) (editor-word-start editor))) + (setf (get-point editor) (editor-previous-word-start editor))) (defun move-word-forwards (chord editor) (declare (ignore chord)) - (setf (get-point editor) (editor-word-end editor))) + (setf (get-point editor) (editor-next-word-end editor))) ;;; UNDO Index: src/editor.lisp diff -u src/editor.lisp:1.10 src/editor.lisp:1.11 --- src/editor.lisp:1.10 Sun Nov 9 08:20:39 2003 +++ src/editor.lisp Sat Feb 28 06:32:05 2004 @@ -21,13 +21,15 @@ (in-package :linedit) -(defvar *version* #.(symbol-name - (with-open-file (f (merge-pathnames "version.lisp-expr" - *compile-file-truename*)) +(defvar *version* #.(symbol-name + (with-open-file (f (merge-pathnames + "version.lisp-expr" + *compile-file-truename*)) (read f)))) (defvar *history* nil) (defvar *killring* nil) +(defvar *debug* nil) (defclass editor (line rewindable) ((commands :reader editor-commands @@ -37,10 +39,10 @@ :initform 'lisp-complete :initarg :complete) (history :reader editor-history - :initform (or *history* (setf *history* (make-instance 'buffer))) + :initform (ensure *history* (make-instance 'buffer)) :initarg :history) (killring :reader editor-killring - :initform (or *killring* (setf *killring* (make-instance 'buffer))) + :initform (ensure *killring* (make-instance 'buffer)) :initarg :killring) (insert :reader editor-insert-mode :initform t @@ -68,9 +70,11 @@ 'smart-editor 'dumb-editor))) (unless ann - (format t "~&Linedit version ~A [~A mode]~%" *version* (if (eq 'smart-editor type) - "smart" - "dumb"))) + (format t "~&Linedit version ~A [~A mode]~%" + *version* + (if (eq 'smart-editor type) + "smart" + "dumb"))) (setf ann t) (apply 'make-instance type args)))) @@ -81,9 +85,10 @@ (last (last-state editor))) (unless (and last (equal string (get-string last))) ;; Save only if different than last saved state - (save-rewindable-state editor (make-instance 'line - :string (copy-seq string) - :point (get-point editor)))))) + (save-rewindable-state editor + (make-instance 'line + :string (copy-seq string) + :point (get-point editor)))))) (defmethod rewind-state ((editor editor)) (let ((line (call-next-method))) @@ -136,38 +141,59 @@ (without-backend editor (c-stop))) (defun editor-word-start (editor) + "Returns the index of the first letter of current or previous word, +if the point is just after a word, or the point." (with-editor-point-and-string ((point string) editor) - ;; Find the first point backwards that is NOT a word-start - (let ((non-start (if (and (plusp point) - (word-delimiter-p (char string (1- point)))) - (position-if-not 'word-delimiter-p string - :end point - :from-end t) - point))) - (or (when non-start - ;; Find the first word-start before that. - (let ((start (position-if 'word-delimiter-p string - :end non-start - :from-end t))) - (when start (1+ start)))) - 0)))) + (if (or (not (at-delimiter-p string point)) + (not (at-delimiter-p string (1- point)))) + (1+ (or (position-if 'word-delimiter-p string :end point :from-end t) + -1)) ; start of string + point))) + +(defun editor-previous-word-start (editor) + "Returns the index of the first letter of current or previous word, +if the point was at the start of a word or between words." + (with-editor-point-and-string ((point string) editor) + (let ((tmp (cond ((at-delimiter-p string point) + (position-if-not 'word-delimiter-p string + :end point :from-end t)) + ((at-delimiter-p string (1- point)) + (position-if-not 'word-delimiter-p string + :end (1- point) :from-end t)) + (t point)))) + ;; tmp is always in the word whose start we want (or NIL) + (1+ (or (position-if 'word-delimiter-p string + :end (or tmp 0) :from-end t) + -1))))) (defun editor-word-end (editor) + "Returns the index just beyond the current word or the point if +point is not inside a word." + (with-editor-point-and-string ((point string) editor) + (if (at-delimiter-p string point) + point + (or (position-if 'word-delimiter-p string :start point) + (length string))))) + +(defun editor-next-word-end (editor) + "Returns the index just beyond the last letter of current or next +word, if the point was between words." (with-editor-point-and-string ((point string) editor) - ;; Find the first point forwards that is NOT a word-end - (let ((non-end (if (and (< point (length string)) - (word-delimiter-p (char string point))) - (position-if-not 'word-delimiter-p string :start point) - point))) - (if non-end - ;; Find the first word-end after that - (or (position-if 'word-delimiter-p string :start non-end) - (length string)) - point)))) + (let ((tmp (if (at-delimiter-p string point) + (or (position-if-not 'word-delimiter-p string + :start point) + (length string)) + point))) + ;; tmp is always in the word whose end we want (or already at the end) + (or (position-if 'word-delimiter-p string :start tmp) + (length string))))) (defun editor-word (editor) + "Returns the current word the point is in or right after, or an +empty string." (let ((start (editor-word-start editor)) (end (editor-word-end editor))) + (dbg "~&editor-word: ~S - ~S~%" start end) (subseq (get-string editor) start end))) (defun editor-complete (editor) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.5 src/utility-functions.lisp:1.6 --- src/utility-functions.lisp:1.5 Thu Nov 20 12:29:55 2003 +++ src/utility-functions.lisp Sat Feb 28 06:32:05 2004 @@ -40,3 +40,12 @@ (defun whitespacep (char) (member char '(#\space #\newline #\tab #\return #\page))) + +(defun at-delimiter-p (string index) + (and (< index (length string)) + (word-delimiter-p (char string index)))) + +(defun dbg (format-string &rest format-args) + (when *debug* + (apply #'format *debug* format-string format-args) + (finish-output *debug*))) Index: src/utility-macros.lisp diff -u src/utility-macros.lisp:1.3 src/utility-macros.lisp:1.4 --- src/utility-macros.lisp:1.3 Sun Oct 19 19:38:23 2003 +++ src/utility-macros.lisp Sat Feb 28 06:32:05 2004 @@ -56,7 +56,12 @@ (with-unique-names (value) `(let ((,value ,condition)) (unless ,value - (error "BUG: You seem to have found a bug in Linedit. Please report this incident ~ - along with directions to reproduce and the following message to ~ - linedit-devel at common-lisp.net: `Invariant ~S violated.'" + (error "BUG: You seem to have found a bug in Linedit. Please report~ + this incident along with directions to reproduce and the ~ + following message to linedit-devel at common-lisp.net:~ + ~ + `Invariant ~S violated.'" ',condition))))) + +(defmacro ensure (symbol expr) + `(or ,symbol (setf ,symbol ,expr))) Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.4 src/version.lisp-expr:1.5 --- src/version.lisp-expr:1.4 Sun Nov 9 07:28:03 2003 +++ src/version.lisp-expr Sat Feb 28 06:32:05 2004 @@ -1 +1 @@ -0.15.0 +0.15.1 From nsiivola at common-lisp.net Sat Feb 28 12:11:18 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 28 Feb 2004 07:11:18 -0500 Subject: [Linedit-cvs] CVS update: src/matcher.lisp src/smart-terminal.lisp src/utility-functions.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv12417 Modified Files: matcher.lisp smart-terminal.lisp utility-functions.lisp Log Message: Fixed paren-higlighting fsvo fix. Eg. ()() now works corretlcy. Date: Sat Feb 28 07:11:16 2004 Author: nsiivola Index: src/matcher.lisp diff -u src/matcher.lisp:1.3 src/matcher.lisp:1.4 --- src/matcher.lisp:1.3 Mon Nov 24 17:56:38 2003 +++ src/matcher.lisp Sat Feb 28 07:11:16 2004 @@ -61,18 +61,19 @@ (defun dwim-mark-parens (string index &key pre-mark post-mark) (multiple-value-bind (open close) (dwim-match-parens string index) - (if (and open close) - (concat (subseq string 0 open) - pre-mark - (string (schar string open)) - post-mark - (subseq string (1+ open) close) - pre-mark - (string (schar string close)) - post-mark - (if (> (length string) (1+ close)) - (subseq string (1+ close)) - "")) - string))) - + (values + (if (and open close) + (concat (subseq string 0 open) + pre-mark + (string (schar string open)) + post-mark + (subseq string (1+ open) close) + pre-mark + (string (schar string close)) + post-mark + (if (> (length string) (1+ close)) + (subseq string (1+ close)) + "")) + string) + open))) Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.10 src/smart-terminal.lisp:1.11 --- src/smart-terminal.lisp:1.10 Mon Nov 24 17:56:38 2003 +++ src/smart-terminal.lisp Sat Feb 28 07:11:16 2004 @@ -23,7 +23,8 @@ (defclass smart-terminal (terminal) ((point-row :initform 1 :accessor point-row) - (active-string :initform "" :accessor active-string))) + (active-string :initform "" :accessor active-string) + (markup-start :initform 0 :accessor get-markup-start))) (defun smart-terminal-p () (and (every 'identity @@ -37,44 +38,61 @@ (when ti:enter-am-mode (ti:tputs ti:enter-am-mode))) +(defun find-row (n columns) + ;; 1+ includes point in row calculations + (ceiling (1+ n) columns)) + +(defun find-col (n columns) + (rem n columns)) + +(defun move-up-in-column (&key col up clear-to-eos) + (ti:tputs ti:column-address col) + (loop repeat up do (ti:tputs ti:cursor-up)) + (when clear-to-eos + (ti:tputs ti:clr-eos))) + +(defun fix-wraparound (start end columns) + ;; If final character ended in the last column the point + ;; will wrap around to the first column on the same line: + ;; hence move down if so. + (when (and (< start end) (zerop (find-col end columns))) + (ti:tputs ti:cursor-down))) + +(defun place-point (&key up col) + (loop repeat up do (ti:tputs ti:cursor-up)) + (ti:tputs ti:column-address col)) + (defmethod display ((backend smart-terminal) &key prompt line point markup) (let* ((*terminal-io* *standard-output*) (columns (backend-columns backend)) - (marked-line (if markup - (dwim-mark-parens line point - :pre-mark ti:enter-bold-mode - :post-mark ti:exit-attribute-mode) - line))) - (flet ((find-row (n) - ;; 1+ includes point in row calculations - (ceiling (1+ n) columns)) - (find-col (n) - (rem n columns))) - (let* ((new (concat prompt marked-line)) - (old (active-string backend)) - (end (+ (length prompt) (length line))) ;; based on unmarked - (rows (find-row end)) - (start (or (mismatch new old) 0)) - (start-row (find-row start)) ;; markup? - (start-col (find-col start))) - ;; Move to start of update and clear to eos - (ti:tputs ti:column-address start-col) - (loop repeat (- (point-row backend) start-row) - do (ti:tputs ti:cursor-up)) - (ti:tputs ti:clr-eos) - ;; Write updated segment - (write-string (subseq new start)) - (when (and (< start end) (zerop (find-col end))) - (ti:tputs ti:cursor-down)) - ;; Place point - (let* ((point (+ (length prompt) point)) - (point-row (find-row point)) - (point-col (find-col point))) - (loop repeat (- rows point-row) - do (ti:tputs ti:cursor-up)) - (ti:tputs ti:column-address point-col) - ;; Save state - (setf (point-row backend) point-row - (active-string backend) (concat prompt line))))) - (force-output *terminal-io*))) - + (old-markup-start (get-markup-start backend))) + (multiple-value-bind (marked-line markup-start) + (if markup + (dwim-mark-parens line point + :pre-mark ti:enter-bold-mode + :post-mark ti:exit-attribute-mode) + (values line point)) + (let* ((new (concat prompt marked-line)) + (old (active-string backend)) + (end (+ (length prompt) (length line))) ;; based on unmarked + (rows (find-row end columns)) + (start (min0 markup-start old-markup-start (mismatch new old))) + (start-row (find-row start columns)) + (start-col (find-col start columns)) + (point* (+ point (length prompt))) + (point-row (find-row point* columns)) + (point-col (find-col point* columns))) + (move-up-in-column + :col start-col + :up (- (point-row backend) start-row) + :clear-to-eos t) + (write-string (subseq new start)) + (fix-wraparound start end columns) + (move-up-in-column + :col point-col + :up (- rows point-row)) + ;; Save state + (setf (point-row backend) point-row + (active-string backend) (concat prompt line) + (get-markup-start backend) markup-start) + (force-output *terminal-io*))))) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.6 src/utility-functions.lisp:1.7 --- src/utility-functions.lisp:1.6 Sat Feb 28 06:32:05 2004 +++ src/utility-functions.lisp Sat Feb 28 07:11:16 2004 @@ -49,3 +49,7 @@ (when *debug* (apply #'format *debug* format-string format-args) (finish-output *debug*))) + +(defun min0 (&rest args) + "Like min, except treats NILs as zeroes." + (apply #'min (mapcar (lambda (x) (or x 0)) args))) From nsiivola at common-lisp.net Sat Feb 28 14:27:28 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 28 Feb 2004 09:27:28 -0500 Subject: [Linedit-cvs] CVS update: src/release.txt src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv29889 Modified Files: release.txt version.lisp-expr Log Message: 0.15.2 Date: Sat Feb 28 09:27:28 2004 Author: nsiivola Index: src/release.txt diff -u src/release.txt:1.5 src/release.txt:1.6 --- src/release.txt:1.5 Thu Nov 6 09:33:39 2003 +++ src/release.txt Sat Feb 28 09:27:27 2004 @@ -9,6 +9,7 @@ editor.lisp line.lisp main.lisp +matcher.lisp packages.lisp rewindable.lisp sbcl-repl.lisp Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.5 src/version.lisp-expr:1.6 --- src/version.lisp-expr:1.5 Sat Feb 28 06:32:05 2004 +++ src/version.lisp-expr Sat Feb 28 09:27:27 2004 @@ -1 +1 @@ -0.15.1 +0.15.2 From nsiivola at common-lisp.net Sat Feb 28 15:13:56 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 28 Feb 2004 10:13:56 -0500 Subject: [Linedit-cvs] CVS update: src/smart-terminal.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv17472 Modified Files: smart-terminal.lisp version.lisp-expr Log Message: Smart terminal should now work on darwin Date: Sat Feb 28 10:13:56 2004 Author: nsiivola Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.11 src/smart-terminal.lisp:1.12 --- src/smart-terminal.lisp:1.11 Sat Feb 28 07:11:16 2004 +++ src/smart-terminal.lisp Sat Feb 28 10:13:56 2004 @@ -23,15 +23,24 @@ (defclass smart-terminal (terminal) ((point-row :initform 1 :accessor point-row) + (point-col :initform 0 :accessor point-col) (active-string :initform "" :accessor active-string) (markup-start :initform 0 :accessor get-markup-start))) +(defun set-column-address (n current) + (if nil + (ti:tputs ti:column-address n) + (cond ((< n current) + (loop repeat (- current n) + do (ti:tputs ti:cursor-left))) + ((> n current) + (loop repeat (- n current) + do (ti:tputs ti:cursor-right)))))) + (defun smart-terminal-p () - (and (every 'identity - (list ti:cursor-up ti:cursor-down - ti:clr-eos ti:column-address )) - (some 'identity - (list ti:auto-right-margin ti:enter-am-mode)))) + (and ti:cursor-up ti:cursor-down ti:clr-eos + (or ti:column-address (and ti:cursor-left ti:cursor-right)) + (or ti:auto-right-margin ti:enter-am-mode))) (defmethod backend-init ((backend smart-terminal)) (call-next-method) @@ -45,8 +54,8 @@ (defun find-col (n columns) (rem n columns)) -(defun move-up-in-column (&key col up clear-to-eos) - (ti:tputs ti:column-address col) +(defun move-up-in-column (&key col up clear-to-eos current-col) + (set-column-address col current-col) (loop repeat up do (ti:tputs ti:cursor-up)) (when clear-to-eos (ti:tputs ti:clr-eos))) @@ -65,7 +74,8 @@ (defmethod display ((backend smart-terminal) &key prompt line point markup) (let* ((*terminal-io* *standard-output*) (columns (backend-columns backend)) - (old-markup-start (get-markup-start backend))) + (old-markup-start (get-markup-start backend)) + (old-col (point-col backend))) (multiple-value-bind (marked-line markup-start) (if markup (dwim-mark-parens line point @@ -85,14 +95,17 @@ (move-up-in-column :col start-col :up (- (point-row backend) start-row) - :clear-to-eos t) + :clear-to-eos t + :current-col old-col) (write-string (subseq new start)) (fix-wraparound start end columns) (move-up-in-column - :col point-col - :up (- rows point-row)) + :col point-col + :up (- rows point-row) + :current-col (find-col end columns)) ;; Save state (setf (point-row backend) point-row + (point-col backend) point-col (active-string backend) (concat prompt line) (get-markup-start backend) markup-start) (force-output *terminal-io*))))) Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.6 src/version.lisp-expr:1.7 --- src/version.lisp-expr:1.6 Sat Feb 28 09:27:27 2004 +++ src/version.lisp-expr Sat Feb 28 10:13:56 2004 @@ -1 +1 @@ -0.15.2 +0.15.3