(defun tpu-reset-screen-size (height width)
"Sets the screen size."
(interactive "nnew screen height: \nnnew screen width: ")
- (set-screen-height height)
- (set-screen-width width))
+ (set-frame-height (selected-frame) height)
+ (set-frame-width (selected-frame) width))
(defun tpu-toggle-newline-and-indent nil
"Toggle between 'newline and indent' and 'simple newline'."
(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)))))
+ (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."
;;; Command and Function Aliases
;;;
;;;###autoload
-(fset 'tpu-edt-mode 'tpu-edt-on)
-(fset 'TPU-EDT-MODE 'tpu-edt-on)
+(defalias 'tpu-edt-mode 'tpu-edt-on)
+(defalias 'TPU-EDT-MODE 'tpu-edt-on)
;;;###autoload
-(fset 'tpu-edt 'tpu-edt-on)
-(fset 'TPU-EDT 'tpu-edt-on)
+(defalias 'tpu-edt 'tpu-edt-on)
+(defalias 'TPU-EDT 'tpu-edt-on)
-(fset 'exit 'tpu-exit)
-(fset 'EXIT 'tpu-exit)
+;; Note: The following functions have no `tpu-' prefix. This is unavoidable.
+;; The real TPU/edt editor has interactive commands with these names,
+;; so tpu-edt.el users expect things like M-x exit RET and M-x help RET
+;; to work. Therefore it really is necessary to define these functions,
+;; even in cases where they redefine existing Emacs functions.
-(fset 'Get 'tpu-get)
-(fset 'GET 'tpu-get)
+(defalias 'exit 'tpu-exit)
+(defalias 'EXIT 'tpu-exit)
-(fset 'include 'tpu-include)
-(fset 'INCLUDE 'tpu-include)
+(defalias 'Get 'tpu-get)
+(defalias 'GET 'tpu-get)
-(fset 'quit 'tpu-quit)
-(fset 'QUIT 'tpu-quit)
+(defalias 'include 'tpu-include)
+(defalias 'INCLUDE 'tpu-include)
-(fset 'spell 'tpu-spell-check)
-(fset 'SPELL 'tpu-spell-check)
+(defalias 'quit 'tpu-quit)
+(defalias 'QUIT 'tpu-quit)
-(fset 'what\ line 'tpu-what-line)
-(fset 'WHAT\ LINE 'tpu-what-line)
+(defalias 'spell 'tpu-spell-check)
+(defalias 'SPELL 'tpu-spell-check)
-(fset 'replace 'tpu-lm-replace)
-(fset 'REPLACE 'tpu-lm-replace)
+(defalias 'what\ line 'tpu-what-line)
+(defalias 'WHAT\ LINE 'tpu-what-line)
-;; 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)
+(defalias 'replace 'tpu-lm-replace)
+(defalias 'REPLACE 'tpu-lm-replace)
-(fset 'set\ cursor\ free 'tpu-set-cursor-free)
-(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
+(defalias 'help 'tpu-help)
+(defalias 'HELP 'tpu-help)
-(fset 'set\ cursor\ bound 'tpu-set-cursor-bound)
-(fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
+(defalias 'set\ cursor\ free 'tpu-set-cursor-free)
+(defalias 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
-(fset 'set\ scroll\ margins 'tpu-set-scroll-margins)
-(fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
+(defalias 'set\ cursor\ bound 'tpu-set-cursor-bound)
+(defalias 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
+
+(defalias 'set\ scroll\ margins 'tpu-set-scroll-margins)
+(defalias 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
+
+;; Real TPU error messages end in periods.
+;; Define this to avoid openly flouting Emacs coding standards.
+(defalias 'tpu-error 'error)
;; Around emacs version 18.57, function line-move was renamed to
(interactive)
(let ((list (tpu-make-file-buffer-list (buffer-list))))
(setq list (delq (current-buffer) list))
- (if (not list) (error "No other buffers."))
+ (if (not list) (tpu-error "No other buffers."))
(switch-to-buffer (car (reverse list)))))
(defun tpu-make-file-buffer-list (buffer-list)
(delete-region beg end)
(tpu-unset-match)))
(t
- (error "No selection active."))))
+ (tpu-error "No selection active."))))
(defun tpu-store-text nil
"Copy the selected region to the cut buffer without deleting it.
(buffer-substring (tpu-match-beginning) (tpu-match-end)))
(tpu-unset-match))
(t
- (error "No selection active."))))
+ (tpu-error "No selection active."))))
(defun tpu-cut (arg)
"Copy selected region to the cut buffer. In the absence of an
(if (not arg) (delete-region beg end))
(tpu-unset-match)))
(t
- (error "No selection active."))))
+ (tpu-error "No selection active."))))
(defun tpu-delete-current-line (num)
"Delete one or specified number of lines after point.
(defun tpu-delete-to-eol (num)
"Delete text up to end of line.
-With argument, delete up to to Nth line-end past point.
+With argument, delete up to the Nth line-end past point.
They are saved for the TPU-edt undelete-lines command."
(interactive "p")
(let ((beg (point)))
(defun tpu-delete-to-bol (num)
"Delete text back to beginning of line.
-With argument, delete up to to Nth line-end past point.
+With argument, delete up to the Nth line-end past point.
They are saved for the TPU-edt undelete-lines command."
(interactive "p")
(let ((beg (point)))
(not case-replace) (not tpu-regexp-p))
(tpu-unset-match)))
(t
- (error "No selection active."))))
+ (tpu-error "No selection active."))))
(defun tpu-substitute (num)
"Replace the selected region with the contents of the cut buffer, and
(tpu-search-internal-core tpu-search-last-string)))
(setq num (1- num))))
(t
- (error "No selection active."))))
+ (tpu-error "No selection active."))))
(defun tpu-lm-replace (from to)
"Interactively search for OLD-string and substitute NEW-string."
(let ((doit t) (strings 0))
;; Can't replace null strings
- (if (string= "" from) (error "No string to replace."))
+ (if (string= "" from) (tpu-error "No string to replace."))
;; Find the first occurrence
(tpu-set-search)
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."))
+ (if (string= "" text) (tpu-error "No string specified."))
(cond ((tpu-mark)
(save-excursion
(if (> (point) (tpu-mark)) (exchange-point-and-mark))
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."))
+ (if (string= "" text) (tpu-error "No string specified."))
(cond ((tpu-mark)
(save-excursion
(if (> (point) (tpu-mark)) (exchange-point-and-mark))
"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)
+ (tpu-error "Percentage %d out of range 0 < percent < 100." perc)
(goto-char (/ (* (point-max) perc) 100))))
(defun tpu-beginning-of-window nil
(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)))))
+ (tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
(kill-buffer "*TPU-Notice*")))
(provide 'tpu-edt)
+;;; arch-tag: f3dfe61c-2cbd-4f73-b9cc-eb215020b857
;;; tpu-edt.el ends here
HCoop / bpt / emacs.git / blobdiff