diff options
| author | Stefan Monnier | 2007-08-06 16:20:10 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2007-08-06 16:20:10 +0000 |
| commit | f2b189796cf660c7cc06a6fb8b9f59295594b77b (patch) | |
| tree | 45a5e8deaff3960cde05d1aa600282996bcfc2dc | |
| parent | 1f3d1bea39b05c380032b80343445b8a1af20429 (diff) | |
| download | emacs-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/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/emulation/tpu-extras.el | 70 |
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 @@ | |||
| 1 | 2007-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 | |||
| 1 | 2007-08-06 Michael Albinus <michael.albinus@gmx.de> | 9 | 2007-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. | ||
| 406 | In Auto Fill mode, can break the preceding line if no numeric arg. | ||
| 407 | This 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'." |
| 416 | Indentation is done using the current indent-line-function. | ||
| 417 | In programming language modes, this is the same as TAB. | ||
| 418 | In some text modes, where TAB inserts a tab, this indents | ||
| 419 | to the specified left-margin column. This is the TPU-edt | ||
| 420 | version 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 |