comparison lisp/emulation/tpu-edt.el @ 39540:a386ffde71f8

Make messages match original TPU/edt editor.

39539:1f0f069f32ea

 and the total number of lines in the buffer."
  (interactive)
  (if (eobp)
      (message "You are at the End of Buffer.  The last line is %d."
	       (count-lines 1 (point-max)))
    (message "Line %d of %d"
	     (count-lines 1 (1+ (point)))
	     (count-lines 1 (point-max)))))

(defun tpu-exit nil
  "Exit the way TPU does, save current buffer and ask about others."
  (interactive)
  (if (not (eq (recursion-depth) 0))

;; Apparently TPU users really expect to do M-x help RET to get help.
;; So it is really necessary to redefine this.
(fset 'help 'tpu-help)
(fset 'HELP 'tpu-help)

(fset 'set\ cursor\ free 'tpu-set-cursor-free)
(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)

(fset 'set\ cursor\ bound 'tpu-set-cursor-bound)

(defun tpu-next-file-buffer nil
  "Go to next buffer in ring that is visiting a file or directory."
  (interactive)
  (let ((list (tpu-make-file-buffer-list (buffer-list))))
    (setq list (delq (current-buffer) list))
    (if (not list) (error "No other buffers"))
    (switch-to-buffer (car (reverse list)))))

(defun tpu-make-file-buffer-list (buffer-list)
  "Returns names from BUFFER-LIST excluding those beginning with a space or star."
  (delq nil (mapcar '(lambda (b)

	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
	   (setq tpu-last-deleted-region (buffer-substring beg end))
	   (delete-region beg end)
	   (tpu-unset-match)))
	(t
	 (error "No selection active"))))

(defun tpu-store-text nil
  "Copy the selected region to the cut buffer without deleting it.
The text is saved for the tpu-paste command."
  (interactive)

	((tpu-check-match)
	 (setq tpu-last-deleted-region
	       (buffer-substring (tpu-match-beginning) (tpu-match-end)))
	 (tpu-unset-match))
	(t
	 (error "No selection active"))))

(defun tpu-cut (arg)
  "Copy selected region to the cut buffer.  In the absence of an
argument, delete the selected region too."
  (interactive "P")

		 (concat tpu-last-deleted-region
			 (buffer-substring beg end)))
	   (if (not arg) (delete-region beg end))
	   (tpu-unset-match)))
	(t
	 (error "No selection active"))))

(defun tpu-delete-current-line (num)
  "Delete one or specified number of lines after point.
This includes the newline character at the end of each line.
They are saved for the TPU-edt undelete-lines command."

	   (setq tpu-last-replaced-text (buffer-substring beg end))
	   (replace-match tpu-last-deleted-region
			  (not case-replace) (not tpu-regexp-p))
	   (tpu-unset-match)))
	(t
	 (error "No selection active"))))

(defun tpu-substitute (num)
  "Replace the selected region with the contents of the cut buffer, and
repeat most recent search.  A numeric argument serves as a repeat count.
A negative argument means replace all occurrences of the search string."

	     (if tpu-searching-forward (forward-char -1) (goto-char beg))
	     (if (= num 1) (tpu-search-internal tpu-search-last-string)
	       (tpu-search-internal-core tpu-search-last-string)))
	   (setq num (1- num))))
	(t
	 (error "No selection active"))))

(defun tpu-lm-replace (from to)
  "Interactively search for OLD-string and substitute NEW-string."
  (interactive (list (tpu-regexp-prompt "Old String: ")
		     (tpu-regexp-prompt "New String: ")))

  (let ((doit t) (strings 0))

    ;; Can't replace null strings
    (if (string= "" from) (error "No string to replace"))

    ;; Find the first occurrence
    (tpu-set-search)
    (tpu-search-internal from t)

(defun tpu-add-at-bol (text)
  "Add text to the beginning of each line in a region,
or each line in the entire buffer if no region is selected."
  (interactive
   (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
  (if (string= "" text) (error "No string specified"))
  (cond ((tpu-mark)
	 (save-excursion
	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
	   (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
	     (if (< (point) (tpu-mark)) (replace-match text))))

(defun tpu-add-at-eol (text)
  "Add text to the end of each line in a region,
or each line of the entire buffer if no region is selected."
  (interactive
   (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
  (if (string= "" text) (error "No string specified"))
  (cond ((tpu-mark)
	 (save-excursion
	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
	   (while (< (point) (tpu-mark))
	     (end-of-line)

(defun tpu-goto-percent (perc)
  "Move point to ARG percentage of the buffer."
  (interactive "NGoto-percentage: ")
  (if (or (> perc 100) (< perc 0))
      (error "Percentage %d out of range 0 < percent < 100" perc)
    (goto-char (/ (* (point-max) perc) 100))))

(defun tpu-beginning-of-window nil
  "Move cursor to top of window."
  (interactive)

    (goto-char (point-min))
    (beep)
    (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
	 (condition-case conditions
             (copy-file oldname newname)
	   (error (message "Sorry, couldn't copy - %s" (cdr conditions)))))
    (kill-buffer "*TPU-Notice*")))


;;;
;;;  Start and Stop TPU-edt

39540:a386ffde71f8

 and the total number of lines in the buffer."
  (interactive)
  (if (eobp)
      (message "You are at the End of Buffer.  The last line is %d."
	       (count-lines 1 (point-max)))
    (let* ((cur (count-lines 1 (1+ (point))))
	   (max (count-lines 1 (point-max)))
	   (pct (/ (* 100 (+ cur (/ max 200))) max)))
      (message "You are on line %d out of %d (%d%%)." cur max pct))))

(defun tpu-exit nil
  "Exit the way TPU does, save current buffer and ask about others."
  (interactive)
  (if (not (eq (recursion-depth) 0))

;; Apparently TPU users really expect to do M-x help RET to get help.
;; So it is really necessary to redefine this.
(fset 'help 'tpu-help)
(fset 'HELP 'tpu-help)

;; Real TPU error messages end in periods.
;; Define this to avoid openly flouting Emacs coding standards.
(defalias 'tpu-error 'error)

(fset 'set\ cursor\ free 'tpu-set-cursor-free)
(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)

(fset 'set\ cursor\ bound 'tpu-set-cursor-bound)

(defun tpu-next-file-buffer nil
  "Go to next buffer in ring that is visiting a file or directory."
  (interactive)
  (let ((list (tpu-make-file-buffer-list (buffer-list))))
    (setq list (delq (current-buffer) list))
    (if (not list) (tpu-error "No other buffers."))
    (switch-to-buffer (car (reverse list)))))

(defun tpu-make-file-buffer-list (buffer-list)
  "Returns names from BUFFER-LIST excluding those beginning with a space or star."
  (delq nil (mapcar '(lambda (b)

	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
	   (setq tpu-last-deleted-region (buffer-substring beg end))
	   (delete-region beg end)
	   (tpu-unset-match)))
	(t
	 (tpu-error "No selection active."))))

(defun tpu-store-text nil
  "Copy the selected region to the cut buffer without deleting it.
The text is saved for the tpu-paste command."
  (interactive)

	((tpu-check-match)
	 (setq tpu-last-deleted-region
	       (buffer-substring (tpu-match-beginning) (tpu-match-end)))
	 (tpu-unset-match))
	(t
	 (tpu-error "No selection active."))))

(defun tpu-cut (arg)
  "Copy selected region to the cut buffer.  In the absence of an
argument, delete the selected region too."
  (interactive "P")

		 (concat tpu-last-deleted-region
			 (buffer-substring beg end)))
	   (if (not arg) (delete-region beg end))
	   (tpu-unset-match)))
	(t
	 (tpu-error "No selection active."))))

(defun tpu-delete-current-line (num)
  "Delete one or specified number of lines after point.
This includes the newline character at the end of each line.
They are saved for the TPU-edt undelete-lines command."

	   (setq tpu-last-replaced-text (buffer-substring beg end))
	   (replace-match tpu-last-deleted-region
			  (not case-replace) (not tpu-regexp-p))
	   (tpu-unset-match)))
	(t
	 (tpu-error "No selection active."))))

(defun tpu-substitute (num)
  "Replace the selected region with the contents of the cut buffer, and
repeat most recent search.  A numeric argument serves as a repeat count.
A negative argument means replace all occurrences of the search string."

	     (if tpu-searching-forward (forward-char -1) (goto-char beg))
	     (if (= num 1) (tpu-search-internal tpu-search-last-string)
	       (tpu-search-internal-core tpu-search-last-string)))
	   (setq num (1- num))))
	(t
	 (tpu-error "No selection active."))))

(defun tpu-lm-replace (from to)
  "Interactively search for OLD-string and substitute NEW-string."
  (interactive (list (tpu-regexp-prompt "Old String: ")
		     (tpu-regexp-prompt "New String: ")))

  (let ((doit t) (strings 0))

    ;; Can't replace null strings
    (if (string= "" from) (tpu-error "No string to replace."))

    ;; Find the first occurrence
    (tpu-set-search)
    (tpu-search-internal from t)

(defun tpu-add-at-bol (text)
  "Add text to the beginning of each line in a region,
or each line in the entire buffer if no region is selected."
  (interactive
   (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
  (if (string= "" text) (tpu-error "No string specified."))
  (cond ((tpu-mark)
	 (save-excursion
	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
	   (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
	     (if (< (point) (tpu-mark)) (replace-match text))))

(defun tpu-add-at-eol (text)
  "Add text to the end of each line in a region,
or each line of the entire buffer if no region is selected."
  (interactive
   (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
  (if (string= "" text) (tpu-error "No string specified."))
  (cond ((tpu-mark)
	 (save-excursion
	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
	   (while (< (point) (tpu-mark))
	     (end-of-line)

(defun tpu-goto-percent (perc)
  "Move point to ARG percentage of the buffer."
  (interactive "NGoto-percentage: ")
  (if (or (> perc 100) (< perc 0))
      (tpu-error "Percentage %d out of range 0 < percent < 100." perc)
    (goto-char (/ (* (point-max) perc) 100))))

(defun tpu-beginning-of-window nil
  "Move cursor to top of window."
  (interactive)

    (goto-char (point-min))
    (beep)
    (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
	 (condition-case conditions
             (copy-file oldname newname)
	   (tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
    (kill-buffer "*TPU-Notice*")))


;;;
;;;  Start and Stop TPU-edt