219
+ − 1 ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model.
+ − 2
+ − 3 ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
+ − 4
+ − 5 ;; Author: K. Shane Hartman
+ − 6 ;; Maintainer: FSF
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 23 ;; Boston, MA 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: FSF 19.30.
+ − 26
+ − 27 ;; XEmacs changes:
+ − 28 ;; -- set zmacs-region-stays
+ − 29 ;; -- set mouse-track-rectangle-p
+ − 30 ;; -- deleted useless hscroll-point-visible junk.
+ − 31
+ − 32
+ − 33 ;;; Commentary:
+ − 34
+ − 35 ;; This code provides the picture-mode commands documented in the Emacs
+ − 36 ;; manual. The screen is treated as a semi-infinite quarter-plane with
+ − 37 ;; support for rectangle operations and `etch-a-sketch' character
+ − 38 ;; insertion in any of eight directions.
+ − 39
+ − 40 ;;; Code:
+ − 41
+ − 42 (defun move-to-column-force (column)
+ − 43 "Move to column COLUMN in current line.
+ − 44 Differs from `move-to-column' in that it creates or modifies whitespace
+ − 45 if necessary to attain exactly the specified column."
+ − 46 (or (natnump column) (setq column 0))
+ − 47 (move-to-column column)
+ − 48 (let ((col (current-column)))
+ − 49 (if (< col column)
+ − 50 (indent-to column)
+ − 51 (if (and (/= col column)
+ − 52 (= (preceding-char) ?\t))
+ − 53 (let (indent-tabs-mode)
+ − 54 (delete-char -1)
+ − 55 (indent-to col)
+ − 56 (move-to-column column))))
+ − 57 (prog1
+ − 58 ;; XEmacs addition:
+ − 59 (setq zmacs-region-stays t))))
+ − 60
+ − 61
+ − 62 ;; Picture Movement Commands
+ − 63
+ − 64 (defun picture-beginning-of-line (&optional arg)
+ − 65 "Position point at the beginning of the line.
+ − 66 With ARG not nil, move forward ARG - 1 lines first.
+ − 67 If scan reaches end of buffer, stop there without error."
+ − 68 (interactive "P")
+ − 69 (if arg (forward-line (1- (prefix-numeric-value arg))))
+ − 70 (beginning-of-line)
+ − 71 )
+ − 72
+ − 73 (defun picture-end-of-line (&optional arg)
+ − 74 "Position point after last non-blank character on current line.
+ − 75 With ARG not nil, move forward ARG - 1 lines first.
+ − 76 If scan reaches end of buffer, stop there without error."
+ − 77 (interactive "P")
+ − 78 (if arg (forward-line (1- (prefix-numeric-value arg))))
+ − 79 (beginning-of-line)
+ − 80 (skip-chars-backward " \t" (prog1 (point) (end-of-line)))
+ − 81 )
+ − 82
+ − 83 (defun picture-forward-column (arg)
+ − 84 "Move cursor right, making whitespace if necessary.
+ − 85 With argument, move that many columns."
+ − 86 (interactive "p")
+ − 87 (let ((target-column (+ (current-column) arg)))
+ − 88 (move-to-column-force target-column)
+ − 89 ;; Picture mode isn't really suited to multi-column characters,
+ − 90 ;; but we might as well let the user move across them.
+ − 91 (and (< arg 0)
+ − 92 (> (current-column) target-column)
446
+ − 93 (backward-char 1))))
219
+ − 94
+ − 95 (defun picture-backward-column (arg)
+ − 96 "Move cursor left, making whitespace if necessary.
+ − 97 With argument, move that many columns."
+ − 98 (interactive "p")
+ − 99 (picture-forward-column (- arg)))
+ − 100
+ − 101 (defun picture-move-down (arg)
+ − 102 "Move vertically down, making whitespace if necessary.
+ − 103 With argument, move that many lines."
+ − 104 (interactive "p")
+ − 105 (let ((col (current-column)))
+ − 106 (picture-newline arg)
+ − 107 (move-to-column-force col)))
+ − 108
+ − 109 (defconst picture-vertical-step 0
+ − 110 "Amount to move vertically after text character in Picture mode.")
+ − 111
+ − 112 (defconst picture-horizontal-step 1
+ − 113 "Amount to move horizontally after text character in Picture mode.")
+ − 114
+ − 115 (defun picture-move-up (arg)
+ − 116 "Move vertically up, making whitespace if necessary.
+ − 117 With argument, move that many lines."
+ − 118 (interactive "p")
+ − 119 (picture-move-down (- arg)))
+ − 120
+ − 121 (defun picture-movement-right ()
+ − 122 "Move right after self-inserting character in Picture mode."
+ − 123 (interactive)
+ − 124 (picture-set-motion 0 1))
+ − 125
+ − 126 (defun picture-movement-left ()
+ − 127 "Move left after self-inserting character in Picture mode."
+ − 128 (interactive)
+ − 129 (picture-set-motion 0 -1))
+ − 130
+ − 131 (defun picture-movement-up ()
+ − 132 "Move up after self-inserting character in Picture mode."
+ − 133 (interactive)
+ − 134 (picture-set-motion -1 0))
+ − 135
+ − 136 (defun picture-movement-down ()
+ − 137 "Move down after self-inserting character in Picture mode."
+ − 138 (interactive)
+ − 139 (picture-set-motion 1 0))
+ − 140
+ − 141 (defun picture-movement-nw ()
+ − 142 "Move up and left after self-inserting character in Picture mode."
+ − 143 (interactive)
+ − 144 (picture-set-motion -1 -1))
+ − 145
+ − 146 (defun picture-movement-ne ()
+ − 147 "Move up and right after self-inserting character in Picture mode."
+ − 148 (interactive)
+ − 149 (picture-set-motion -1 1))
+ − 150
+ − 151 (defun picture-movement-sw ()
+ − 152 "Move down and left after self-inserting character in Picture mode."
+ − 153 (interactive)
+ − 154 (picture-set-motion 1 -1))
+ − 155
+ − 156 (defun picture-movement-se ()
+ − 157 "Move down and right after self-inserting character in Picture mode."
+ − 158 (interactive)
+ − 159 (picture-set-motion 1 1))
+ − 160
+ − 161 (defun picture-set-motion (vert horiz)
+ − 162 "Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
+ − 163 The modeline is updated to reflect the current direction."
+ − 164 (setq picture-vertical-step vert
+ − 165 picture-horizontal-step horiz)
+ − 166 (setq mode-name
+ − 167 (format "Picture:%s"
+ − 168 (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
+ − 169 '(nw up ne left none right sw down se)))))
+ − 170 (redraw-modeline)
+ − 171 (message nil))
+ − 172
+ − 173 (defun picture-move ()
+ − 174 "Move in direction of `picture-vertical-step' and `picture-horizontal-step'."
+ − 175 (picture-move-down picture-vertical-step)
+ − 176 (picture-forward-column picture-horizontal-step))
+ − 177
+ − 178 (defun picture-motion (arg)
+ − 179 "Move point in direction of current picture motion in Picture mode.
+ − 180 With ARG do it that many times. Useful for delineating rectangles in
+ − 181 conjunction with diagonal picture motion.
+ − 182 Do \\[command-apropos] picture-movement to see commands which control motion."
+ − 183 (interactive "p")
+ − 184 (picture-move-down (* arg picture-vertical-step))
+ − 185 (picture-forward-column (* arg picture-horizontal-step)))
+ − 186
+ − 187 (defun picture-motion-reverse (arg)
+ − 188 "Move point in direction opposite of current picture motion in Picture mode.
+ − 189 With ARG do it that many times. Useful for delineating rectangles in
+ − 190 conjunction with diagonal picture motion.
+ − 191 Do \\[command-apropos] `picture-movement' to see commands which control motion."
+ − 192 (interactive "p")
+ − 193 (picture-motion (- arg)))
+ − 194
+ − 195
+ − 196 ;; Picture insertion and deletion.
+ − 197
+ − 198 (defun picture-self-insert (arg)
+ − 199 "Insert this character in place of character previously at the cursor.
+ − 200 The cursor then moves in the direction you previously specified
+ − 201 with the commands `picture-movement-right', `picture-movement-up', etc.
+ − 202 Do \\[command-apropos] `picture-movement' to see those commands."
+ − 203 (interactive "p")
+ − 204 (while (> arg 0)
+ − 205 (setq arg (1- arg))
+ − 206 (move-to-column-force (1+ (current-column)))
+ − 207 (delete-char -1)
+ − 208 ;; FSF changes the following to last-command-event.
+ − 209 (insert last-command-char)
446
+ − 210 (backward-char 1)
219
+ − 211 (picture-move)
+ − 212 ;; XEmacs addition:
+ − 213 (setq zmacs-region-stays nil)))
+ − 214
+ − 215 (defun picture-clear-column (arg)
+ − 216 "Clear out ARG columns after point without moving."
+ − 217 (interactive "p")
+ − 218 (let* ((opoint (point))
+ − 219 (original-col (current-column))
+ − 220 (target-col (+ original-col arg)))
+ − 221 (move-to-column-force target-col)
+ − 222 (delete-region opoint (point))
+ − 223 (save-excursion
+ − 224 (indent-to (max target-col original-col)))))
+ − 225
+ − 226 (defun picture-backward-clear-column (arg)
+ − 227 "Clear out ARG columns before point, moving back over them."
+ − 228 (interactive "p")
+ − 229 (picture-clear-column (- arg)))
+ − 230
+ − 231 (defun picture-clear-line (arg)
+ − 232 "Clear out rest of line; if at end of line, advance to next line.
+ − 233 Cleared-out line text goes into the kill ring, as do newlines that are
+ − 234 advanced over. With argument, clear out (and save in kill ring) that
+ − 235 many lines."
+ − 236 (interactive "P")
+ − 237 (if arg
+ − 238 (progn
+ − 239 (setq arg (prefix-numeric-value arg))
+ − 240 (kill-line arg)
+ − 241 (newline (if (> arg 0) arg (- arg))))
+ − 242 (if (looking-at "[ \t]*$")
+ − 243 (kill-ring-save (point) (progn (forward-line 1) (point)))
+ − 244 (kill-region (point) (progn (end-of-line) (point))))
+ − 245 ;; XEmacs addition:
+ − 246 (setq zmacs-region-stays nil)))
+ − 247
+ − 248 (defun picture-newline (arg)
+ − 249 "Move to the beginning of the following line.
+ − 250 With argument, moves that many lines (up, if negative argument);
+ − 251 always moves to the beginning of a line."
+ − 252 (interactive "p")
+ − 253 (if (< arg 0)
+ − 254 (forward-line arg)
+ − 255 (while (> arg 0)
+ − 256 (end-of-line)
+ − 257 (if (eobp) (newline) (forward-char 1))
+ − 258 (setq arg (1- arg))))
+ − 259 )
+ − 260
+ − 261 (defun picture-open-line (arg)
+ − 262 "Insert an empty line after the current line.
+ − 263 With positive argument insert that many lines."
+ − 264 (interactive "p")
+ − 265 (save-excursion
+ − 266 (end-of-line)
+ − 267 (open-line arg))
+ − 268 )
+ − 269
+ − 270 (defun picture-duplicate-line ()
+ − 271 "Insert a duplicate of the current line, below it."
+ − 272 (interactive)
+ − 273 (save-excursion
+ − 274 (let ((contents
+ − 275 (buffer-substring
+ − 276 (progn (beginning-of-line) (point))
+ − 277 (progn (picture-newline 1) (point)))))
+ − 278 (forward-line -1)
+ − 279 (insert contents))))
+ − 280
+ − 281 ;; Like replace-match, but overwrites.
+ − 282 (defun picture-replace-match (newtext fixedcase literal)
+ − 283 (let (ocolumn change pos)
+ − 284 (goto-char (setq pos (match-end 0)))
+ − 285 (setq ocolumn (current-column))
+ − 286 ;; Make the replacement and undo it, to see how it changes the length.
+ − 287 (let ((buffer-undo-list nil)
+ − 288 list1)
+ − 289 (replace-match newtext fixedcase literal)
+ − 290 (setq change (- (current-column) ocolumn))
+ − 291 (setq list1 buffer-undo-list)
+ − 292 (while list1
+ − 293 (setq list1 (primitive-undo 1 list1))))
+ − 294 (goto-char pos)
+ − 295 (if (> change 0)
+ − 296 (delete-region (point)
+ − 297 (progn
+ − 298 (move-to-column-force (+ change (current-column)))
+ − 299 (point))))
+ − 300 (replace-match newtext fixedcase literal)
+ − 301 (if (< change 0)
+ − 302 (insert-char ?\ (- change)))))
+ − 303
+ − 304 ;; Picture Tabs
+ − 305
+ − 306 (defvar picture-tab-chars "!-~"
+ − 307 "*A character set which controls behavior of commands
+ − 308 \\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
+ − 309 regular expression, any regexp special characters will be quoted.
+ − 310 It defines a set of \"interesting characters\" to look for when setting
+ − 311 \(or searching for) tab stops, initially \"!-~\" (all printing characters).
+ − 312 For example, suppose that you are editing a table which is formatted thus:
+ − 313 | foo | bar + baz | 23 *
+ − 314 | bubbles | and + etc | 97 *
+ − 315 and that `picture-tab-chars' is \"|+*\". Then invoking
+ − 316 \\[picture-set-tab-stops] on either of the previous lines would result
+ − 317 in the following tab stops
+ − 318 : : : :
+ − 319 Another example - \"A-Za-z0-9\" would produce the tab stops
+ − 320 : : : :
+ − 321
+ − 322 Note that if you want the character `-' to be in the set, it must be
+ − 323 included in a range or else appear in a context where it cannot be
+ − 324 taken for indicating a range (e.g. \"-A-Z\" declares the set to be the
+ − 325 letters `A' through `Z' and the character `-'). If you want the
+ − 326 character `\\' in the set it must be preceded by itself: \"\\\\\".
+ − 327
+ − 328 The command \\[picture-tab-search] is defined to move beneath (or to) a
+ − 329 character belonging to this set independent of the tab stops list.")
+ − 330
+ − 331 (defun picture-set-tab-stops (&optional arg)
+ − 332 "Set value of `tab-stop-list' according to context of this line.
+ − 333 This controls the behavior of \\[picture-tab]. A tab stop is set at
+ − 334 every column occupied by an \"interesting character\" that is preceded
+ − 335 by whitespace. Interesting characters are defined by the variable
+ − 336 `picture-tab-chars', see its documentation for an example of usage.
+ − 337 With ARG, just (re)set `tab-stop-list' to its default value. The tab
+ − 338 stops computed are displayed in the minibuffer with `:' at each stop."
+ − 339 (interactive "P")
+ − 340 (save-excursion
+ − 341 (let (tabs)
+ − 342 (if arg
+ − 343 (setq tabs (default-value 'tab-stop-list))
+ − 344 (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
+ − 345 (beginning-of-line)
+ − 346 (let ((bol (point)))
+ − 347 (end-of-line)
+ − 348 (while (re-search-backward regexp bol t)
+ − 349 (skip-chars-forward " \t")
+ − 350 (setq tabs (cons (current-column) tabs)))
+ − 351 (if (null tabs)
+ − 352 (error "No characters in set %s on this line."
+ − 353 (regexp-quote picture-tab-chars))))))
+ − 354 (setq tab-stop-list tabs)
+ − 355 (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
+ − 356 (while tabs
+ − 357 (aset blurb (car tabs) ?:)
+ − 358 (setq tabs (cdr tabs)))
+ − 359 (message blurb)))))
+ − 360
+ − 361 (defun picture-tab-search (&optional arg)
+ − 362 "Move to column beneath next interesting char in previous line.
+ − 363 With ARG move to column occupied by next interesting character in this
+ − 364 line. The character must be preceded by whitespace.
+ − 365 \"interesting characters\" are defined by variable `picture-tab-chars'.
+ − 366 If no such character is found, move to beginning of line."
+ − 367 (interactive "P")
+ − 368 (let ((target (current-column)))
+ − 369 (save-excursion
+ − 370 (if (and (not arg)
+ − 371 (progn
+ − 372 (beginning-of-line)
+ − 373 (skip-chars-backward
+ − 374 (concat "^" (regexp-quote picture-tab-chars))
+ − 375 (point-min))
+ − 376 (not (bobp))))
+ − 377 (move-to-column target))
+ − 378 (if (re-search-forward
+ − 379 (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
+ − 380 (save-excursion (end-of-line) (point))
+ − 381 'move)
+ − 382 (setq target (1- (current-column)))
+ − 383 (setq target nil)))
+ − 384 (if target
+ − 385 (move-to-column-force target)
+ − 386 (beginning-of-line))))
+ − 387
+ − 388 (defun picture-tab (&optional arg)
+ − 389 "Tab transparently (just move point) to next tab stop.
+ − 390 With prefix arg, overwrite the traversed text with spaces. The tab stop
+ − 391 list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
+ − 392 See also documentation for variable `picture-tab-chars'."
+ − 393 (interactive "P")
+ − 394 (let* ((opoint (point)))
+ − 395 (move-to-tab-stop)
+ − 396 (if arg
+ − 397 (let (indent-tabs-mode
+ − 398 (column (current-column)))
+ − 399 (delete-region opoint (point))
+ − 400 (indent-to column))
+ − 401 ;; XEmacs addition:
+ − 402 (setq zmacs-region-stays t))))
+ − 403
+ − 404 ;; Picture Rectangles
+ − 405
+ − 406 (defconst picture-killed-rectangle nil
+ − 407 "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode.
+ − 408 The contents can be retrieved by \\[picture-yank-rectangle]")
+ − 409
+ − 410 (defun picture-clear-rectangle (start end &optional killp)
+ − 411 "Clear and save rectangle delineated by point and mark.
+ − 412 The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced
+ − 413 with whitespace. The previously saved rectangle, if any, is lost. With
+ − 414 prefix argument, the rectangle is actually killed, shifting remaining text."
+ − 415 (interactive "r\nP")
+ − 416 (setq picture-killed-rectangle (picture-snarf-rectangle start end killp)))
+ − 417
+ − 418 (defun picture-clear-rectangle-to-register (start end register &optional killp)
+ − 419 "Clear rectangle delineated by point and mark into REGISTER.
+ − 420 The rectangle is saved in REGISTER and replaced with whitespace. With
+ − 421 prefix argument, the rectangle is actually killed, shifting remaining text."
+ − 422 (interactive "r\ncRectangle to register: \nP")
+ − 423 (set-register register (picture-snarf-rectangle start end killp)))
+ − 424
+ − 425 (defun picture-snarf-rectangle (start end &optional killp)
+ − 426 (let ((column (current-column))
+ − 427 (indent-tabs-mode nil))
+ − 428 (prog1 (save-excursion
+ − 429 (if killp
+ − 430 (delete-extract-rectangle start end)
+ − 431 (prog1 (extract-rectangle start end)
+ − 432 (clear-rectangle start end))))
+ − 433 (move-to-column-force column)
+ − 434 ;; XEmacs addition:
+ − 435 (setq zmacs-region-stays nil))))
+ − 436
+ − 437 (defun picture-yank-rectangle (&optional insertp)
+ − 438 "Overlay rectangle saved by \\[picture-clear-rectangle]
+ − 439 The rectangle is positioned with upper left corner at point, overwriting
+ − 440 existing text. With prefix argument, the rectangle is inserted instead,
+ − 441 shifting existing text. Leaves mark at one corner of rectangle and
+ − 442 point at the other (diagonally opposed) corner."
+ − 443 (interactive "P")
+ − 444 (if (not (consp picture-killed-rectangle))
+ − 445 (error "No rectangle saved.")
+ − 446 (picture-insert-rectangle picture-killed-rectangle insertp)))
+ − 447
+ − 448 (defun picture-yank-at-click (click arg)
+ − 449 "Insert the last killed rectangle at the position clicked on.
+ − 450 Also move point to one end of the text thus inserted (normally the end).
+ − 451 Prefix arguments are interpreted as with \\[yank].
+ − 452 If `mouse-yank-at-point' is non-nil, insert at point
+ − 453 regardless of where you click."
+ − 454 (interactive "e\nP")
+ − 455 (or mouse-yank-at-point (mouse-set-point click))
+ − 456 (picture-yank-rectangle arg))
+ − 457
+ − 458 (defun picture-yank-rectangle-from-register (register &optional insertp)
+ − 459 "Overlay rectangle saved in REGISTER.
+ − 460 The rectangle is positioned with upper left corner at point, overwriting
+ − 461 existing text. With prefix argument, the rectangle is
+ − 462 inserted instead, shifting existing text. Leaves mark at one corner
+ − 463 of rectangle and point at the other (diagonally opposed) corner."
+ − 464 (interactive "cRectangle from register: \nP")
+ − 465 (let ((rectangle (get-register register)))
+ − 466 (if (not (consp rectangle))
+ − 467 (error "Register %c does not contain a rectangle." register)
+ − 468 (picture-insert-rectangle rectangle insertp))))
+ − 469
+ − 470 (defun picture-insert-rectangle (rectangle &optional insertp)
+ − 471 "Overlay RECTANGLE with upper left corner at point.
+ − 472 Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
+ − 473 Leaves the region surrounding the rectangle."
+ − 474 (let ((indent-tabs-mode nil))
+ − 475 (if (not insertp)
+ − 476 (save-excursion
+ − 477 (delete-rectangle (point)
+ − 478 (progn
+ − 479 (picture-forward-column (length (car rectangle)))
+ − 480 (picture-move-down (1- (length rectangle)))
+ − 481 (point)))))
+ − 482 (push-mark)
+ − 483 (insert-rectangle rectangle)))
+ − 484
+ − 485
+ − 486 ;; Picture Keymap, entry and exit points.
+ − 487
+ − 488 (defconst picture-mode-map nil)
+ − 489
+ − 490 (defun picture-substitute (oldfun newfun)
+ − 491 (substitute-key-definition oldfun newfun picture-mode-map global-map))
+ − 492
+ − 493 (if (not picture-mode-map)
+ − 494 (progn
+ − 495 (setq picture-mode-map (make-keymap 'picture-mode-map))
+ − 496 (picture-substitute 'self-insert-command 'picture-self-insert)
+ − 497 (picture-substitute 'forward-char 'picture-forward-column)
+ − 498 (picture-substitute 'backward-char 'picture-backward-column)
+ − 499 (picture-substitute 'delete-char 'picture-clear-column)
+ − 500 ;; There are two possibilities for what is normally on DEL.
+ − 501 (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
+ − 502 (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
+ − 503 (picture-substitute 'kill-line 'picture-clear-line)
+ − 504 (picture-substitute 'open-line 'picture-open-line)
+ − 505 (picture-substitute 'newline 'picture-newline)
+ − 506 (picture-substitute 'newline-and-indent 'picture-duplicate-line)
+ − 507 (picture-substitute 'next-line 'picture-move-down)
+ − 508 (picture-substitute 'previous-line 'picture-move-up)
+ − 509 (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
+ − 510 (picture-substitute 'end-of-line 'picture-end-of-line)
+ − 511
+ − 512 (define-key picture-mode-map "\C-c\C-d" 'delete-char)
+ − 513 (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
+ − 514 (define-key picture-mode-map "\t" 'picture-tab)
+ − 515 (define-key picture-mode-map "\e\t" 'picture-tab-search)
+ − 516 (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
+ − 517 (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
+ − 518 (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
+ − 519 (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
+ − 520 (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
+ − 521 (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
+ − 522 (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
+ − 523 (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
+ − 524 (define-key picture-mode-map "\C-c<" 'picture-movement-left)
+ − 525 (define-key picture-mode-map "\C-c>" 'picture-movement-right)
+ − 526 (define-key picture-mode-map "\C-c^" 'picture-movement-up)
+ − 527 (define-key picture-mode-map "\C-c." 'picture-movement-down)
+ − 528 (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
+ − 529 (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
+ − 530 (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
+ − 531 (define-key picture-mode-map "\C-c\\" 'picture-movement-se)))
+ − 532
+ − 533 (defvar picture-mode-hook nil
+ − 534 "If non-nil, its value is called on entry to Picture mode.
+ − 535 Picture mode is invoked by the command \\[picture-mode].")
+ − 536
+ − 537 (defvar picture-mode-old-local-map)
+ − 538 (defvar picture-mode-old-mode-name)
+ − 539 (defvar picture-mode-old-major-mode)
+ − 540 (defvar picture-mode-old-truncate-lines)
+ − 541
+ − 542 ;;;###autoload
+ − 543 (defun picture-mode ()
+ − 544 "Switch to Picture mode, in which a quarter-plane screen model is used.
+ − 545 Printing characters replace instead of inserting themselves with motion
+ − 546 afterwards settable by these commands:
+ − 547 C-c < Move left after insertion.
+ − 548 C-c > Move right after insertion.
+ − 549 C-c ^ Move up after insertion.
+ − 550 C-c . Move down after insertion.
+ − 551 C-c ` Move northwest (nw) after insertion.
+ − 552 C-c ' Move northeast (ne) after insertion.
+ − 553 C-c / Move southwest (sw) after insertion.
+ − 554 C-c \\ Move southeast (se) after insertion.
+ − 555 The current direction is displayed in the modeline. The initial
+ − 556 direction is right. Whitespace is inserted and tabs are changed to
+ − 557 spaces when required by movement. You can move around in the buffer
+ − 558 with these commands:
+ − 559 \\[picture-move-down] Move vertically to SAME column in previous line.
+ − 560 \\[picture-move-up] Move vertically to SAME column in next line.
+ − 561 \\[picture-end-of-line] Move to column following last non-whitespace character.
+ − 562 \\[picture-forward-column] Move right inserting spaces if required.
+ − 563 \\[picture-backward-column] Move left changing tabs to spaces if required.
+ − 564 C-c C-f Move in direction of current picture motion.
+ − 565 C-c C-b Move in opposite direction of current picture motion.
+ − 566 Return Move to beginning of next line.
+ − 567 You can edit tabular text with these commands:
+ − 568 M-Tab Move to column beneath (or at) next interesting character.
+ − 569 `Indents' relative to a previous line.
+ − 570 Tab Move to next stop in tab stop list.
+ − 571 C-c Tab Set tab stops according to context of this line.
+ − 572 With ARG resets tab stops to default (global) value.
+ − 573 See also documentation of variable picture-tab-chars
+ − 574 which defines \"interesting character\". You can manually
+ − 575 change the tab stop list with command \\[edit-tab-stops].
+ − 576 You can manipulate text with these commands:
+ − 577 C-d Clear (replace) ARG columns after point without moving.
+ − 578 C-c C-d Delete char at point - the command normally assigned to C-d.
+ − 579 \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them.
+ − 580 \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared
+ − 581 text is saved in the kill ring.
+ − 582 \\[picture-open-line] Open blank line(s) beneath current line.
+ − 583 You can manipulate rectangles with these commands:
+ − 584 C-c C-k Clear (or kill) a rectangle and save it.
+ − 585 C-c C-w Like C-c C-k except rectangle is saved in named register.
+ − 586 C-c C-y Overlay (or insert) currently saved rectangle at point.
+ − 587 C-c C-x Like C-c C-y except rectangle is taken from named register.
+ − 588 \\[copy-rectangle-to-register] Copies a rectangle to a register.
+ − 589 \\[advertised-undo] Can undo effects of rectangle overlay commands
+ − 590 commands if invoked soon enough.
+ − 591 You can return to the previous mode with:
+ − 592 C-c C-c Which also strips trailing whitespace from every line.
+ − 593 Stripping is suppressed by supplying an argument.
+ − 594
+ − 595 Entry to this mode calls the value of picture-mode-hook if non-nil.
+ − 596
+ − 597 Note that Picture mode commands will work outside of Picture mode, but
+ − 598 they are not defaultly assigned to keys."
+ − 599 (interactive)
+ − 600 (if (eq major-mode 'picture-mode)
+ − 601 (error "You are already editing a picture.")
+ − 602 (make-local-variable 'picture-mode-old-local-map)
+ − 603 (setq picture-mode-old-local-map (current-local-map))
+ − 604 (use-local-map picture-mode-map)
+ − 605 (make-local-variable 'picture-mode-old-mode-name)
+ − 606 (setq picture-mode-old-mode-name mode-name)
+ − 607 (make-local-variable 'picture-mode-old-major-mode)
+ − 608 (setq picture-mode-old-major-mode major-mode)
+ − 609 (setq major-mode 'picture-mode)
+ − 610 (make-local-variable 'picture-killed-rectangle)
+ − 611 (setq picture-killed-rectangle nil)
+ − 612 (make-local-variable 'tab-stop-list)
+ − 613 (setq tab-stop-list (default-value 'tab-stop-list))
+ − 614 (make-local-variable 'picture-tab-chars)
+ − 615 (setq picture-tab-chars (default-value 'picture-tab-chars))
+ − 616 (make-local-variable 'picture-vertical-step)
+ − 617 (make-local-variable 'picture-horizontal-step)
+ − 618 (make-local-variable 'picture-mode-old-truncate-lines)
+ − 619 (setq picture-mode-old-truncate-lines truncate-lines)
+ − 620 (setq truncate-lines t)
+ − 621
+ − 622 ;; XEmacs addition:
+ − 623 (make-local-variable 'mouse-track-rectangle-p)
+ − 624 (setq mouse-track-rectangle-p t)
+ − 625
+ − 626 (picture-set-motion 0 1)
+ − 627
+ − 628 ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc.
+ − 629 (run-hooks 'edit-picture-hook 'picture-mode-hook)
+ − 630 (message
+ − 631 (substitute-command-keys
+ − 632 "Type \\[picture-mode-exit] in this buffer to return it to %s mode.")
+ − 633 picture-mode-old-mode-name)))
+ − 634
+ − 635 ;;;###autoload
+ − 636 (defalias 'edit-picture 'picture-mode)
+ − 637
+ − 638 (defun picture-mode-exit (&optional nostrip)
+ − 639 "Undo picture-mode and return to previous major mode.
+ − 640 With no argument strips whitespace from end of every line in Picture buffer
+ − 641 otherwise just return to previous mode."
+ − 642 (interactive "P")
+ − 643 (if (not (eq major-mode 'picture-mode))
+ − 644 (error "You aren't editing a Picture.")
+ − 645 (if (not nostrip) (picture-clean))
+ − 646 (setq mode-name picture-mode-old-mode-name)
+ − 647 (use-local-map picture-mode-old-local-map)
+ − 648 (setq major-mode picture-mode-old-major-mode)
+ − 649 (kill-local-variable 'tab-stop-list)
+ − 650 (setq truncate-lines picture-mode-old-truncate-lines)
+ − 651 ;; XEmacs change/addition:
+ − 652 (kill-local-variable 'mouse-track-rectangle-p)
+ − 653 (redraw-modeline)))
+ − 654
+ − 655 (defun picture-clean ()
+ − 656 "Eliminate whitespace at ends of lines."
+ − 657 (save-excursion
+ − 658 (goto-char (point-min))
+ − 659 (while (re-search-forward "[ \t][ \t]*$" nil t)
+ − 660 (delete-region (match-beginning 0) (point)))))
+ − 661
+ − 662 (provide 'picture)
+ − 663
+ − 664 ;;; picture.el ends here
