diff options
| author | Richard M. Stallman | 1992-09-28 13:02:35 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-09-28 13:02:35 +0000 |
| commit | 3bcbd523b28a572022af20fc6988ce2efde3494e (patch) | |
| tree | 34f61279d8b58713a2b3f26a957e9eda6c413234 | |
| parent | 6b185759071d9ba87bd9e61adfe29620986d7078 (diff) | |
| download | emacs-3bcbd523b28a572022af20fc6988ce2efde3494e.tar.gz emacs-3bcbd523b28a572022af20fc6988ce2efde3494e.zip | |
Use frame-width instead of screen-width.
| -rw-r--r-- | lisp/textmodes/two-column.el | 95 |
1 files changed, 34 insertions, 61 deletions
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index ee3477d9e31..daafd8c7e98 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el | |||
| @@ -221,48 +221,40 @@ | |||
| 221 | 221 | ||
| 222 | ;;; Code: | 222 | ;;; Code: |
| 223 | 223 | ||
| 224 | ;;;;; variable declarations ;;;;; | 224 | ;;;;; Set up keymap ;;;;; |
| 225 | |||
| 226 | (provide 'two-column) | ||
| 227 | |||
| 228 | (defvar tc-prefix "\C-x6" | ||
| 229 | "Prefix tc-mode-map gets bound to. | ||
| 230 | If you'd like to bind it to function key <f2>, see the prolog of the | ||
| 231 | source file, lisp/two-column.el") | ||
| 232 | 225 | ||
| 226 | ;;;###autoload | ||
| 233 | (defvar tc-mode-map nil | 227 | (defvar tc-mode-map nil |
| 234 | "Keymap that contains all commands useful with two-column minor mode. | 228 | "Keymap for commands for two-column mode.") |
| 235 | This gets bound globally to `tc-prefix' since minor modes have | ||
| 236 | no local keymap.") | ||
| 237 | 229 | ||
| 230 | ;;;###autoload | ||
| 238 | (if tc-mode-map | 231 | (if tc-mode-map |
| 239 | () | 232 | () |
| 240 | (setq tc-mode-map (make-sparse-keymap)) | 233 | (setq tc-mode-map (make-sparse-keymap)) |
| 241 | (define-key tc-mode-map "1" 'tc-merge) | 234 | (define-key tc-mode-map "1" 'tc-merge) |
| 242 | (define-key tc-mode-map "2" 'tc-split) | 235 | (define-key tc-mode-map "2" 'tc-two-columns) |
| 243 | (define-key tc-mode-map "b" 'tc-associate-buffer) | 236 | (define-key tc-mode-map "b" 'tc-associate-buffer) |
| 244 | (define-key tc-mode-map "k" 'tc-kill-association) | 237 | (define-key tc-mode-map "k" 'tc-kill-association) |
| 245 | (define-key tc-mode-map "\C-l" 'tc-recenter) | 238 | (define-key tc-mode-map "\C-l" 'tc-recenter) |
| 246 | (define-key tc-mode-map "o" 'tc-associated-buffer) | 239 | (define-key tc-mode-map "o" 'tc-associated-buffer) |
| 247 | (define-key tc-mode-map "u" 'tc-unmerge) | 240 | (define-key tc-mode-map "s" 'tc-split) |
| 248 | (define-key tc-mode-map "{" 'shrink-window-horizontally) | 241 | (define-key tc-mode-map "{" 'shrink-window-horizontally) |
| 249 | (define-key tc-mode-map "}" 'enlarge-window-horizontally) | 242 | (define-key tc-mode-map "}" 'enlarge-window-horizontally) |
| 250 | (define-key tc-mode-map " " 'tc-scroll-up) | 243 | (define-key tc-mode-map " " 'tc-scroll-up) |
| 251 | (define-key tc-mode-map "\^?" 'tc-scroll-down) | 244 | (define-key tc-mode-map "\^?" 'tc-scroll-down) |
| 252 | (define-key tc-mode-map "\C-m" 'tc-scroll-line)) | 245 | (define-key tc-mode-map "\C-m" 'tc-scroll-line)) |
| 253 | 246 | ||
| 254 | (global-set-key tc-prefix tc-mode-map) | 247 | ;;;###autoload |
| 255 | 248 | (global-set-key "\C-x6" tc-mode-map) | |
| 249 | |||
| 250 | ;;;;; variable declarations ;;;;; | ||
| 256 | 251 | ||
| 257 | ;; markers seem to be the only buffer-id not affected by renaming | 252 | ;; markers seem to be the only buffer-id not affected by renaming |
| 258 | ;; a buffer. This nevertheless loses when a buffer is killed. | 253 | ;; a buffer. This nevertheless loses when a buffer is killed. |
| 259 | (defvar tc-other nil | 254 | (defvar tc-other nil |
| 260 | "Marker to the associated buffer, if non-nil.") | 255 | "Marker to the associated buffer, if non-nil.") |
| 261 | (make-variable-buffer-local 'tc-other) | 256 | (make-variable-buffer-local 'tc-other) |
| 262 | 257 | (put 'tc-other 'permanent-local t) | |
| 263 | |||
| 264 | (defvar tc-buffer-list () | ||
| 265 | "An alist of markers to associated buffers. (Backs up `tc-other')") | ||
| 266 | 258 | ||
| 267 | (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist)) | 259 | (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist)) |
| 268 | 260 | ||
| @@ -274,12 +266,14 @@ no local keymap.") | |||
| 274 | 266 | ||
| 275 | (defvar tc-separator "" | 267 | (defvar tc-separator "" |
| 276 | "*A string inserted between the two columns when merging. | 268 | "*A string inserted between the two columns when merging. |
| 277 | This gets set locally by \\[tc-unmerge].") | 269 | This gets set locally by \\[tc-split].") |
| 270 | (put 'tc-separator 'permanent-local t) | ||
| 278 | 271 | ||
| 279 | (defvar tc-window-width 40 | 272 | (defvar tc-window-width 40 |
| 280 | "*The width of the first column. (Must be at least `window-min-width') | 273 | "*The width of the first column. (Must be at least `window-min-width') |
| 281 | This value is local for every buffer that sets it.") | 274 | This value is local for every buffer that sets it.") |
| 282 | (make-variable-buffer-local 'tc-window-width) | 275 | (make-variable-buffer-local 'tc-window-width) |
| 276 | (put 'tc-window-width 'permanent-local t) | ||
| 283 | 277 | ||
| 284 | (defvar tc-beyond-fill-column 4 | 278 | (defvar tc-beyond-fill-column 4 |
| 285 | "*Base for calculating `fill-column' for a buffer in two-column minor mode. | 279 | "*Base for calculating `fill-column' for a buffer in two-column minor mode. |
| @@ -288,7 +282,7 @@ minus this value.") | |||
| 288 | 282 | ||
| 289 | (defvar tc-mode-hook nil | 283 | (defvar tc-mode-hook nil |
| 290 | "Function called, if non-nil, whenever turning on two-column minor mode. | 284 | "Function called, if non-nil, whenever turning on two-column minor mode. |
| 291 | It can get called by \\[tc-split] (tc-split), \\[tc-unmerge] (tc-unmerge) | 285 | It can get called by \\[tc-two-columns] (tc-two-columns), \\[tc-split] (tc-split) |
| 292 | and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") | 286 | and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") |
| 293 | 287 | ||
| 294 | ;;;;; base functions ;;;;; | 288 | ;;;;; base functions ;;;;; |
| @@ -296,15 +290,7 @@ and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") | |||
| 296 | ;; the access method for the other buffer. this tries to remedy against | 290 | ;; the access method for the other buffer. this tries to remedy against |
| 297 | ;; lost local variables and lost buffers. | 291 | ;; lost local variables and lost buffers. |
| 298 | (defun tc-other () | 292 | (defun tc-other () |
| 299 | (if (or tc-other | 293 | (if tc-other |
| 300 | (setq tc-other | ||
| 301 | ; assoc with a different predicate, since we don't know | ||
| 302 | ; which marker points to this buffer | ||
| 303 | (let ((bl tc-buffer-list)) | ||
| 304 | (while (and bl (not (eq (current-buffer) | ||
| 305 | (marker-buffer (car (car bl)))))) | ||
| 306 | (setq bl (cdr bl))) | ||
| 307 | (cdr (car bl))))) | ||
| 308 | (or (prog1 | 294 | (or (prog1 |
| 309 | (marker-buffer tc-other) | 295 | (marker-buffer tc-other) |
| 310 | (setq mode-line-format tc-mode-line-format )) | 296 | (setq mode-line-format tc-mode-line-format )) |
| @@ -316,7 +302,7 @@ and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") | |||
| 316 | (kill-local-variable 'mode-line-format) | 302 | (kill-local-variable 'mode-line-format) |
| 317 | nil)))) | 303 | nil)))) |
| 318 | 304 | ||
| 319 | (defun tc-split (&optional buffer) | 305 | (defun tc-two-columns (&optional buffer) |
| 320 | "Split current window vertically for two-column editing. | 306 | "Split current window vertically for two-column editing. |
| 321 | 307 | ||
| 322 | When called the first time, associates a buffer with the current | 308 | When called the first time, associates a buffer with the current |
| @@ -333,7 +319,7 @@ the associated buffer having empty lines next to them. | |||
| 333 | 319 | ||
| 334 | You have the following commands at your disposal: | 320 | You have the following commands at your disposal: |
| 335 | 321 | ||
| 336 | \\[tc-split] Rearrange screen | 322 | \\[tc-two-columns] Rearrange screen |
| 337 | \\[tc-associate-buffer] Reassociate buffer after changing major mode | 323 | \\[tc-associate-buffer] Reassociate buffer after changing major mode |
| 338 | \\[tc-scroll-up] Scroll both buffers up by a screenfull | 324 | \\[tc-scroll-up] Scroll both buffers up by a screenfull |
| 339 | \\[tc-scroll-down] Scroll both buffers down by a screenful | 325 | \\[tc-scroll-down] Scroll both buffers down by a screenful |
| @@ -353,11 +339,11 @@ The appearance of the screen can be customized by the variables | |||
| 353 | (interactive "P") | 339 | (interactive "P") |
| 354 | ; first go to full width, so that we can certainly split into | 340 | ; first go to full width, so that we can certainly split into |
| 355 | ; two windows | 341 | ; two windows |
| 356 | (if (< (window-width) (screen-width)) | 342 | (if (< (window-width) (frame-width)) |
| 357 | (enlarge-window 99999 t)) | 343 | (enlarge-window 99999 t)) |
| 358 | (split-window-horizontally | 344 | (split-window-horizontally |
| 359 | (max window-min-width (min tc-window-width | 345 | (max window-min-width (min tc-window-width |
| 360 | (- (screen-width) window-min-width)))) | 346 | (- (frame-width) window-min-width)))) |
| 361 | (if (tc-other) | 347 | (if (tc-other) |
| 362 | (progn | 348 | (progn |
| 363 | (other-window 1) | 349 | (other-window 1) |
| @@ -384,26 +370,18 @@ The appearance of the screen can be customized by the variables | |||
| 384 | mode-line-format tc-mode-line-format | 370 | mode-line-format tc-mode-line-format |
| 385 | tc-other other | 371 | tc-other other |
| 386 | other (point-marker)) | 372 | other (point-marker)) |
| 387 | (setq tc-buffer-list (cons (cons tc-other other) | ||
| 388 | tc-buffer-list)) | ||
| 389 | (run-hooks tc-mode-hook) | 373 | (run-hooks tc-mode-hook) |
| 390 | (other-window -1) | 374 | (other-window -1) |
| 391 | (setq tc-buffer-list | ||
| 392 | (cons (cons other | ||
| 393 | (save-excursion | ||
| 394 | (set-buffer (tc-other)) | ||
| 395 | tc-other)) | ||
| 396 | tc-buffer-list)) | ||
| 397 | (setq tc-other other)))) | 375 | (setq tc-other other)))) |
| 398 | 376 | ||
| 399 | (fset 'tc-mode 'tc-split) | 377 | (fset 'tc-mode 'tc-two-columns) |
| 400 | 378 | ||
| 401 | (defun tc-associate-buffer () | 379 | (defun tc-associate-buffer () |
| 402 | "Associate another buffer with this one in two-column minor mode. | 380 | "Associate another buffer with this one in two-column minor mode. |
| 403 | Can also be used to associate a just previously visited file, by | 381 | Can also be used to associate a just previously visited file, by |
| 404 | accepting the proposed default buffer. | 382 | accepting the proposed default buffer. |
| 405 | 383 | ||
| 406 | See \\[tc-split] and `lisp/two-column.el' for further details." | 384 | See \\[tc-two-columns] and `lisp/two-column.el' for further details." |
| 407 | (interactive) | 385 | (interactive) |
| 408 | (let ((b1 (current-buffer)) | 386 | (let ((b1 (current-buffer)) |
| 409 | (b2 (or (tc-other) | 387 | (b2 (or (tc-other) |
| @@ -418,13 +396,13 @@ See \\[tc-split] and `lisp/two-column.el' for further details." | |||
| 418 | (setq b1 (and (assq 'tc-window-width (buffer-local-variables)) | 396 | (setq b1 (and (assq 'tc-window-width (buffer-local-variables)) |
| 419 | tc-window-width))) | 397 | tc-window-width))) |
| 420 | ; if other buffer has a local width, adjust here too | 398 | ; if other buffer has a local width, adjust here too |
| 421 | (if b1 (setq tc-window-width (- (screen-width) b1))) | 399 | (if b1 (setq tc-window-width (- (frame-width) b1))) |
| 422 | (tc-split b2))) | 400 | (tc-two-columns b2))) |
| 423 | 401 | ||
| 424 | (defun tc-unmerge (arg) | 402 | (defun tc-split (arg) |
| 425 | "Unmerge a two-column text into two buffers in two-column minor mode. | 403 | "Unmerge a two-column text into two buffers in two-column minor mode. |
| 426 | The text is unmerged at the cursor's column which becomes the local | 404 | The text is unmerged at the cursor's column which becomes the local |
| 427 | value of tc-window-width. Only lines that have the ARG same | 405 | value of `tc-window-width'. Only lines that have the ARG same |
| 428 | preceding characters at that column get split. The ARG preceding | 406 | preceding characters at that column get split. The ARG preceding |
| 429 | characters without any leading whitespace become the local value for | 407 | characters without any leading whitespace become the local value for |
| 430 | `tc-separator'. This way lines that continue across both | 408 | `tc-separator'. This way lines that continue across both |
| @@ -437,9 +415,9 @@ separator you like and then unmerge that line. E.g.: | |||
| 437 | First column's text sSs Second columns text | 415 | First column's text sSs Second columns text |
| 438 | \\___/\\ | 416 | \\___/\\ |
| 439 | / \\ | 417 | / \\ |
| 440 | 5 character Separator You type M-5 \\[tc-unmerge] with the point here | 418 | 5 character Separator You type M-5 \\[tc-split] with the point here |
| 441 | 419 | ||
| 442 | See \\[tc-split] and `lisp/two-column.el' for further details." | 420 | See \\[tc-two-columns] and `lisp/two-column.el' for further details." |
| 443 | (interactive "p") | 421 | (interactive "p") |
| 444 | (and (tc-other) | 422 | (and (tc-other) |
| 445 | (if (y-or-n-p (concat "Overwrite associated buffer `" | 423 | (if (y-or-n-p (concat "Overwrite associated buffer `" |
| @@ -459,10 +437,10 @@ See \\[tc-split] and `lisp/two-column.el' for further details." | |||
| 459 | (backward-char arg) | 437 | (backward-char arg) |
| 460 | (setq chars (buffer-substring (point) point)) | 438 | (setq chars (buffer-substring (point) point)) |
| 461 | (skip-chars-forward " \t" point) | 439 | (skip-chars-forward " \t" point) |
| 462 | (make-variable-buffer-local 'tc-separator) | 440 | (make-local-variable 'tc-separator) |
| 463 | (setq tc-separator (buffer-substring (point) point) | 441 | (setq tc-separator (buffer-substring (point) point) |
| 464 | tc-window-width (current-column))) | 442 | tc-window-width (current-column))) |
| 465 | (tc-split) | 443 | (tc-two-columns) |
| 466 | (setq other (tc-other)) | 444 | (setq other (tc-other)) |
| 467 | ; now we're ready to actually unmerge | 445 | ; now we're ready to actually unmerge |
| 468 | (save-excursion | 446 | (save-excursion |
| @@ -495,14 +473,7 @@ If the associated buffer is unmodified and empty, it is killed." | |||
| 495 | (let ((buffer (current-buffer))) | 473 | (let ((buffer (current-buffer))) |
| 496 | (save-excursion | 474 | (save-excursion |
| 497 | (and (tc-other) | 475 | (and (tc-other) |
| 498 | (prog2 | 476 | (set-buffer (tc-other)) |
| 499 | (setq tc-buffer-list | ||
| 500 | (delq (assq tc-other tc-buffer-list) | ||
| 501 | tc-buffer-list)) | ||
| 502 | (set-buffer (tc-other)) | ||
| 503 | (setq tc-buffer-list | ||
| 504 | (delq (assq tc-other tc-buffer-list) | ||
| 505 | tc-buffer-list))) | ||
| 506 | (or (not (tc-other)) | 477 | (or (not (tc-other)) |
| 507 | (eq buffer (tc-other))) | 478 | (eq buffer (tc-other))) |
| 508 | (if (and (not (buffer-modified-p)) | 479 | (if (and (not (buffer-modified-p)) |
| @@ -563,7 +534,7 @@ off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] | |||
| 563 | (insert tc-separator string)) | 534 | (insert tc-separator string)) |
| 564 | (next-line 1) ; add one if necessary | 535 | (next-line 1) ; add one if necessary |
| 565 | (set-buffer b2)))) | 536 | (set-buffer b2)))) |
| 566 | (if (< (window-width) (screen-width)) | 537 | (if (< (window-width) (frame-width)) |
| 567 | (enlarge-window 99999 t))) | 538 | (enlarge-window 99999 t))) |
| 568 | 539 | ||
| 569 | ;;;;; utility functions ;;;;; | 540 | ;;;;; utility functions ;;;;; |
| @@ -643,4 +614,6 @@ gets scrolled to the same line." | |||
| 643 | (interactive "p") | 614 | (interactive "p") |
| 644 | (enlarge-window-horizontally (- arg))) | 615 | (enlarge-window-horizontally (- arg))) |
| 645 | 616 | ||
| 617 | (provide 'two-column) | ||
| 618 | |||
| 646 | ;;; two-column.el ends here | 619 | ;;; two-column.el ends here |