Mercurial > emacs
comparison lisp/emulation/tpu-extras.el @ 78424:439c49b198b0
(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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 06 Aug 2007 16:20:10 +0000 |
parents | ac0efac52065 |
children | ced2db270723 30d1e922e79c 424b655804ca |
comparison
equal
deleted
inserted
replaced
78423:ca1e15221b34 | 78424:439c49b198b0 |
---|---|
139 ;;; Hooks -- Set cursor free in picture mode. | 139 ;;; Hooks -- Set cursor free in picture mode. |
140 ;;; Clean up when writing a file from cursor free mode. | 140 ;;; Clean up when writing a file from cursor free mode. |
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 |
154 | 152 |
155 (defun tpu-top-check (beg lines) | 153 (defun tpu-top-check (beg lines) |
244 (picture-end-of-line (- 1 num))) | 242 (picture-end-of-line (- 1 num))) |
245 (t | 243 (t |
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))) |
253 (if tpu-cursor-free (picture-end-of-line) (end-of-line)) | 251 (if tpu-cursor-free (picture-end-of-line) (end-of-line)) |
254 (if (= beg (point)) (message "You are already at the end of a line.")))) | 252 (if (= beg (point)) (message "You are already at the end of a line.")))) |
390 (and (> (point) bottom) (recenter bottom-margin)))) | 388 (and (> (point) bottom) (recenter bottom-margin)))) |
391 (and (< (point) top) (recenter (min beg top-margin)))))) | 389 (and (< (point) top) (recenter (min beg top-margin)))))) |
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. | 403 (let ((beg (tpu-current-line))) |
417 In programming language modes, this is the same as TAB. | 404 ad-do-it |
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))) | |
423 (tpu-old-newline-and-indent) | |
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 |
433 ;;; Function to set scroll margins | 414 ;;; Function to set scroll margins |
434 | 415 |
438 (interactive | 419 (interactive |
439 "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ | 420 "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ |
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%%" |
458 tpu-top-scroll-margin tpu-bottom-scroll-margin))) | 442 tpu-top-scroll-margin tpu-bottom-scroll-margin))) |
459 | 443 |
460 | 444 |
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) |
468 (substitute-key-definition 'tpu-set-cursor-free | 452 (substitute-key-definition 'tpu-set-cursor-free |
469 'tpu-set-cursor-bound | 453 'tpu-set-cursor-bound |
470 GOLD-map) | 454 GOLD-map) |
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) |
478 (setq tpu-cursor-free nil) | 462 (setq tpu-cursor-free nil) |
479 (substitute-key-definition 'tpu-set-cursor-bound | 463 (substitute-key-definition 'tpu-set-cursor-bound |
480 'tpu-set-cursor-free | 464 'tpu-set-cursor-free |
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 |