;;; lisp file for xyzzy ver0.2.2.233 or ver0.2.2.234
;;; undo.l ver0.1.5.5 // modification for all // + sort-text.l // crayonzen [2023-03-18]07:14:43(+0900)
;;; undo.l ver0.1.5.4 // modification for all // crayonzen [2006-05-27]09:21:03(+0900)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide "undo")
(in-package "editor")
(export '(un_do
re_do
undo-all
redo-all
reset-undo-del
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *exception-cmd-list* '(
;perform-replace
replace-dialog ;;cancel delete after
replace-string
query-replace
replace-regexp
query-replace-regexp
repeat-complex-command
;;not-modified
revert-buffer
))
(defvar *exception-all-buffer-cmd-list* '(
;gresreg-process
gresreg-dialog
gresreg1
))
(defvar *exclude-cmd-list* '(
mouse-left-press
mouse-left-motion
mouse-nop
mouse-ctl-left-press
mouse-ctl-left-motion
mouse-shift-left-press
begin-auto-scroll
scroll-page-mouse-press
scroll-page-mouse-motion
next-page-mouse
))
(defvar *complete-exclude-cmd-list* '(
un_do
re_do
undo-all
redo-all
undo
redo
open-file-dialog
close-and-open-file-dialog
first-error
next-error
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local *undo-del-info* nil)
(defvar-local *undo-del-list* nil)
(defvar-local *action-count* 0)
(defvar-local *pre-append-modified-count* nil)
(defvar-local *pre-buffer-modified-count* 0)
(defvar-local *pre-action-count* 0)
;;for self-insert-command
(defvar-local *_count* 0)
(defvar *self-insert_value* 4)
(add-hook '*pre-command-hook* 'set-buffer-undo-pre-command) ;;befor command
(add-hook '*post-command-hook* 'set-buffer-undo-post-command) ;;after command
(defun set-buffer-undo-post-command ()
(when kept-undo-information
(unless *executing-macro*
;;gresreg all buffer
(if (find *this-command* *exception-all-buffer-cmd-list* :test #'eq)
(replace-all-undo-del-list)
;;else 1 buffer
(if *pre-append-modified-count*
(if (eql *pre-append-modified-count* (buffer-modified-count))
(progn
(delete (car *undo-del-list*) *undo-del-list*)
(setq *action-count* (- *action-count* 1)))
(progn
(setf (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*)))) (point))
;;replace
(if (find *this-command* *exception-cmd-list* :test #'eq)
(replace-undo-del-list))
;;repeat-complex-command
;;revert
(if (eq *this-command* 'revert-buffer)
(clear-undo-del))
)
)
;;else dummy + 1
(if (and (null (find *this-command* *complete-exclude-cmd-list* :test #'eq))
(null (eq *this-command* 'self-insert-command))
(null (eq *pre-buffer-modified-count* (buffer-modified-count)))
(eql *pre-action-count* *action-count*))
(progn
(setq *action-count* (plus-undo-del-dummy-list *action-count* 1))
(setf (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*)))) (point))
))
)
)
;; (setq action-cmd (cdr (assoc 'this_command (cdr (assoc *action-count* *undo-del-list*)))))
;; (message "*action-count* ~S ~S / *_count* ~D / count ~D / this-command ~S "
;; *action-count* action-cmd *_count* (buffer-modified-count) *this-command*)
))
)
(defun get-undo-count ()
(let ((undo_count 0)
(redo_count 0)
(all_count 0))
(while (buffer-can-redo-p (selected-buffer))
(setq redo_count (+ redo_count 1))
(undo-boundary)
(redo))
(while (buffer-can-undo-p (selected-buffer))
(setq all_count (+ all_count 1))
(undo-boundary)
(undo))
(setq undo_count (- all_count redo_count))
(if (> undo_count 0)
(block redoblock
(let* ((n 0))
(tagbody
repeat
(if (>= n undo_count)
(return-from redoblock n))
(setq n (+ n 1))
(undo-boundary)
(redo)
(go repeat))
)))
(values all_count undo_count redo_count))
)
(defun clear-undo-del ()
(interactive)
(setq *undo-del-list* nil)
(setq *action-count* 0)
)
(defun reset-undo-del ()
(interactive)
(let ()
(setq *undo-del-list* nil)
(setq *action-count* 0)
(multiple-value-setq (all_count undo_count redo_count) (get-undo-count))
(if (> all_count 0)
(plus-undo-del-dummy-list *action-count* all_count))
(setq *action-count* undo_count))
)
(defun plus-undo-del-dummy-list (action_count replace_count)
(if (and (numberp action_count)
(> replace_count 0))
(block add-dummy-list
(let* ((action_count action_count)
(replace-action-count (+ action_count replace_count))
(dummy-info
(list (cons 'this_command 'dummy-command)
(cons 'pre_selection_p nil)
(cons 'get_selection_type nil)
(cons 'selection_mark nil)
(cons 'selection_point nil)
(cons 'mark_t nil)
(cons '_point nil)
(cons 'post_point nil)
)))
(tagbody
repeat
(if (>= action_count replace-action-count)
(return-from add-dummy-list action_count))
(setq action_count (+ action_count 1))
(setq *undo-del-list* (append (list (cons action_count dummy-info)) *undo-del-list*))
(go repeat))
)))
)
(defun replace-undo-del-list ()
(setf (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*)))) nil)
(multiple-value-setq (all_count undo_count redo_count) (get-undo-count))
(setq replace_count (- all_count *action-count*))
(if (> replace_count 0)
(progn
(plus-undo-del-dummy-list *action-count* replace_count)
(setq *action-count* undo_count)
))
(if (< replace_count 0)
(progn
(delete (car *undo-del-list*) *undo-del-list*)
(setq *action-count* (- *action-count* 1))))
)
(defun replace-all-undo-del-list ()
(let ((cur-buffer (selected-buffer)))
(replace-undo-del-list)
(save-excursion
(dolist (buffer (buffer-list))
(if (null (eq buffer cur-buffer))
(progn
(set-buffer buffer)
(multiple-value-setq (all_count undo_count redo_count) (get-undo-count))
(setq replace_count (- all_count *action-count*))
(if (> replace_count 0)
(progn
(plus-undo-del-dummy-list *action-count* replace_count)
(setq *action-count* undo_count)
))
)))))
)
(defun set-buffer-undo-pre-command ()
(when kept-undo-information
(unless *executing-macro*
(setq *pre-buffer-modified-count* (buffer-modified-count))
(setq *pre-append-modified-count* nil)
(setq *pre-action-count* *action-count*)
(if (and (null (find *this-command* *exclude-cmd-list* :test #'eq))
(null (find *this-command* *complete-exclude-cmd-list* :test #'eq)))
(progn
(setq action t)
(if (and (eq *this-command* 'self-insert-command)
(eq *last-command* 'self-insert-command))
(progn
(setq post_point (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*)))))
(if (= (point) post_point)
(progn
(if (>= *_count* (- *self-insert_value* 1))
(progn
(setq *_count* 0)
(setq action t))
(progn
(setf (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*))))
(+ post_point 1))
(clear-undo-boundary)
(setq *_count* (+ *_count* 1))
(setq action nil))))
(progn
(setq *_count* 0)
(setq action t))))
(progn
(setq *_count* 0)
(setq action t)))
(when action
(setq *pre-append-modified-count* (buffer-modified-count))
(setq *action-count* (+ *action-count* 1))
(setq *undo-del-info*
(list (cons 'this_command *this-command*)
(cons 'pre_selection_p (pre-selection-p))
(cons 'get_selection_type (if (pre-selection-p) (get-selection-type)))
(cons 'selection_mark (if (pre-selection-p) (selection-mark)))
(cons 'selection_point (if (pre-selection-p) (selection-point)))
(cons 'mark_t (mark t))
(cons '_point (point))
(cons 'post_point nil)
))
(setq *undo-del-list* (append (list (cons *action-count* *undo-del-info*)) *undo-del-list*))
(limit-undo-del-list))
))
))
)
(defun limit-undo-del-list ()
(let (n)
(setq n (- (length *undo-del-list*) kept-undo-information 1))
(if (>= n 0)
(setf (cdr (nthcdr n *undo-del-list*)) nil)))
)
(defun un_do ()
(interactive "*p")
(when kept-undo-information
(unless *executing-macro*
(undo)
(when *undo-del-list*
(if (null (set-redo-selection))
(progn
(setq _point (cdr (assoc '_point (cdr (assoc *action-count* *undo-del-list*)))))
(if _point
(goto-char _point))))
(setq *action-count* (- *action-count* 1)))
))
)
(defun re_do ()
(interactive "*p")
(when kept-undo-information
(unless *executing-macro*
(redo)
(when *undo-del-list*
(setq *action-count* (+ *action-count* 1))
(setq post_point (cdr (assoc 'post_point (cdr (assoc *action-count* *undo-del-list*)))))
(if post_point
(goto-char post_point)))
))
)
(defun set-redo-selection ()
(if (cdr (assoc 'pre_selection_p (cdr (assoc *action-count* *undo-del-list*))))
(progn
(if (cdr (assoc 'mark_t (cdr (assoc *action-count* *undo-del-list*))))
(set-mark (cdr (assoc 'mark_t (cdr (assoc *action-count* *undo-del-list*))))))
(goto-char (cdr (assoc 'selection_mark (cdr (assoc *action-count* *undo-del-list*)))))
(continue-pre-selection)
(start-selection 2 t)
(goto-char (cdr (assoc 'selection_point (cdr (assoc *action-count* *undo-del-list*)))))
(if (eql 3 (cdr (assoc 'get_selection_type (cdr (assoc *action-count* *undo-del-list*)))))
(set-selection-type 3 t))
(selection-leave))
(if (or (eq 'kill-region (cdr (assoc 'this_command (cdr (assoc *action-count* *undo-del-list*)))))
(eq 'sort-lines-buffer (cdr (assoc 'this_command (cdr (assoc *action-count* *undo-del-list*)))))
(eq 'sort-lines-buffer-reverse (cdr (assoc 'this_command (cdr (assoc *action-count* *undo-del-list*)))))
)
(progn
(set-mark (cdr (assoc 'mark_t (cdr (assoc *action-count* *undo-del-list*)))))
(goto-char (cdr (assoc '_point (cdr (assoc *action-count* *undo-del-list*)))))
(reverse-region (cdr (assoc 'mark_t (cdr (assoc *action-count* *undo-del-list*))))
(cdr (assoc '_point (cdr (assoc *action-count* *undo-del-list*))))
t)
)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun undo-all ()
(interactive "*p")
(let ((count 0))
(while (buffer-can-undo-p (selected-buffer))
(setq count (+ count 1))
(undo-boundary)
(undo))
(when *action-count*
(setq *action-count* (- *action-count* count))
))
)
(defun redo-all ()
(interactive "*p")
(let ((count 0))
(while (buffer-can-redo-p (selected-buffer))
(setq count (+ count 1))
(undo-boundary)
(redo))
(when *action-count*
(setq *action-count* (+ *action-count* count))
))
)
Copyright (c) 2000-2026 crayonzen