aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-08-06 16:20:10 +0000
committerStefan Monnier2007-08-06 16:20:10 +0000
commitf2b189796cf660c7cc06a6fb8b9f59295594b77b (patch)
tree45a5e8deaff3960cde05d1aa600282996bcfc2dc
parent1f3d1bea39b05c380032b80343445b8a1af20429 (diff)
downloademacs-f2b189796cf660c7cc06a6fb8b9f59295594b77b.tar.gz
emacs-f2b189796cf660c7cc06a6fb8b9f59295594b77b.zip
(tpu-before-save-hook): Rename from tpu-write-file-hook.
Activate it with add-hook on buffer-save-hook. (newline, newline-and-indent, do-auto-fill): Use advice instead of redefining the function. (tpu-set-scroll-margins): Activate the pieces of advice.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/emulation/tpu-extras.el70
2 files changed, 36 insertions, 44 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0f94bcb9f1d..079f60d281c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12007-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emulation/tpu-extras.el (tpu-before-save-hook): Rename from
4 tpu-write-file-hook. Activate it with add-hook on buffer-save-hook.
5 (newline, newline-and-indent, do-auto-fill): Use advice instead of
6 redefining the function.
7 (tpu-set-scroll-margins): Activate the pieces of advice.
8
12007-08-06 Michael Albinus <michael.albinus@gmx.de> 92007-08-06 Michael Albinus <michael.albinus@gmx.de>
2 10
3 * net/ange-ftp.el (ange-ftp-hook-function): Catch also errors in 11 * net/ange-ftp.el (ange-ftp-hook-function): Catch also errors in
@@ -12,7 +20,7 @@
12 20
13 * term.el: Honor term-default-fg-color and term-default-bg-color 21 * term.el: Honor term-default-fg-color and term-default-bg-color
14 settings when modifying term-current-face. 22 settings when modifying term-current-face.
15 (term-default-fg-color, term-default-bg-color): Initialized from 23 (term-default-fg-color, term-default-bg-color): Initialize from
16 default term-current-face. 24 default term-current-face.
17 (term-mode, term-reset-terminal): Set term-current-face with 25 (term-mode, term-reset-terminal): Set term-current-face with
18 term-default-fg-color and term-default-bg-color. 26 term-default-fg-color and term-default-bg-color.
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 019896c0eb2..609ce2e203b 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -141,13 +141,11 @@ the previous line when starting from a line beginning."
141 141
142(add-hook 'picture-mode-hook 'tpu-set-cursor-free) 142(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
143 143
144(defun tpu-write-file-hook nil 144(defun tpu-before-save-hook ()
145 "Eliminate whitespace at ends of lines, if the cursor is free." 145 "Eliminate whitespace at ends of lines, if the cursor is free."
146 (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) 146 (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends)))
147 147
148(or (memq 'tpu-write-file-hook write-file-functions) 148(add-hook 'before-save-hook 'tpu-before-save-hook)
149 (setq write-file-functions
150 (cons 'tpu-write-file-hook write-file-functions)))
151 149
152 150
153;;; Utility routines for implementing scroll margins 151;;; Utility routines for implementing scroll margins
@@ -246,7 +244,7 @@ Accepts a prefix argument for the number of lines to move."
246 (end-of-line (- 1 num)))) 244 (end-of-line (- 1 num))))
247 (tpu-top-check beg num))) 245 (tpu-top-check beg num)))
248 246
249(defun tpu-current-end-of-line nil 247(defun tpu-current-end-of-line ()
250 "Move point to end of current line." 248 "Move point to end of current line."
251 (interactive) 249 (interactive)
252 (let ((beg (point))) 250 (let ((beg (point)))
@@ -392,41 +390,24 @@ A repeat count means scroll that many sections."
392 390
393 391
394 392
395;;; Replace the newline, newline-and-indent, and do-auto-fill functions 393;; Advise the newline, newline-and-indent, and do-auto-fill functions.
396 394(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
397(or (fboundp 'tpu-old-newline) 395 "Respect `tpu-bottom-scroll-margin'."
398 (fset 'tpu-old-newline (symbol-function 'newline))) 396 (let ((beg (tpu-current-line))
399(or (fboundp 'tpu-old-do-auto-fill) 397 (num (prefix-numeric-value (ad-get-arg 0))))
400 (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill))) 398 ad-do-it
401(or (fboundp 'tpu-old-newline-and-indent)
402 (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent)))
403
404(defun newline (&optional num)
405 "Insert a newline. With arg, insert that many newlines.
406In Auto Fill mode, can break the preceding line if no numeric arg.
407This is the TPU-edt version that respects the bottom scroll margin."
408 (interactive "p")
409 (let ((beg (tpu-current-line)))
410 (or num (setq num 1))
411 (tpu-old-newline num)
412 (tpu-bottom-check beg num))) 399 (tpu-bottom-check beg num)))
413 400
414(defun newline-and-indent nil 401(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
415 "Insert a newline, then indent according to major mode. 402 "Respect `tpu-bottom-scroll-margin'."
416Indentation is done using the current indent-line-function.
417In programming language modes, this is the same as TAB.
418In some text modes, where TAB inserts a tab, this indents
419to the specified left-margin column. This is the TPU-edt
420version that respects the bottom scroll margin."
421 (interactive)
422 (let ((beg (tpu-current-line))) 403 (let ((beg (tpu-current-line)))
423 (tpu-old-newline-and-indent) 404 ad-do-it
424 (tpu-bottom-check beg 1))) 405 (tpu-bottom-check beg 1)))
425 406
426(defun do-auto-fill nil 407(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
427 "TPU-edt version that respects the bottom scroll margin." 408 "Respect `tpu-bottom-scroll-margin'."
428 (let ((beg (tpu-current-line))) 409 (let ((beg (tpu-current-line)))
429 (tpu-old-do-auto-fill) 410 ad-do-it
430 (tpu-bottom-check beg 1))) 411 (tpu-bottom-check beg 1)))
431 412
432 413
@@ -440,18 +421,21 @@ version that respects the bottom scroll margin."
440\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") 421\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
441 ;; set top scroll margin 422 ;; set top scroll margin
442 (or (string= top "") 423 (or (string= top "")
443 (if (string= "%" (substring top -1)) 424 (setq tpu-top-scroll-margin
444 (setq tpu-top-scroll-margin (string-to-number top)) 425 (if (string= "%" (substring top -1))
445 (setq tpu-top-scroll-margin 426 (string-to-number top)
446 (/ (1- (+ (* (string-to-number top) 100) (window-height))) 427 (/ (1- (+ (* (string-to-number top) 100) (window-height)))
447 (window-height))))) 428 (window-height)))))
448 ;; set bottom scroll margin 429 ;; set bottom scroll margin
449 (or (string= bottom "") 430 (or (string= bottom "")
450 (if (string= "%" (substring bottom -1)) 431 (setq tpu-bottom-scroll-margin
451 (setq tpu-bottom-scroll-margin (string-to-number bottom)) 432 (if (string= "%" (substring bottom -1))
452 (setq tpu-bottom-scroll-margin 433 (string-to-number bottom)
453 (/ (1- (+ (* (string-to-number bottom) 100) (window-height))) 434 (/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
454 (window-height))))) 435 (window-height)))))
436 (dolist (f '(newline newline-and-indent do-auto-fill))
437 (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
438 (ad-activate f))
455 ;; report scroll margin settings if running interactively 439 ;; report scroll margin settings if running interactively
456 (and (interactive-p) 440 (and (interactive-p)
457 (message "Scroll margins set. Top = %s%%, Bottom = %s%%" 441 (message "Scroll margins set. Top = %s%%, Bottom = %s%%"
@@ -461,7 +445,7 @@ version that respects the bottom scroll margin."
461;;; Functions to set cursor bound or free 445;;; Functions to set cursor bound or free
462 446
463;;;###autoload 447;;;###autoload
464(defun tpu-set-cursor-free nil 448(defun tpu-set-cursor-free ()
465 "Allow the cursor to move freely about the screen." 449 "Allow the cursor to move freely about the screen."
466 (interactive) 450 (interactive)
467 (setq tpu-cursor-free t) 451 (setq tpu-cursor-free t)
@@ -471,7 +455,7 @@ version that respects the bottom scroll margin."
471 (message "The cursor will now move freely about the screen.")) 455 (message "The cursor will now move freely about the screen."))
472 456
473;;;###autoload 457;;;###autoload
474(defun tpu-set-cursor-bound nil 458(defun tpu-set-cursor-bound ()
475 "Constrain the cursor to the flow of the text." 459 "Constrain the cursor to the flow of the text."
476 (interactive) 460 (interactive)
477 (tpu-trim-line-ends) 461 (tpu-trim-line-ends)
@@ -481,5 +465,5 @@ version that respects the bottom scroll margin."
481 GOLD-map) 465 GOLD-map)
482 (message "The cursor is now bound to the flow of your text.")) 466 (message "The cursor is now bound to the flow of your text."))
483 467
484;;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a 468;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
485;;; tpu-extras.el ends here 469;;; tpu-extras.el ends here