# HG changeset patch # User Richard M. Stallman # Date 937162990 0 # Node ID c85397c22e1bf5e33109dc70f8e99f5271315875 # Parent a48ea135fed49563d943e2db64ca474bc5a77024 (tpu-version): New version. (tpu-search-overlay, tpu-replace-overlay): New variables. (tpu-search-highlight, tpu-toggle-direction): New functions. (tpu-lm-replace): Set tpu-replace-overlay. (tpu-edt-on, tpu-edt-off): Add/remove tpu-search-highlight post command hook. diff -r a48ea135fed4 -r c85397c22e1b lisp/emulation/tpu-edt.el --- a/lisp/emulation/tpu-edt.el Sun Sep 12 17:29:24 1999 +0000 +++ b/lisp/emulation/tpu-edt.el Sun Sep 12 19:03:10 1999 +0000 @@ -4,7 +4,7 @@ ;; Author: Rob Riepel ;; Maintainer: Rob Riepel -;; Version: 4.2 +;; Version: 4.4 ;; Keywords: emulations ;; This file is part of GNU Emacs. @@ -184,7 +184,7 @@ ;; (tpu-edt) ;; ; Set scroll margins 10% (top) and 15% (bottom). -;; (tpu-set-scroll-margins "10%" "15%") +;; (tpu-set-scroll-margins "10%" "15%") ;; ; Load the vtxxx terminal control functions. ;; (load "vt-control" t) @@ -275,7 +275,7 @@ ;;; ;;; Version Information ;;; -(defconst tpu-version "4.2" "TPU-edt version number.") +(defconst tpu-version "4.4" "TPU-edt version number.") ;;; @@ -369,6 +369,13 @@ "If non-nil, TPU-edt is searching in the forward direction.") (defvar tpu-search-last-string "" "Last text searched for by the TPU-edt search commands.") +(defvar tpu-search-overlay (make-overlay 0 0) + "Search highlight overlay.") +(overlay-put tpu-search-overlay 'face 'bold) + +(defvar tpu-replace-overlay (make-overlay 0 0) + "Replace highlight overlay.") +(overlay-put tpu-replace-overlay 'face 'highlight) (defvar tpu-regexp-p nil "If non-nil, TPU-edt uses regexp search and replace routines.") @@ -1119,6 +1126,12 @@ (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist) (read-string re-prompt)))) +(defun tpu-search-highlight nil + (if (tpu-check-match) + (move-overlay tpu-search-overlay + (tpu-match-beginning) (tpu-match-end) (current-buffer)) + (move-overlay tpu-search-overlay 0 0 (current-buffer)))) + (defun tpu-search nil "Search for a string or regular expression. The search is performed in the current direction." @@ -1564,46 +1577,50 @@ ;; Loop on replace question - yes, no, all, last, or quit. (while doit (if (not (tpu-check-match)) (setq doit nil) - (progn (message "Replace? Type Yes, No, All, Last, or Quit: ") - (let ((ans (read-char))) + (progn + (move-overlay tpu-replace-overlay + (tpu-match-beginning) (tpu-match-end) (current-buffer)) + (message "Replace? Type Yes, No, All, Last, or Quit: ") + (let ((ans (read-char))) - (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal from t)) + (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal from t)) - ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) - (tpu-search-internal from t)) + ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) + (tpu-search-internal from t)) - ((or (= ans ?a) (= ans ?A)) - (save-excursion - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t) - (while (tpu-check-match) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t))) - (setq doit nil)) + ((or (= ans ?a) (= ans ?A)) + (save-excursion + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t) + (while (tpu-check-match) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t))) + (setq doit nil)) - ((or (= ans ?l) (= ans ?L)) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (setq doit nil)) + ((or (= ans ?l) (= ans ?L)) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (setq doit nil)) - ((or (= ans ?q) (= ans ?Q)) - (setq doit nil))))))) + ((or (= ans ?q) (= ans ?Q)) + (tpu-unset-match) + (setq doit nil))))))) - (message "Replaced %s occurrence%s." strings - (if (not (= 1 strings)) "s" "")))) + (move-overlay tpu-replace-overlay 0 0 (current-buffer)) + (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) (defun tpu-emacs-replace (&optional dont-ask) "A TPU-edt interface to the emacs replace functions. If TPU-edt is @@ -1988,6 +2005,11 @@ (tpu-set-search) (tpu-update-mode-line)) +(defun tpu-toggle-direction nil + "Change the current TPU direction." + (interactive) + (if tpu-advance (tpu-backup-direction) (tpu-advance-direction))) + ;;; ;;; Define keymaps @@ -2477,6 +2499,7 @@ (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t) (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t) (autoload 'ispell-region "ispell" "Check spelling of region" t))) + (add-hook 'post-command-hook 'tpu-search-highlight) (tpu-set-mode-line t) (tpu-advance-direction) ;; set page delimiter, display line truncation, and scrolling like TPU @@ -2491,6 +2514,7 @@ (cond (tpu-edt-mode (tpu-reset-control-keys nil) + (remove-hook 'post-command-hook 'tpu-search-highlight) (tpu-set-mode-line nil) (setq-default page-delimiter "^\f") (setq-default truncate-lines nil)