*** empty log message ***
[bpt/emacs.git] / lisp / textmodes / two-column.el
CommitLineData
72c0ae01
ER
1;;; two-column.el --- minor mode for editing of two-column text
2
eea8d4ef
ER
3;; Copyright (C) 1992 Free Software Foundation, Inc.
4
72c0ae01 5;; Author: Daniel Pfeiffer <pfeiffer@cix.cict.fr>
72c0ae01
ER
6;; Adapted-By: ESR
7
72c0ae01
ER
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 1, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24;;; Commentary:
25
26;; --8<---- two-column.el ----8<--------8<--------8<--------8<--------8<-------
27;; Esperanto: English:
28
29;; Minora modalo por samtempa dukolumna Minor mode for simultaneous
30;; tajpado two-column editing
31
32;; ^Ci dataro estas ero de GNU Emacs. This file is part of GNU Emacs.
33
34;; GNU Emacs estas disdonata en la GNU Emacs is distributed in the hope
35;; espero ke ^gi estos utila, sed SEN that it will be useful, but WITHOUT
36;; IA GARANTIO. Neniu a^utoro a^u ANY WARRANTY. No author or
37;; disdonanto akceptas respondecon al distributor accepts responsibility
38;; iu ajn por la sekvoj de ^gia uzado, to anyone for the consequences of
39;; a^u ^cu ^gi serveblas al iu celo, using it or for whether it serves
40;; a^u e^c entute funkcias, se li ni any particular purpose or works at
41;; estas skribinta tion. Vidu la GNU all, unless he says so in writing.
42;; Emacs ^Generala Publika Licenco por Refer to the GNU Emacs General
43;; plenaj detaloj. Public License for full details.
44
45;; ^Ciu rajtas kopii, modifi kaj ree Everyone is granted permission to
46;; disdoni GNU Emacs, sed nur sub la copy, modify and redistribute GNU
47;; condi^coj priskribitaj en la GNU Emacs, but only under the conditions
48;; Emacs ^Generala Publika Licenco. described in the GNU Emacs General
49;; Kopio de tiu licenso estas supozata Public License. A copy of this
50;; donita al vi kune kun GNU Emacs, por license is supposed to have been
51;; ke vi sciu viajn rajtojn kaj given to you along with GNU Emacs so
52;; respondecojn. ^Gi devus esti en you can know your rights and
53;; dataro nomata COPYING. Inter responsibilities. It should be in a
54;; alia^joj, la notico pri kopirajto file named COPYING. Among other
55;; kaj ^ci notico devas esti gardata things, the copyright notice and
56;; sur ^ciuj kopioj. this notice must be preserved on all
57;; copies.
58
59
60;; Tiu minora modalo ebligas al vi This minor mode allows you to
61;; tajpi sendepende en du apudaj independently edit two adjacent
62;; bufroj. Vi havas tri eblecojn por buffers. You have three ways to
63;; eki ^gin. ^Ciu donas al vi start it up. Each gives you a
64;; horizontale disigatan fenestron, horizontally split window similar to
65;; simila al fina apareco de via the final outcome of your text:
66;; teksto:
67
68;; C-x 6 2 asocias novan bufron nomatan associates a new buffer called
69;; same, sed kun 2C/ anta^u. the same, but with 2C/
70;; prepended.
71
72;; C-x 6 b asocias alian bufron. Vi povas associates another buffer.
73;; anka^u asocii dataron, se vi This can be used to associate a
74;; ^jus anta^ue faris C-x C-f. file if you just did C-x C-f.
75
76;; C-x 6 u disigas jam dukolumnan tekston unmerges a two-column text into
77;; en du bufroj ekde la nuna two buffers from the current
78;; linio, kaj je la nuna kolumno. line and at the current column.
79;; La anta^uaj signoj (ofte The preceding characters (often
80;; tabeligilo a^u |) estas la tab or |) are the column
81;; kolumna disiganto. Linioj kiuj separator. Lines that don't
82;; ne enhavas ilin ne estas have them won't be separated.
83;; disigitaj. Kiel la kvara kaj Like the fourth and fifth line
84;; la kvina linio se vi disigas if you unmerge this file from
85;; ^ci dataron ekde la unua angla the first english word.
86;; vorto.
87
88;; Je ^cia flanko estas bufro, kiu On each side is a buffer that knows
89;; konas la alian. Kun la ordonoj C-x about the other. With the commands
90;; 6 SPC, C-x 6 DEL kaj C-x 6 RET oni C-x 6 SPC, C-x 6 DEL and C-x 6 RET
91;; povas suben- a^u supreniri unu you can simultaneously scroll up or
92;; ekranon, kaj subeniri linion, down by a screenfull and by a line
93;; samtempe en la du bufroj. Al la alia in both buffers. Empty lines are
94;; bufro estas aldonataj linioj se added to the other buffer if
95;; necesas, por ke vi vidu la saman necessary, so that you see the same
96;; parton. Per C-x 6 C-l vi povas part. With C-x 6 C-l you can
97;; recentrigi la linion. Kiam vi nur recenter the line. When you only
98;; plu havas unu el la du bufroj have one of the two buffers onscreen
99;; surekrane vi revidos la alian per you can get the other back with C-x
100;; denove C-x 6 2. 6 2 once more.
101
102;; Se vi volas meti longajn liniojn If you include long lines, i.e which
103;; (ekz. programerojn) en la kunigotan will span both columns (eg. source
104;; tekston, ili devas esti en la code), they should be in what will
105;; estonte unua kolumno. La alia devas be the first column, with the
106;; havi malplenajn linion apud ili. associated buffer having empty lines
107;; next to them.
108
109;; Averto: en Emacs kiam vi ^san^gas la Attention: in Emacs when you change
110;; ma^joran modalon, la minoraj modaloj the major mode, the minor modes are
111;; estas anka^u elmemorigitaj. Tiu- also purged from memory. In that
112;; okaze vi devas religi la du bufrojn case you must reassociate the two
113;; per iu C-x 6-ordono, ekz. C-x 6 b. buffers with any C-x 6-command, e.g.
114;; C-x 6 b.
115
116;; Kiam vi estos kontenta de la When you have edited both buffers to
117;; rezulto, vi kunmetos la du kolumnojn your content, you merge them with
118;; per C-x 6 1. Se vi poste vidas C-x 6 1. If you then see a problem,
119;; problemon, vi neniigu la kunmeton you undo the merge with C-x u and
120;; per C-x u kaj plue modifu la du continue to edit the two buffers.
121;; bufrojn. Kiam vi ne plu volas tajpi When you no longer want to edit in
122;; dukolumne, vi eliru el la minora two columns, you turn off the minor
123;; modalo per C-x 6 k. mode with C-x 6 k.
124
125
126;; An^stata^u tri `autoload' kaj tri | Instead of three `autoload' and
127;; `global-set-key' vi povas uzi la | three `global-set-key' you can use
128;; jenon en via dataro ~/.emacs, por | the following in your file
129;; memstare ^car^gi la modalon: | ~/.emacs, to automatically load
130;; | the mode:
131
132;; (global-set-key "\C-x6"
133;; '(lambda () (interactive)
134;; (load-library "two-column")
135;; (call-interactively
136;; (cdr (assq (read-char) tc-mode-map)))))
137
138;; Se vi ^satus havi la dukolumnajn | If you'd like to have the
139;; ordonojn je funkciklavo <f2>, vi | two-column commands on function
140;; povas uzi la jenon en via dataro | key <f2>, you can use the
141;; ~/.emacs: | following in your file ~/.emacs:
142
143;; (define-key function-keymap "\^b"
144;; '(lambda () (interactive)
145;; (load-library "two-column")
146;; (define-key function-keymap "\^b" tc-mode-map)
147;; (call-interactively
148;; (cdr (assq (read-char) tc-mode-map)))))
149
150;; In addition to two-column editing of text, for example for writing a
151;; bilingual text side-by-side as shown below in the file's prolog, other
152;; interesting uses have been found for this minor mode:
153;;
154;;
155;; You can separate the columns with {+} C-x 6 u or <f2> u if you prefer
156;; any string that pleases you, by {+} handles these with a prefix argument
157;; setting tc-separator. For {+} that enables you to declare the
158;; example "{+} " if you like to {+} desired length of such a string.
159;; amuse yourself.
160;;
161;;
162;; keyword You can write any text corresponding to a
163;; given keyword in a filled paragraph next to
164;; it. Note that the width of the first column
165;; may be less than window-min-width in the
166;; result, but will be displayed at that width.
167;;
168;; another This is not a three- or multi-column mode.
169;; The example in the file's prolog required
170;; working on two columns and then treating the
171;; result as one column in order to add the
172;; third.
173;;
174;;
175;; Programmers might like the ability to split off the comment column of
176;; a file that looks like the following. The advantage is that with
177;; (setq fill-prefix "-- ") you can run M-q (fill-paragraph) on the
178;; comment. The problem is, code quickly gets rather wide, so you need
179;; to use a narrower comment column, which is less interesting, unless
180;; you have a 132-column screen. Code lines that reach beyond
181;; comment-column are no problem, except that you won't always see their
182;; end during editing.
183;;
184;; BEGIN -- This is just some meaningless
185;; FOR i IN 1..10 LOOP -- code in Ada, that runs foobar
186;; foobar( i ); -- once for each argument from one
187;; END LOOP; -- to ten, and then we're already
188;; END; -- through with it.
189;;
190;; Better yet, you can put the point before "This", type M-3 C-x 6 u
191;; which makes "-- " the separator between a no-comments Ada buffer, and
192;; a plain text comment buffer. When you put them back together, every
193;; non-empty line of the 2nd column will again be preceded by "-- ".
194;;
195;;
196;; The <f2> function key hack (which is one of the rare times when
197;; function keys are mnemonic) at the end of the file's prolog requires
198;; that the lisp/term/*.el for your terminal use the standard
199;; conventions. Too bad that some don't (at least not in version 18.55).
200;; The Sun one is hopelessly non-standard, and vt2[024]0 somehow forgot
201;; to define <f1> thru <f5>. (It defines <pf1> thru <pf4> instead, but
202;; that is not what we need on an X terminal.) If you want to use those,
203;; you'll need another hack something like:
204;;
205;; (if (string= (system-name) "cix")
206;; (progn
207;; (load-library "term/vt200.el")
208;; (define-key CSI-map "12~" (cons function-keymap ?\^b)))
209;; (global-unset-key "\e[")
210;; (define-key esc-map "[225z" (cons function-keymap ?\^b)))
211;;
212;; where "cix" is the non-sun machine I use. Actually I use the same X
213;; terminal to connect to both machines, and I want to keep my ~/.emacs
214;; identical on both. Bother, the two Emacses don't recognize the same
215;; keys and assign different sequences to those they do! I sure hope all
216;; this nonsense will stop with version 19 (or preferably soon) where I'd
217;; like to be able to say (define-key some-map '<f2> some-cmd), and see
218;; <f2> rather than some unintelligible ESC-sequence in command key
219;; sequences.
220
221;;; Code:
222\f
223;;;;; variable declarations ;;;;;
224
225(provide 'two-column)
226
227(defvar tc-prefix "\C-x6"
228 "Prefix tc-mode-map gets bound to.
229If you'd like to bind it to function key <f2>, see the prolog of the
230source file, lisp/two-column.el")
231
232(defvar tc-mode-map nil
233 "Keymap that contains all commands useful with two-column minor mode.
234This gets bound globally to `tc-prefix' since minor modes have
235no local keymap.")
236
237(if tc-mode-map
238 ()
239 (setq tc-mode-map (make-sparse-keymap))
240 (define-key tc-mode-map "1" 'tc-merge)
241 (define-key tc-mode-map "2" 'tc-split)
242 (define-key tc-mode-map "b" 'tc-associate-buffer)
243 (define-key tc-mode-map "k" 'tc-kill-association)
244 (define-key tc-mode-map "\C-l" 'tc-recenter)
245 (define-key tc-mode-map "o" 'tc-associated-buffer)
246 (define-key tc-mode-map "u" 'tc-unmerge)
247 (define-key tc-mode-map "{" 'shrink-window-horizontally)
248 (define-key tc-mode-map "}" 'enlarge-window-horizontally)
249 (define-key tc-mode-map " " 'tc-scroll-up)
250 (define-key tc-mode-map "\^?" 'tc-scroll-down)
251 (define-key tc-mode-map "\C-m" 'tc-scroll-line))
252
253(global-set-key tc-prefix tc-mode-map)
254
255
256;; markers seem to be the only buffer-id not affected by renaming
257;; a buffer. This nevertheless loses when a buffer is killed.
258(defvar tc-other nil
259 "Marker to the associated buffer, if non-nil.")
260(make-variable-buffer-local 'tc-other)
261
262
263(defvar tc-buffer-list ()
264 "An alist of markers to associated buffers. (Backs up `tc-other')")
265
266(setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist))
267
268;; rearranged, so that the pertinent info will show in 40 columns
269(defvar tc-mode-line-format
270 '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
271 minor-mode-alist "%n" mode-line-process ")%]%-")
272 "*Value of mode-line-format for a buffer in two-column minor mode.")
273
274(defvar tc-separator ""
275 "*A string inserted between the two columns when merging.
276This gets set locally by \\[tc-unmerge].")
277
278(defvar tc-window-width 40
279 "*The width of the first column. (Must be at least `window-min-width')
280This value is local for every buffer that sets it.")
281(make-variable-buffer-local 'tc-window-width)
282
283(defvar tc-beyond-fill-column 4
284 "*Base for calculating `fill-column' for a buffer in two-column minor mode.
285The value of `fill-column' becomes `tc-window-width' for this buffer
286minus this value.")
287
288(defvar tc-mode-hook nil
289 "Function called, if non-nil, whenever turning on two-column minor mode.
290It can get called by \\[tc-split] (tc-split), \\[tc-unmerge] (tc-unmerge)
291and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
292\f
293;;;;; base functions ;;;;;
294
295;; the access method for the other buffer. this tries to remedy against
296;; lost local variables and lost buffers.
297(defun tc-other ()
298 (if (or tc-other
299 (setq tc-other
300 ; assoc with a different predicate, since we don't know
301 ; which marker points to this buffer
302 (let ((bl tc-buffer-list))
303 (while (and bl (not (eq (current-buffer)
304 (marker-buffer (car (car bl))))))
305 (setq bl (cdr bl)))
306 (cdr (car bl)))))
307 (or (prog1
308 (marker-buffer tc-other)
309 (setq mode-line-format tc-mode-line-format ))
310 ; The associated buffer somehow got killed.
311 (progn
312 ; The other variables may later be useful if the user
313 ; reestablishes the association.
314 (kill-local-variable 'tc-other)
315 (kill-local-variable 'mode-line-format)
316 nil))))
317
318(defun tc-split (&optional buffer)
319 "Split current window vertically for two-column editing.
320
321When called the first time, associates a buffer with the current
322buffer. Both buffers are put in two-column minor mode and
323tc-mode-hook gets called on both. These buffers remember
324about one another, even when renamed.
325
326When called again, restores the screen layout with the current buffer
327first and the associated buffer to it's right.
328
329If you include long lines, i.e which will span both columns (eg.
330source code), they should be in what will be the first column, with
331the associated buffer having empty lines next to them.
332
333You have the following commands at your disposal:
334
335\\[tc-split] Rearrange screen
336\\[tc-associate-buffer] Reassociate buffer after changing major mode
337\\[tc-scroll-up] Scroll both buffers up by a screenfull
338\\[tc-scroll-down] Scroll both buffers down by a screenful
339\\[tc-scroll-line] Scroll both buffers up by one or more lines
340\\[tc-recenter] Recenter and realign other buffer
341\\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column
342\\[tc-associated-buffer] Switch to associated buffer
343\\[tc-merge] Merge both buffers
344
345These keybindings can be customized in your ~/.emacs by `tc-prefix'
346and `tc-mode-map'.
347
348The appearance of the screen can be customized by the variables
349`tc-window-width', `tc-beyond-fill-column',
350`tc-mode-line-format' and `truncate-partial-width-windows'."
351
352 (interactive "P")
353 ; first go to full width, so that we can certainly split into
354 ; two windows
355 (if (< (window-width) (screen-width))
356 (enlarge-window 99999 t))
357 (split-window-horizontally
358 (max window-min-width (min tc-window-width
359 (- (screen-width) window-min-width))))
360 (if (tc-other)
361 (progn
362 (other-window 1)
363 (switch-to-buffer (tc-other))
364 (other-window -1)
365 ; align buffers if necessary
366 (tc-scroll-line 0))
367
368 ; set up minor mode linking two buffers
369 (setq fill-column (- tc-window-width
370 tc-beyond-fill-column)
371 mode-line-format tc-mode-line-format)
372 (run-hooks tc-mode-hook)
373 (let ((other (point-marker)))
374 (other-window 1)
375 (switch-to-buffer
376 (or buffer
377 (generate-new-buffer
378 (concat "2C/" (buffer-name)))))
379 (or buffer
380 (text-mode))
381 (setq fill-column (- tc-window-width
382 tc-beyond-fill-column)
383 mode-line-format tc-mode-line-format
384 tc-other other
385 other (point-marker))
386 (setq tc-buffer-list (cons (cons tc-other other)
387 tc-buffer-list))
388 (run-hooks tc-mode-hook)
389 (other-window -1)
390 (setq tc-buffer-list
391 (cons (cons other
392 (save-excursion
393 (set-buffer (tc-other))
394 tc-other))
395 tc-buffer-list))
396 (setq tc-other other))))
397
398(fset 'tc-mode 'tc-split)
399
400(defun tc-associate-buffer ()
401 "Associate another buffer with this one in two-column minor mode.
402Can also be used to associate a just previously visited file, by
403accepting the proposed default buffer.
404
405See \\[tc-split] and `lisp/two-column.el' for further details."
406 (interactive)
407 (let ((b1 (current-buffer))
408 (b2 (or (tc-other)
409 (read-buffer "Associate buffer: " (other-buffer)))))
410 (save-excursion
411 (setq tc-other nil)
412 (set-buffer b2)
413 (and (tc-other)
414 (not (eq b1 (tc-other)))
415 (error "Buffer already associated with buffer `%s'."
416 (buffer-name (tc-other))))
417 (setq b1 (and (assq 'tc-window-width (buffer-local-variables))
418 tc-window-width)))
419 ; if other buffer has a local width, adjust here too
420 (if b1 (setq tc-window-width (- (screen-width) b1)))
421 (tc-split b2)))
422
423(defun tc-unmerge (arg)
424 "Unmerge a two-column text into two buffers in two-column minor mode.
425The text is unmerged at the cursor's column which becomes the local
426value of tc-window-width. Only lines that have the ARG same
427preceding characters at that column get split. The ARG preceding
428characters without any leading whitespace become the local value for
429`tc-separator'. This way lines that continue across both
430columns remain untouched in the first buffer.
431
432This function can be used with a prototype line, to set up things as
433you like them. You write the first line of each column with the
434separator you like and then unmerge that line. E.g.:
435
436First column's text sSs Second columns text
437 \\___/\\
438 / \\
439 5 character Separator You type M-5 \\[tc-unmerge] with the point here
440
441See \\[tc-split] and `lisp/two-column.el' for further details."
442 (interactive "p")
443 (and (tc-other)
444 (if (y-or-n-p (concat "Overwrite associated buffer `"
445 (buffer-name (tc-other))
446 "'? "))
447 (save-excursion
448 (set-buffer (tc-other))
449 (erase-buffer))
450 (signal 'quit nil)))
451 (let ((point (point))
452 ; make next-line always come back to same column
453 (goal-column (current-column))
454 ; a counter for empty lines in other buffer
455 (n (1- (count-lines (point-min) (point))))
456 chars other)
457 (save-excursion
458 (backward-char arg)
459 (setq chars (buffer-substring (point) point))
460 (skip-chars-forward " \t" point)
461 (make-variable-buffer-local 'tc-separator)
462 (setq tc-separator (buffer-substring (point) point)
463 tc-window-width (current-column)))
464 (tc-split)
465 (setq other (tc-other))
466 ; now we're ready to actually unmerge
467 (save-excursion
468 (while (not (eobp))
469 (if (not (and (= (current-column) goal-column)
470 (string= chars
471 (buffer-substring (point)
472 (save-excursion
473 (backward-char arg)
474 (point))))))
475 (setq n (1+ n))
476 (setq point (point))
477 (backward-char arg)
478 (skip-chars-backward " \t")
479 (delete-region point (point))
480 (setq point (point))
481 (insert-char ?\n n)
482 (append-to-buffer other point (progn (end-of-line)
483 (if (eobp)
484 (point)
485 (1+ (point)))))
486 (delete-region point (point))
487 (setq n 0))
488 (next-line 1)))))
489
490(defun tc-kill-association ()
491 "Turn off two-column minor mode in current and associated buffer.
492If the associated buffer is unmodified and empty, it is killed."
493 (interactive)
494 (let ((buffer (current-buffer)))
495 (save-excursion
496 (and (tc-other)
497 (prog2
498 (setq tc-buffer-list
499 (delq (assq tc-other tc-buffer-list)
500 tc-buffer-list))
501 (set-buffer (tc-other))
502 (setq tc-buffer-list
503 (delq (assq tc-other tc-buffer-list)
504 tc-buffer-list)))
505 (or (not (tc-other))
506 (eq buffer (tc-other)))
507 (if (and (not (buffer-modified-p))
508 (eobp) (bobp))
509 (kill-buffer nil)
510 (kill-local-variable 'tc-other)
511 (kill-local-variable 'tc-window-width)
512 (kill-local-variable 'tc-separator)
513 (kill-local-variable 'mode-line-format)
514 (kill-local-variable 'fill-column))))
515 (kill-local-variable 'tc-other)
516 (kill-local-variable 'tc-window-width)
517 (kill-local-variable 'tc-separator)
518 (kill-local-variable 'mode-line-format)
519 (kill-local-variable 'fill-column)))
520
521
522;; this doesn't use yank-rectangle, so that the first column can
523;; contain long lines
524(defun tc-merge ()
525 "Merges the associated buffer with the current buffer.
526They get merged at the column, which is the value of
527`tc-window-width', i.e. usually at the vertical window
528separator. This separator gets replaced with white space. Beyond
529that the value of gets inserted on merged lines. The two columns are
530thus pasted side by side, in a single text. If the other buffer is
531not displayed to the left of this one, then this one becomes the left
532column.
533
534If you want `tc-separator' on empty lines in the second column,
535you should put just one space in them. In the final result, you can strip
536off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] + $ RET RET"
537
538 (interactive)
539 (or (tc-other)
540 (error "You must first set two-column minor mode."))
541 (and (> (car (window-edges)) 0) ; not touching left edge of screen
542 (eq (window-buffer (previous-window))
543 (tc-other))
544 (other-window -1))
545 (save-excursion
546 (let ((b1 (current-buffer))
547 (b2 (tc-other))
548 string)
549 (goto-char (point-min))
550 (set-buffer b2)
551 (goto-char (point-min))
552 (while (not (eobp))
553 (setq string (buffer-substring (point)
554 (progn (end-of-line) (point))))
555 (or (eobp)
556 (forward-char)) ; next line
557 (set-buffer b1)
558 (if (string= string "")
559 ()
560 (end-of-line)
561 (indent-to-column tc-window-width)
562 (insert tc-separator string))
563 (next-line 1) ; add one if necessary
564 (set-buffer b2))))
565 (if (< (window-width) (screen-width))
566 (enlarge-window 99999 t)))
567\f
568;;;;; utility functions ;;;;;
569
570(defun tc-associated-buffer ()
571 "Switch to associated buffer."
572 (interactive)
573 (or (tc-other)
574 (error "You must set two-column minor mode."))
575 (if (get-buffer-window (tc-other))
576 (select-window (get-buffer-window (tc-other)))
577 (switch-to-buffer (tc-other))))
578
579;; It would be desirable to intercept anything that causes the current
580;; window to scroll. Maybe a `scroll-hook'?
581(defun tc-scroll-line (arg)
582 "Scroll current window upward by ARG lines.
583The associated window gets scrolled to the same line."
584 (interactive "p")
585 (or (tc-other)
586 (error "You must set two-column minor mode."))
587 ; scroll-up has a bug on arg 0 at end of buffer
588 (or (zerop arg)
589 (scroll-up arg))
590 (setq arg (count-lines (point-min) (window-start)))
591 ; too bad that pre 18.57 Emacs makes save-window-excursion restore
592 ; the point. When it becomes extinct, we can simplify this.
593 (if (get-buffer-window (tc-other))
594 (let ((window (selected-window)))
595 (select-window (get-buffer-window (tc-other)))
596 (setq arg (- arg (count-lines (point-min) (window-start))))
597 ; make sure that other buffer has enough lines
598 (save-excursion
599 (goto-char (point-max))
600 (insert-char ?\n
601 (- arg (count-lines (window-start) (point-max)) -1)))
602 (or (zerop arg)
603 (scroll-up arg))
604 (select-window window))))
605
606(defun tc-scroll-up (arg)
607 "Scroll current window upward by ARG screens.
608The associated window gets scrolled to the same line."
609 (interactive "p")
610 (tc-scroll-line (* arg (- (window-height)
611 next-screen-context-lines 1))))
612
613(defun tc-scroll-down (arg)
614 "Scroll current window downward by ARG screens.
615The associated window gets scrolled to the same line."
616 (interactive "p")
617 (tc-scroll-line (* arg (- next-screen-context-lines
618 (window-height) -1))))
619
620(defun tc-recenter (arg)
621 "Center point in window. With ARG, put point on line ARG.
622This counts from bottom if ARG is negative. The associated window
623gets scrolled to the same line."
624 (interactive "P")
625 (setq arg (and arg (prefix-numeric-value arg)))
626 (tc-scroll-line (- (count-lines (window-start) (point))
627 (cond ((null arg) (/ (window-height) 2))
628 ((< arg 0) (+ (window-height) arg))
629 ( arg)))))
630
631(defun enlarge-window-horizontally (arg)
632 "Make current window ARG columns wider."
633 (interactive "p")
634 (enlarge-window arg t)
635 (and (tc-other)
636 (setq tc-window-width (+ tc-window-width arg))
637 (set-buffer (tc-other))
638 (setq tc-window-width (- tc-window-width arg))))
639
640(defun shrink-window-horizontally (arg)
641 "Make current window ARG columns narrower."
642 (interactive "p")
643 (enlarge-window-horizontally (- arg)))
644
645;;; two-column.el ends here