Skip to content
Snippets Groups Projects
Commit 312eeb9a authored by dtc's avatar dtc
Browse files

Fix a type error in "Delete Previous Character" that occurred when

there were too few characters to delete. Further, rework the code to
not modify the buffer if there are not enough characters.
parent 4e220ad0
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/morecoms.lisp,v 1.4 1994/10/31 04:50:12 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/morecoms.lisp,v 1.5 1999/09/14 16:18:23 dtc Rel $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -127,22 +127,33 @@ ...@@ -127,22 +127,33 @@
(when (minusp n) (when (minusp n)
(editor-error "Delete Previous Character Expanding Tabs only accepts ~ (editor-error "Delete Previous Character Expanding Tabs only accepts ~
positive arguments.")) positive arguments."))
(let ((errorp nil)) ;; Pre-calculate the number of characters that need to be deleted
(with-mark ((mark point :left-inserting)) ;; and any remaining white space filling, allowing modification to
;; be avoided if there are not enough characters to delete.
(let ((errorp nil)
(del 0)
(fill 0))
(with-mark ((mark point))
(dotimes (i n) (dotimes (i n)
(cond ((char= (previous-character mark) #\tab) (if (> fill 0)
(let ((pos (mark-column mark))) (decf fill)
(delete-characters mark -1) (let ((prev (previous-character mark)))
(dotimes (i (- pos (mark-column mark))) (cond ((and prev (char= prev #\tab))
(insert-character mark #\space)) (let ((pos (mark-column mark)))
(mark-before mark))) (mark-before mark)
((mark-before mark)) (incf fill (- pos (mark-column mark) 1)))
(t (incf del))
(setq errorp t) ((mark-before mark)
(return))))) (incf del))
(kill-characters point (- n)) (t
(when errorp (setq errorp t)
(editor-error "There were not ~D characters before point." n))))) (return)))))))
(cond ((and (not errorp) (kill-characters point (- del)))
(with-mark ((mark point :left-inserting))
(dotimes (i fill)
(insert-character mark #\space))))
(t
(editor-error "There were not ~D characters before point." n))))))
(defvar *scope-table* (defvar *scope-table*
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment