comparison lisp/emulation/viper-cmd.el @ 90596:6823a91487f2

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 399-413) - Update from CVS - Rcirc update from Ryan Yeske - Merge from gnus--rel--5.10 - Miscellaneous tq-related fixes. * gnus--rel--5.10 (patch 126-127) - Merge from emacs--devo--0 - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-105

90595:fd59c4164a14

(defvar quail-current-str)
(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)
(defvar init-message)
(defvar initial)

;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
    (eval-when-compile

	    (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
	    ;; save current color, if not already saved
	    (viper-save-cursor-color 'before-insert-mode))
	;; set insert mode cursor color
	(viper-change-cursor-color viper-insert-state-cursor-color)))
  (if (eq viper-current-state 'emacs-state)
      (let ((has-saved-cursor-color-in-emacs-mode
	     (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
	(or has-saved-cursor-color-in-emacs-mode
	    (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
	    ;; save current color, if not already saved

  (interactive)
  (or (viper-overlay-p viper-replace-overlay)
      (viper-set-replace-overlay (point-min) (point-min)))
  (viper-hide-replace-overlay)

  (let ((has-saved-cursor-color-in-emacs-mode
	 (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
    (or has-saved-cursor-color-in-emacs-mode
	(string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
	(viper-save-cursor-color 'before-emacs-mode))
    (viper-change-cursor-color viper-emacs-state-cursor-color))

  (viper-change-state 'emacs-state)

  ;; Protect against user errors in hooks
  (condition-case conds

  (let ((event last-input-event)
	(keyseq [nil])
	(inhibit-quit t))
    (if (viper-ESC-event-p event)
	(progn
	  ;; Emacs 22.50.8 introduced a bug, which makes even a single ESC into
	  ;; a fast keyseq. To guard against this, we added a check if there
	  ;; are other events as well
	  (if (and (viper-fast-keysequence-p) unread-command-events)
	      (progn
		(let (minor-mode-map-alist emulation-mode-map-alists)
		  (viper-set-unread-command-events event)
		  (setq keyseq (read-key-sequence nil 'continue-echo))
		  ) ; let

(add-hook 'after-change-functions 'viper-undo-sentinel)

;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end len)
  (setq undo-beg-posn beg
	undo-end-posn (or end beg))
  ;; some other hooks may be changing various text properties in
  ;; the buffer in response to 'undo'; so remove this hook to avoid
  ;; its repeated invocation
  (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local))

(defun viper-undo ()
  "Undo previous change."
  (interactive)
  (message "undo!")

    ;; the viper-after-change-undo-hook removes itself after the 1st invocation
    (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)

    (undo-start)
    (undo-more 2)
    (setq undo-beg-posn (or undo-beg-posn before-undo-pt)
	  undo-end-posn (or undo-end-posn undo-beg-posn))

    (goto-char undo-beg-posn)
    (sit-for 0)
    (if (and viper-keep-point-on-undo
	     (pos-visible-in-window-p before-undo-pt))
	(progn
	  (push-mark (point-marker) t)
	  (viper-sit-for-short 300)
	  (goto-char undo-end-posn)
	  (viper-sit-for-short 300)
	  (if (and (> (viper-chars-in-region undo-beg-posn before-undo-pt) 1)
		   (> (viper-chars-in-region undo-end-posn before-undo-pt) 1))
	      (goto-char before-undo-pt)
	    (goto-char undo-beg-posn)))
      (push-mark before-undo-pt t))
    (if (and (eolp) (not (bolp))) (backward-char 1))
    ;;(if (not modified) (set-buffer-modified-p t))
    )
  (setq this-command 'viper-undo))

;; Continue undoing previous changes.
(defun viper-undo-more ()

  "Repeat previous search."
  (interactive "P")
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg))
	debug-on-error)
    (if (null viper-s-string) (error viper-NoPrevSearch))
    (viper-search viper-s-string viper-s-forward arg)
    (if com
	(progn
	  (viper-move-marker-locally 'viper-com-point (mark t))
	  (viper-execute-com 'viper-search-next val com)))))

90596:6823a91487f2

(defvar quail-current-str)
(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)
(defvar init-message)
(defvar initial)
(defvar undo-beg-posn)
(defvar undo-end-posn)

;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
    (eval-when-compile

	    (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
	    ;; save current color, if not already saved
	    (viper-save-cursor-color 'before-insert-mode))
	;; set insert mode cursor color
	(viper-change-cursor-color viper-insert-state-cursor-color)))
  (if (and viper-emacs-state-cursor-color (eq viper-current-state 'emacs-state))
      (let ((has-saved-cursor-color-in-emacs-mode
	     (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
	(or has-saved-cursor-color-in-emacs-mode
	    (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
	    ;; save current color, if not already saved

  (interactive)
  (or (viper-overlay-p viper-replace-overlay)
      (viper-set-replace-overlay (point-min) (point-min)))
  (viper-hide-replace-overlay)

  (if viper-emacs-state-cursor-color
      (let ((has-saved-cursor-color-in-emacs-mode
	     (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
	(or has-saved-cursor-color-in-emacs-mode
	    (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
	    (viper-save-cursor-color 'before-emacs-mode))
	(viper-change-cursor-color viper-emacs-state-cursor-color)))

  (viper-change-state 'emacs-state)

  ;; Protect against user errors in hooks
  (condition-case conds

  (let ((event last-input-event)
	(keyseq [nil])
	(inhibit-quit t))
    (if (viper-ESC-event-p event)
	(progn
	  ;; Some versions of Emacs (eg., 22.50.8 have a bug, which makes even
	  ;; a single ESC into ;; a fast keyseq. To guard against this, we
	  ;; added a check if there are other events as well. Keep the next
	  ;; line for the next time the bug reappears, so that will remember to
	  ;; report it.
	  ;;(if (and (viper-fast-keysequence-p) unread-command-events)
	  (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug
	      (progn
		(let (minor-mode-map-alist emulation-mode-map-alists)
		  (viper-set-unread-command-events event)
		  (setq keyseq (read-key-sequence nil 'continue-echo))
		  ) ; let

(add-hook 'after-change-functions 'viper-undo-sentinel)

;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end len)
  (if undo-in-progress
      (setq undo-beg-posn beg
	    undo-end-posn (or end beg))
    ;; some other hooks may be changing various text properties in
    ;; the buffer in response to 'undo'; so remove this hook to avoid
    ;; its repeated invocation
    (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
  ))

(defun viper-undo ()
  "Undo previous change."
  (interactive)
  (message "undo!")

    ;; the viper-after-change-undo-hook removes itself after the 1st invocation
    (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)

    (undo-start)
    (undo-more 2)
    ;;(setq undo-beg-posn (or undo-beg-posn (point))
    ;;    undo-end-posn (or undo-end-posn (point)))
    ;;(setq undo-beg-posn (or undo-beg-posn before-undo-pt)
    ;;      undo-end-posn (or undo-end-posn undo-beg-posn))

    (if (and undo-beg-posn undo-end-posn)
	(progn
	  (goto-char undo-beg-posn)
	  (sit-for 0)
	  (if (and viper-keep-point-on-undo
		   (pos-visible-in-window-p before-undo-pt))
	      (progn
		(push-mark (point-marker) t)
		(viper-sit-for-short 300)
		(goto-char undo-end-posn)
		(viper-sit-for-short 300)
		(if (pos-visible-in-window-p undo-beg-posn)
		    (goto-char before-undo-pt)
		  (goto-char undo-beg-posn)))
	    (push-mark before-undo-pt t))
	  ))

    (if (and (eolp) (not (bolp))) (backward-char 1))
    )
  (setq this-command 'viper-undo))

;; Continue undoing previous changes.
(defun viper-undo-more ()

  "Repeat previous search."
  (interactive "P")
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg))
	debug-on-error)
    (if (or (null viper-s-string) (string= viper-s-string ""))
	(error viper-NoPrevSearch))
    (viper-search viper-s-string viper-s-forward arg)
    (if com
	(progn
	  (viper-move-marker-locally 'viper-com-point (mark t))
	  (viper-execute-com 'viper-search-next val com)))))