;;; 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
			     previous-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))
      ))
  )
