![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to picture.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to picture.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; "Picture mode" -- editing using quarter-plane screen model. ! 2: ;; Copyright (C) 1985 Richard M. Stallman and K. Shane Hartman ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: (defun move-to-column-force (column) ! 23: "Move to column COLUMN in current line. ! 24: Differs from move-to-column in that it creates or modifies whitespace ! 25: if necessary to attain exactly the specified column." ! 26: (move-to-column column) ! 27: (let ((col (current-column))) ! 28: (if (< col column) ! 29: (indent-to column) ! 30: (if (and (/= col column) ! 31: (= (preceding-char) ?\t)) ! 32: (let (indent-tabs-mode) ! 33: (delete-char -1) ! 34: (indent-to col) ! 35: (move-to-column column)))))) ! 36: ! 37: ! 38: ;; Picture Movement Commands ! 39: ! 40: (defun Picture-end-of-line (&optional arg) ! 41: "Position point after last non-blank character on current line. ! 42: With ARG not nil, move forward ARG - 1 lines first. ! 43: If scan reaches end of buffer, stop there without error." ! 44: (interactive "P") ! 45: (if arg (forward-line (1- (prefix-numeric-value arg)))) ! 46: (beginning-of-line) ! 47: (skip-chars-backward " \t" (prog1 (point) (end-of-line)))) ! 48: ! 49: (defun Picture-forward-column (arg) ! 50: "Move cursor right, making whitespace if necessary. ! 51: With argument, move that many columns." ! 52: (interactive "p") ! 53: (move-to-column-force (+ (current-column) arg))) ! 54: ! 55: (defun Picture-backward-column (arg) ! 56: "Move cursor left, making whitespace if necessary. ! 57: With argument, move that many columns." ! 58: (interactive "p") ! 59: (move-to-column-force (- (current-column) arg))) ! 60: ! 61: (defun Picture-move-down (arg) ! 62: "Move vertically down, making whitespace if necessary. ! 63: With argument, move that many lines." ! 64: (interactive "p") ! 65: (let ((col (current-column))) ! 66: (Picture-newline arg) ! 67: (move-to-column-force col))) ! 68: ! 69: (defconst picture-vertical-step 0 ! 70: "Amount to move vertically after text character in Picture mode.") ! 71: ! 72: (defconst picture-horizontal-step 1 ! 73: "Amount to move horizontally after text character in Picture mode.") ! 74: ! 75: (defun Picture-move-up (arg) ! 76: "Move vertically up, making whitespace if necessary. ! 77: With argument, move that many lines." ! 78: (interactive "p") ! 79: (Picture-move-down (- arg))) ! 80: ! 81: (defun picture-movement-right () ! 82: "Move right after self-inserting character in Picture mode." ! 83: (interactive) ! 84: (Picture-set-motion 0 1)) ! 85: ! 86: (defun picture-movement-left () ! 87: "Move left after self-inserting character in Picture mode." ! 88: (interactive) ! 89: (Picture-set-motion 0 -1)) ! 90: ! 91: (defun picture-movement-up () ! 92: "Move up after self-inserting character in Picture mode." ! 93: (interactive) ! 94: (Picture-set-motion -1 0)) ! 95: ! 96: (defun picture-movement-down () ! 97: "Move down after self-inserting character in Picture mode." ! 98: (interactive) ! 99: (Picture-set-motion 1 0)) ! 100: ! 101: (defun picture-movement-nw () ! 102: "Move up and left after self-inserting character in Picture mode." ! 103: (interactive) ! 104: (Picture-set-motion -1 -1)) ! 105: ! 106: (defun picture-movement-ne () ! 107: "Move up and right after self-inserting character in Picture mode." ! 108: (interactive) ! 109: (Picture-set-motion -1 1)) ! 110: ! 111: (defun picture-movement-sw () ! 112: "Move down and left after self-inserting character in Picture mode." ! 113: (interactive) ! 114: (Picture-set-motion 1 -1)) ! 115: ! 116: (defun picture-movement-se () ! 117: "Move down and right after self-inserting character in Picture mode." ! 118: (interactive) ! 119: (Picture-set-motion 1 1)) ! 120: ! 121: (defun Picture-set-motion (vert horiz) ! 122: "Set VERTICAL and HORIZONTAL increments for movement in Picture mode. ! 123: The mode line is updated to reflect the current direction." ! 124: (setq picture-vertical-step vert ! 125: picture-horizontal-step horiz) ! 126: (setq mode-name ! 127: (format "Picture:%s" ! 128: (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2)))) ! 129: '(nw up ne left none right sw down se))))) ! 130: ;; Kludge - force the mode line to be updated. Is there a better ! 131: ;; way to this? ! 132: (set-buffer-modified-p (buffer-modified-p)) ! 133: (message "")) ! 134: ! 135: (defun Picture-move () ! 136: "Move in direction of picture-vertical-step and picture-horizontal-step." ! 137: (Picture-move-down picture-vertical-step) ! 138: (Picture-forward-column picture-horizontal-step)) ! 139: ! 140: (defun Picture-motion (arg) ! 141: "Move point in direction of current picture motion in Picture mode. ! 142: With ARG do it that many times. Useful for delineating rectangles in ! 143: conjunction with diagonal picture motion. ! 144: Do \\[command-apropos] picture-movement to see commands which control motion." ! 145: (interactive "p") ! 146: (Picture-move-down (* arg picture-vertical-step)) ! 147: (Picture-forward-column (* arg picture-horizontal-step))) ! 148: ! 149: (defun Picture-motion-reverse (arg) ! 150: "Move point in direction opposite of current picture motion in Picture mode. ! 151: With ARG do it that many times. Useful for delineating rectangles in ! 152: conjunction with diagonal picture motion. ! 153: Do \\[command-apropos] picture-movement to see commands which control motion." ! 154: (interactive "p") ! 155: (Picture-motion (- arg))) ! 156: ! 157: ! 158: ;; Picture insertion and deletion. ! 159: ! 160: (defun Picture-self-insert (arg) ! 161: "Insert this character in place of character previously at the cursor. ! 162: The cursor then moves in the direction you previously specified ! 163: with the commands picture-movement-right, picture-movement-up, etc. ! 164: Do \\[command-apropos] picture-movement to see those commands." ! 165: (interactive "p") ! 166: (while (> arg 0) ! 167: (setq arg (1- arg)) ! 168: (move-to-column-force (1+ (current-column))) ! 169: (delete-char -1) ! 170: (insert last-input-char) ! 171: (forward-char -1) ! 172: (Picture-move))) ! 173: ! 174: (defun Picture-clear-column (arg) ! 175: "Clear out ARG columns after point without moving." ! 176: (interactive "p") ! 177: (let* ((opoint (point)) ! 178: (original-col (current-column)) ! 179: (target-col (+ original-col arg))) ! 180: (move-to-column-force target-col) ! 181: (delete-region opoint (point)) ! 182: (save-excursion ! 183: (indent-to (max target-col original-col))))) ! 184: ! 185: (defun Picture-backward-clear-column (arg) ! 186: "Clear out ARG columns before point, moving back over them." ! 187: (interactive "p") ! 188: (Picture-clear-column (- arg))) ! 189: ! 190: (defun Picture-clear-line (arg) ! 191: "Clear out rest of line; if at end of line, advance to next line. ! 192: Cleared-out line text goes into the kill ring, as do ! 193: newlines that are advanced over. ! 194: With argument, clear out (and save in kill ring) that many lines." ! 195: (interactive "P") ! 196: (if arg ! 197: (progn ! 198: (setq arg (prefix-numeric-value arg)) ! 199: (kill-region (point) (scan-buffer (point) (if (> arg 0) arg (- arg 1)) ?\n)) ! 200: (newline (if (> arg 0) arg (- arg)))) ! 201: (if (looking-at "[ \t]*$") ! 202: (kill-ring-save (point) (progn (forward-line 1) (point))) ! 203: (kill-region (point) (progn (end-of-line) (point)))))) ! 204: ! 205: (defun Picture-newline (arg) ! 206: "Move to the beginning of the following line. ! 207: With argument, moves that many lines (up, if negative argument); ! 208: always moves to the beginning of a line." ! 209: (interactive "p") ! 210: (if (< arg 0) ! 211: (forward-line arg) ! 212: (while (> arg 0) ! 213: (end-of-line) ! 214: (if (eobp) (newline) (forward-char 1)) ! 215: (setq arg (1- arg))))) ! 216: ! 217: (defun Picture-open-line (arg) ! 218: "Insert an empty line after the current line. ! 219: With positive argument insert that many lines." ! 220: (interactive "p") ! 221: (save-excursion ! 222: (end-of-line) ! 223: (open-line arg))) ! 224: ! 225: (defun Picture-duplicate-line () ! 226: "Insert a duplicate of the current line, below it." ! 227: (interactive) ! 228: (save-excursion ! 229: (let ((contents ! 230: (buffer-substring ! 231: (progn (beginning-of-line) (point)) ! 232: (progn (Picture-newline 1) (point))))) ! 233: (forward-line -1) ! 234: (insert contents)))) ! 235: ! 236: ! 237: ;; Picture Tabs ! 238: ! 239: (defvar picture-tab-chars "!-~" ! 240: "*A character set which controls behavior of commands ! 241: \\[Picture-set-tab-stops] and \\[Picture-tab-search]. It is NOT a ! 242: regular expression, any regexp special characters will be quoted. ! 243: It defines a set of \"interesting characters\" to look for when setting ! 244: \(or searching for) tab stops, initially \"!-~\" (all printing characters). ! 245: For example, suppose that you are editing a table which is formatted thus: ! 246: | foo | bar + baz | 23 * ! 247: | bubbles | and + etc | 97 * ! 248: and that picture-tab-chars is \"|+*\". Then invoking ! 249: \\[Picture-set-tab-stops] on either of the previous lines would result ! 250: in the following tab stops ! 251: : : : : ! 252: Another example - \"A-Za-z0-9\" would produce the tab stops ! 253: : : : : ! 254: ! 255: Note that if you want the character `-' to be in the set, it must be ! 256: included in a range or else appear in a context where it cannot be ! 257: taken for indicating a range (e.g. \"-A-Z\" declares the set to be the ! 258: letters `A' through `Z' and the character `-'). If you want the ! 259: character `\\' in the set it must be preceded by itself: \"\\\\\". ! 260: ! 261: The command \\[Picture-tab-search] is defined to move beneath (or to) a ! 262: character belonging to this set independent of the tab stops list.") ! 263: ! 264: (defun Picture-set-tab-stops (&optional arg) ! 265: "Set value of tab-stop-list according to context of this line. ! 266: This controls the behavior of \\[Picture-tab]. A tab stop ! 267: is set at every column occupied by an \"interesting character\" that is ! 268: preceded by whitespace. Interesting characters are defined by the ! 269: variable picture-tab-chars, see its documentation for an example ! 270: of usage. With ARG, just (re)set tab-stop-list to its default value. ! 271: The tab stops computed are displayed in the minibuffer with `:' at ! 272: each stop." ! 273: (interactive "P") ! 274: (save-excursion ! 275: (let (tabs) ! 276: (if arg ! 277: (setq tabs (default-value 'tab-stop-list)) ! 278: (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]"))) ! 279: (beginning-of-line) ! 280: (let ((bol (point))) ! 281: (end-of-line) ! 282: (while (re-search-backward regexp bol t) ! 283: (skip-chars-forward " \t") ! 284: (setq tabs (cons (current-column) tabs))) ! 285: (if (null tabs) ! 286: (error "No characters in set %s on this line." ! 287: (regexp-quote picture-tab-chars)))))) ! 288: (setq tab-stop-list tabs) ! 289: (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ ))) ! 290: (while tabs ! 291: (aset blurb (car tabs) ?:) ! 292: (setq tabs (cdr tabs))) ! 293: (message blurb))))) ! 294: ! 295: (defun Picture-tab-search (&optional arg) ! 296: "Move to column beneath next interesting char in previous line. ! 297: With ARG move to column occupied by next interesting character in this ! 298: line. The character must be preceded by whitespace. ! 299: \"interesting characters\" are defined by variable picture-tab-chars. ! 300: If no such character is found, move to beginning of line." ! 301: (interactive "P") ! 302: (let ((target (current-column))) ! 303: (save-excursion ! 304: (if (and (not arg) ! 305: (progn ! 306: (beginning-of-line) ! 307: (skip-chars-backward ! 308: (concat "^" (regexp-quote picture-tab-chars)) ! 309: (point-min)) ! 310: (not (bobp)))) ! 311: (move-to-column target)) ! 312: (if (re-search-forward ! 313: (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]") ! 314: (save-excursion (end-of-line) (point)) ! 315: 'move) ! 316: (setq target (1- (current-column))) ! 317: (setq target nil))) ! 318: (if target ! 319: (move-to-column-force target) ! 320: (beginning-of-line)))) ! 321: ! 322: (defun Picture-tab (&optional arg) ! 323: "Tab transparently (move) to next tab stop. ! 324: With ARG overwrite the traversed text with spaces. The tab stop ! 325: list can be changed by \\[Picture-set-tab-stops] and \\[edit-tab-stops]. ! 326: See also documentation for variable picture-tab-chars." ! 327: (interactive "P") ! 328: (let* ((opoint (point)) ! 329: (target (prog2 (tab-to-tab-stop) ! 330: (current-column) ! 331: (delete-region opoint (point))))) ! 332: (move-to-column-force target) ! 333: (if arg ! 334: (let (indent-tabs-mode) ! 335: (delete-region opoint point) ! 336: (indent-to target))))) ! 337: ! 338: ! 339: ;; Picture Rectangles ! 340: ! 341: (defconst picture-killed-rectangle nil ! 342: "Rectangle killed or copied by \\[Picture-clear-rectangle] in Picture mode. ! 343: The contents can be retrieved by \\[Picture-yank-rectangle]") ! 344: ! 345: (defun Picture-clear-rectangle (start end register &optional killp) ! 346: "Clear and save rectangle delineated by point and mark. ! 347: The rectangle is saved for yanking by \\[Picture-yank-rectangle] and replaced ! 348: with whitespace. The previously saved rectangle, if any, is lost. ! 349: With prefix argument, the rectangle is actually killed, shifting remaining ! 350: text." ! 351: (interactive "r\nP") ! 352: (setq picture-killed-rectangle (Picture-snarf-rectangle start end killp))) ! 353: ! 354: (defun Picture-clear-rectangle-to-register (start end register &optional killp) ! 355: "Clear rectangle delineated by point and mark into REGISTER. ! 356: The rectangle is saved in REGISTER and replaced with whitespace. ! 357: With prefix argument, the rectangle is actually killed, shifting remaining ! 358: text." ! 359: (interactive "r\ncRectangle to register: \nP") ! 360: (set-register register (Picture-snarf-rectangle start end killp))) ! 361: ! 362: (defun Picture-snarf-rectangle (start end &optional killp) ! 363: (let ((column (current-column)) ! 364: (indent-tabs-mode nil)) ! 365: (prog1 (save-excursion ! 366: (if killp ! 367: (delete-extract-rectangle start end) ! 368: (prog1 (extract-rectangle start end) ! 369: (clear-rectangle start end)))) ! 370: (move-to-column-force column)))) ! 371: ! 372: (defun Picture-yank-rectangle (&optional insertp) ! 373: "Overlay rectangle saved by \\[Picture-clear-rectangle] ! 374: The rectangle is positioned with upper left corner at point, overwriting ! 375: existing text. With prefix argument, the rectangle is inserted instead, ! 376: shifting existing text. Leaves mark at one corner of rectangle and ! 377: point at the other (diagonally opposed) corner." ! 378: (interactive "P") ! 379: (if (not (consp picture-killed-rectangle)) ! 380: (error "No rectangle saved.") ! 381: (Picture-insert-rectangle picture-killed-rectangle insertp))) ! 382: ! 383: (defun Picture-yank-rectangle-from-register (register &optional insertp) ! 384: "Overlay rectangle saved in REGISTER. ! 385: The rectangle is positioned with upper left corner at point, overwriting ! 386: existing text. With prefix argument, the rectangle is ! 387: inserted instead, shifting existing text. Leaves mark at one corner ! 388: of rectangle and point at the other (diagonally opposed) corner." ! 389: (interactive "cRectangle from register: \nP") ! 390: (let ((rectangle (get-register register))) ! 391: (if (not (consp rectangle)) ! 392: (error "Register %c does not contain a rectangle." register) ! 393: (Picture-insert-rectangle rectangle insertp)))) ! 394: ! 395: (defun Picture-insert-rectangle (rectangle &optional insertp) ! 396: "Overlay RECTANGLE with upper left corner at point. ! 397: Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted. ! 398: Leaves the region surrounding the rectangle." ! 399: (let ((indent-tabs-mode nil)) ! 400: (if (not insertp) ! 401: (save-excursion ! 402: (delete-rectangle (point) ! 403: (progn ! 404: (Picture-forward-column (length (car rectangle))) ! 405: (Picture-move-down (1- (length rectangle))) ! 406: (point))))) ! 407: (push-mark) ! 408: (insert-rectangle rectangle))) ! 409: ! 410: ! 411: ;; Picture Keymap, entry and exit points. ! 412: ! 413: (defconst picture-mode-map nil) ! 414: ! 415: (if (not picture-mode-map) ! 416: (let ((i ?\ )) ! 417: (setq picture-mode-map (make-keymap)) ! 418: (while (< i ?\177) ! 419: (aset picture-mode-map i 'Picture-self-insert) ! 420: (setq i (1+ i))) ! 421: (define-key picture-mode-map "\C-f" 'Picture-forward-column) ! 422: (define-key picture-mode-map "\C-b" 'Picture-backward-column) ! 423: (define-key picture-mode-map "\C-d" 'Picture-clear-column) ! 424: (define-key picture-mode-map "\C-c\C-d" 'delete-char) ! 425: (define-key picture-mode-map "\177" 'Picture-backward-clear-column) ! 426: (define-key picture-mode-map "\C-k" 'Picture-clear-line) ! 427: (define-key picture-mode-map "\C-o" 'Picture-open-line) ! 428: (define-key picture-mode-map "\C-m" 'Picture-newline) ! 429: (define-key picture-mode-map "\C-j" 'Picture-duplicate-line) ! 430: (define-key picture-mode-map "\C-n" 'Picture-move-down) ! 431: (define-key picture-mode-map "\C-p" 'Picture-move-up) ! 432: (define-key picture-mode-map "\C-e" 'Picture-end-of-line) ! 433: (define-key picture-mode-map "\e\t" 'Picture-toggle-tab-state) ! 434: (define-key picture-mode-map "\t" 'Picture-tab) ! 435: (define-key picture-mode-map "\e\t" 'Picture-tab-search) ! 436: (define-key picture-mode-map "\C-c\t" 'Picture-set-tab-stops) ! 437: (define-key picture-mode-map "\C-c\C-k" 'Picture-clear-rectangle) ! 438: (define-key picture-mode-map "\C-c\C-w" 'Picture-clear-rectangle-to-register) ! 439: (define-key picture-mode-map "\C-c\C-y" 'Picture-yank-rectangle) ! 440: (define-key picture-mode-map "\C-c\C-x" 'Picture-yank-rectangle-from-register) ! 441: (define-key picture-mode-map "\C-c\C-c" 'Picture-mode-exit) ! 442: (define-key picture-mode-map "\C-c\C-f" 'Picture-motion) ! 443: (define-key picture-mode-map "\C-c\C-b" 'Picture-motion-reverse) ! 444: (define-key picture-mode-map "\e`" 'picture-movement-left) ! 445: (define-key picture-mode-map "\e'" 'picture-movement-right) ! 446: (define-key picture-mode-map "\e-" 'picture-movement-up) ! 447: (define-key picture-mode-map "\e=" 'picture-movement-down) ! 448: (define-key picture-mode-map "\C-c`" 'picture-movement-nw) ! 449: (define-key picture-mode-map "\C-c'" 'picture-movement-ne) ! 450: (define-key picture-mode-map "\C-c/" 'picture-movement-sw) ! 451: (define-key picture-mode-map "\C-c\\" 'picture-movement-se))) ! 452: ! 453: (defvar edit-picture-hook nil ! 454: "If non-nil, it's value is called on entry to Picture mode. ! 455: Picture mode is invoked by the command \\[edit-picture].") ! 456: ! 457: (defun edit-picture () ! 458: "Switch to Picture mode, in which a quarter-plane screen model is used. ! 459: Printing characters replace instead of inserting themselves with motion ! 460: afterwards settable by these commands: ! 461: M-` Move left after insertion. ! 462: M-' Move right after insertion. ! 463: M-- Move up after insertion. ! 464: M-= Move down after insertion. ! 465: C-c ` Move northwest (nw) after insertion. ! 466: C-c ' Move northeast (ne) after insertion. ! 467: C-c / Move southwest (sw) after insertion. ! 468: C-c \\ Move southeast (se) after insertion. ! 469: The current direction is displayed in the mode line. The initial ! 470: direction is right. Whitespace is inserted and tabs are changed to ! 471: spaces when required by movement. You can move around in the buffer ! 472: with these commands: ! 473: C-p Move vertically to SAME column in previous line. ! 474: C-n Move vertically to SAME column in next line. ! 475: C-e Move to column following last non-whitespace character. ! 476: C-f Move right inserting spaces if required. ! 477: C-b Move left changing tabs to spaces if required. ! 478: C-c C-f Move in direction of current picture motion. ! 479: C-c C-b Move in opposite direction of current picture motion. ! 480: Return Move to beginning of next line. ! 481: You can edit tabular text with these commands: ! 482: M-Tab Move to column beneath (or at) next interesting charecter. ! 483: `Indents' relative to a previous line. ! 484: Tab Move to next stop in tab stop list. ! 485: C-c Tab Set tab stops according to context of this line. ! 486: With ARG resets tab stops to default (global) value. ! 487: See also documentation of variable picture-tab-chars ! 488: which defines \"interesting character\". You can manually ! 489: change the tab stop list with command \\[edit-tab-stops]. ! 490: You can manipulate text with these commands: ! 491: C-d Clear (replace) ARG columns after point without moving. ! 492: C-c C-d Delete char at point - the command normally assigned to C-d. ! 493: Delete Clear (replace) ARG columns before point, moving back over them. ! 494: C-k Clear ARG lines, advancing over them. The cleared ! 495: text is saved in the kill ring. ! 496: C-o Open blank line(s) beneath current line. ! 497: You can manipulate rectangles with these commands: ! 498: C-c C-k Clear (or kill) a rectangle and save it. ! 499: C-c C-w Like C-c C-k except rectangle is saved in named register. ! 500: C-c C-y Overlay (or insert) currently saved rectangle at point. ! 501: C-c C-x Like C-c C-y except rectangle is taken from named register. ! 502: \\[copy-rectangle-to-register] Copies a rectangle to a register. ! 503: \\[advertised-undo] Can undo effects of rectangle overlay commands ! 504: commands if invoked soon enough. ! 505: You can return to the previous mode with: ! 506: C-c C-c Which also strips trailing whitespace from every line. ! 507: Stripping is suppressed by supplying an argument. ! 508: ! 509: Entry to this mode calls the value of edit-picture-hook if non-nil. ! 510: ! 511: Note that Picture mode commands will work outside of Picture mode, but ! 512: they are not defaultly assigned to keys." ! 513: (interactive) ! 514: (if (eq major-mode 'edit-picture) ! 515: (error "You are already editing a Picture.") ! 516: (make-local-variable 'Picture-mode-old-local-map) ! 517: (setq Picture-mode-old-local-map (current-local-map)) ! 518: (use-local-map picture-mode-map) ! 519: (make-local-variable 'Picture-mode-old-mode-name) ! 520: (setq Picture-mode-old-mode-name mode-name) ! 521: (make-local-variable 'Picture-mode-old-major-mode) ! 522: (setq Picture-mode-old-major-mode major-mode) ! 523: (setq major-mode 'edit-picture) ! 524: (make-local-variable 'picture-killed-rectangle) ! 525: (setq picture-killed-rectangle nil) ! 526: (make-local-variable 'tab-stop-list) ! 527: (setq tab-stop-list (default-value 'tab-stop-list)) ! 528: (make-local-variable 'picture-tab-chars) ! 529: (setq picture-tab-chars (default-value 'picture-tab-chars)) ! 530: (make-local-variable 'Picture-vertical-step) ! 531: (make-local-variable 'Picture-horizontal-step) ! 532: (Picture-set-motion 0 1) ! 533: (run-hooks 'edit-picture-hook) ! 534: (message ! 535: (substitute-command-keys ! 536: "Type \\[Picture-mode-exit] in this buffer to return it to %s mode.") ! 537: Picture-mode-old-mode-name))) ! 538: ! 539: (fset 'picture-mode 'edit-picture) ; for the confused ! 540: ! 541: (defun Picture-mode-exit (&optional nostrip) ! 542: "Undo edit-picture and return to previous major mode. ! 543: With no argument strips whitespace from end of every line in Picture buffer ! 544: otherwise just return to previous mode." ! 545: (interactive "P") ! 546: (if (not (eq major-mode 'edit-picture)) ! 547: (error "You aren't editing a Picture.") ! 548: (if (not nostrip) (Picture-clean)) ! 549: (setq mode-name Picture-mode-old-mode-name) ! 550: (use-local-map Picture-mode-old-local-map) ! 551: (setq major-mode Picture-mode-old-major-mode) ! 552: (kill-local-variable 'tab-stop-list) ! 553: ;; Kludge - force the mode line to be updated. Is there a better ! 554: ;; way to do this? ! 555: (set-buffer-modified-p (buffer-modified-p)))) ! 556: ! 557: (defun Picture-clean () ! 558: "Eliminate whitespace at ends of lines." ! 559: (save-excursion ! 560: (goto-char (point-min)) ! 561: (while (re-search-forward "[ \t][ \t]*$" nil t) ! 562: (delete-region (match-beginning 0) (point)))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.