Mercurial > hg > xemacs-beta
annotate lisp/auto-show.el @ 5940:c608d4b0b75e cygwin64 tip
rescue lost branch from 64bit.backup
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Thu, 16 Dec 2021 18:48:58 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; auto-show.el --- perform automatic horizontal scrolling as point moves |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 ;; This file is in the public domain. | |
| 5 | |
| 6 ;; Author: Pete Ware <ware@cis.ohio-state.edu> | |
| 7 ;; Maintainer: XEmacs Development Team | |
| 8 ;; Keywords: extensions, internal, dumped | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Synched up with: Emacs/Mule zeta. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; This file is dumped with XEmacs. | |
| 30 | |
| 31 ;; Modified by: Ben Wing <ben@xemacs.org> | |
| 32 | |
| 33 ;; This file provides functions that | |
| 34 ;; automatically scroll the window horizontally when the point moves | |
| 35 ;; off the left or right side of the window. | |
| 36 | |
| 37 ;; Once this library is loaded, automatic horizontal scrolling | |
| 38 ;; occurs whenever long lines are being truncated. | |
| 39 ;; To request truncation of long lines, set the variable | |
| 40 ;; Setting the variable `truncate-lines' to non-nil. | |
| 41 ;; You can do this for all buffers as follows: | |
| 42 ;; | |
| 43 ;; (set-default 'truncate-lines t) | |
| 44 | |
| 45 ;; Here is how to do it for C mode only: | |
| 46 ;; | |
| 47 ;; (set-default 'truncate-lines nil) ; this is the original value | |
| 48 ;; (defun my-c-mode-hook () | |
| 49 ;; "Run when C-mode starts up. Changes ..." | |
| 50 ;; ... set various personal preferences ... | |
| 51 ;; (setq truncate-lines t)) | |
| 52 ;; (add-hook 'c-mode-hook 'my-c-mode-hook) | |
| 53 ;; | |
| 54 ;; | |
| 55 ;; As a finer level of control, you can still have truncated lines but | |
| 56 ;; without the automatic horizontal scrolling by setting the buffer | |
| 57 ;; local variable `auto-show-mode' to nil. The default value is t. | |
| 58 ;; The command `auto-show-mode' toggles the value of the variable | |
| 59 ;; `auto-show-mode'. | |
| 60 | |
| 61 ;;; Code: | |
| 62 | |
| 63 (defgroup auto-show nil | |
| 64 "Perform automatic horizontal scrolling as point moves." | |
| 65 :group 'display | |
| 66 :group 'extensions) | |
| 67 | |
| 68 ;; This is preloaded, so we don't need special :set, :require, etc. | |
| 69 (defcustom auto-show-mode t | |
| 70 "*Non-nil enables automatic horizontal scrolling, when lines are truncated. | |
| 71 The default value is t. To change the default, do this: | |
| 72 (set-default 'auto-show-mode nil) | |
| 73 See also command `auto-show-mode'. | |
| 74 This variable has no effect when lines are not being truncated. | |
| 75 This variable is automatically local in each buffer where it is set." | |
| 76 :type 'boolean | |
| 77 :group 'auto-show) | |
| 78 | |
| 79 (make-variable-buffer-local 'auto-show-mode) | |
| 80 | |
| 81 (defcustom auto-show-shift-amount 8 | |
| 82 "*Extra columns to scroll. for automatic horizontal scrolling." | |
| 83 :type 'integer | |
| 84 :group 'auto-show) | |
| 85 | |
| 86 (defcustom auto-show-show-left-margin-threshold 50 | |
| 87 "*Threshold column for automatic horizontal scrolling to the right. | |
| 88 If point is before this column, we try to scroll to make the left margin | |
| 89 visible. Setting this to 0 disables this feature." | |
| 90 :type 'number | |
| 91 :group 'auto-show) | |
| 92 | |
| 93 (defun auto-show-mode (arg) | |
| 94 "Turn automatic horizontal scroll mode on or off. | |
| 95 With arg, turn auto scrolling on if arg is positive, off otherwise. | |
| 96 This mode is enabled or disabled for each buffer individually. | |
| 97 It takes effect only when `truncate-lines' is non-nil." | |
| 98 (interactive "P") | |
| 99 (setq auto-show-mode | |
| 100 (if (null arg) | |
| 101 (not auto-show-mode) | |
| 102 (> (prefix-numeric-value arg) 0)))) | |
| 103 | |
| 104 ;; XEmacs addition: | |
| 105 (defvar auto-show-inhibiting-commands | |
| 106 '(scrollbar-char-left | |
| 107 scrollbar-char-right | |
| 108 scrollbar-page-left | |
| 109 scrollbar-page-right | |
| 110 scrollbar-to-left | |
| 111 scrollbar-to-right | |
| 112 scrollbar-horizontal-drag) | |
| 113 "Commands that inhibit auto-show behavior. | |
| 114 This normally includes the horizontal scrollbar commands.") | |
| 115 | |
| 116 ;; XEmacs addition: | |
| 117 (defun auto-show-should-take-action-p () | |
| 118 (and auto-show-mode (window-truncated-p) | |
| 119 (equal (window-buffer) (current-buffer)) | |
| 120 (not (memq this-command auto-show-inhibiting-commands)))) | |
| 121 | |
| 122 ;; XEmacs addition: | |
| 123 (defun auto-show-make-region-visible (start end) | |
| 124 "Move point in such a way that the region (START, END) is visible. | |
| 125 This only does anything if auto-show-mode is enabled, and it doesn't | |
| 126 actually do any horizontal scrolling; rather, it just sets things up so | |
| 127 that the region will be visible when `auto-show-make-point-visible' | |
| 128 is next called (this happens after every command)." | |
| 129 (if (auto-show-should-take-action-p) | |
| 130 (let* ((scroll (window-hscroll)) ;how far window is scrolled | |
| 131 (w-width (- (window-width) | |
| 132 (if (> scroll 0) | |
| 133 2 1))) ;how wide window is on the screen | |
| 134 (right-col (+ scroll w-width)) | |
| 135 (start-col (save-excursion (goto-char start) (current-column))) | |
| 136 (end-col (save-excursion (goto-char end) (current-column)))) | |
| 137 (cond ((and (>= start-col scroll) | |
| 138 (<= end-col right-col)) | |
| 139 ;; already completely visible | |
| 140 nil) | |
| 141 ((< start-col scroll) | |
| 142 (scroll-right (- scroll start-col))) | |
| 143 (t | |
| 144 (scroll-left (- end-col right-col))))))) | |
| 145 | |
| 146 (defun auto-show-make-point-visible (&optional ignore-arg) | |
| 147 "Scroll horizontally to make point visible, if that is enabled. | |
| 148 This function only does something if `auto-show-mode' is non-nil | |
| 149 and longlines are being truncated in the selected window. | |
| 150 See also the command `auto-show-mode'." | |
| 151 (interactive) | |
| 152 ;; XEmacs change | |
| 153 (if (auto-show-should-take-action-p) | |
| 154 (let* ((col (current-column)) ;column on line point is at | |
| 155 (scroll (window-hscroll)) ;how far window is scrolled | |
| 156 (w-width (- (window-width) | |
| 157 (if (> scroll 0) | |
| 158 2 1))) ;how wide window is on the screen | |
| 159 (right-col (+ scroll w-width))) | |
| 160 (if (and (< col auto-show-show-left-margin-threshold) | |
| 161 (< col (window-width)) | |
| 162 (> scroll 0)) | |
| 163 (scroll-right scroll) | |
| 164 (if (< col scroll) ;to the left of the screen | |
| 165 (scroll-right (+ (- scroll col) auto-show-shift-amount)) | |
| 166 (if (or (> col right-col) ;to the right of the screen | |
| 167 (and (= col right-col) | |
| 168 (not (eolp)))) | |
| 169 (scroll-left (+ auto-show-shift-amount | |
| 170 (- col (+ scroll w-width)))))))))) | |
| 171 | |
| 172 ;; XEmacs change: | |
| 173 ;; #### instead of this, we kludgily call it from the C code, to make sure | |
| 174 ;; that it's done after any other things on post-command-hook (which might | |
| 175 ;; move point). | |
| 176 ;; Do auto-scrolling after commands. | |
| 177 ;;(add-hook 'post-command-hook 'auto-show-make-point-visible) | |
| 178 | |
| 179 ;; If being dumped, turn it on right away. | |
| 180 (when (boundp 'pureload) | |
| 181 (auto-show-mode 1)) | |
| 182 | |
| 183 ;; Do auto-scrolling in comint buffers after process output also. | |
| 184 ; XEmacs -- don't do this now, it messes up comint. | |
| 185 ;(add-hook 'comint-output-filter-functions 'auto-show-make-point-visible t) | |
| 186 | |
| 187 (provide 'auto-show) | |
| 188 | |
| 189 ;;; auto-show.el ends here |