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