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