;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
;;; Code:
(defgroup picture nil
- "Picture mode --- editing using quarter-plane screen model."
+ "Editing text-based pictures (\"ASCII art\")."
:prefix "picture-"
:group 'wp)
;; Picture Movement Commands
-;; When a cursor is on a wide-column character (e.g. Chinese,
-;; Japanese, Korean), this variable tells the desired current column
-;; which may be different from (current-column).
-(defvar picture-desired-column 0)
+(defvar picture-desired-column 0
+ "Desired current column for Picture mode.
+When a cursor is on a wide-column character (e.g. Chinese,
+Japanese, Korean), this may may be different from `current-column'.")
+
-;; If the value of picture-desired-column is far from the current
-;; column, or if the arg ADJUST-TO-CURRENT is non-nil, set it to the
-;; current column. Return the current column.
(defun picture-update-desired-column (adjust-to-current)
+ "Maybe update `picture-desired-column'.
+If the value of `picture-desired-column' is more than one column
+from `current-column', or if the argument ADJUST-TO-CURRENT is
+non-nil, set it to the current column. Return `current-column'."
(let ((current-column (current-column)))
(if (or adjust-to-current
(< picture-desired-column (1- current-column))
"Position point at the beginning of the line.
With ARG not nil, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
- (interactive "P")
+ (interactive "^P")
(if arg (forward-line (1- (prefix-numeric-value arg))))
(beginning-of-line)
(setq picture-desired-column 0))
"Position point after last non-blank character on current line.
With ARG not nil, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
- (interactive "P")
+ (interactive "^P")
(if arg (forward-line (1- (prefix-numeric-value arg))))
(beginning-of-line)
(skip-chars-backward " \t" (prog1 (point) (end-of-line)))
(defun picture-forward-column (arg &optional interactive)
"Move cursor right, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p\nd")
+ (interactive "^p\nd")
(let (deactivate-mark)
(picture-update-desired-column interactive)
(setq picture-desired-column (max 0 (+ picture-desired-column arg)))
(defun picture-backward-column (arg &optional interactive)
"Move cursor left, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p\nd")
+ (interactive "^p\nd")
(picture-update-desired-column interactive)
(picture-forward-column (- arg)))
(defun picture-move-down (arg)
"Move vertically down, making whitespace if necessary.
With argument, move that many lines."
- (interactive "p")
+ (interactive "^p")
(let (deactivate-mark)
(picture-update-desired-column nil)
(picture-newline arg)
(defun picture-move-up (arg)
"Move vertically up, making whitespace if necessary.
With argument, move that many lines."
- (interactive "p")
+ (interactive "^p")
(picture-update-desired-column nil)
(picture-move-down (- arg)))
"Move point in direction of current picture motion in Picture mode.
With ARG do it that many times. Useful for delineating rectangles in
conjunction with diagonal picture motion.
-Do \\[command-apropos] picture-movement to see commands which control motion."
- (interactive "p")
+Use \"\\[command-apropos] picture-movement\" to see commands which control motion."
+ (interactive "^p")
(picture-move-down (* arg picture-vertical-step))
(picture-forward-column (* arg picture-horizontal-step)))
"Move point in direction opposite of current picture motion in Picture mode.
With ARG do it that many times. Useful for delineating rectangles in
conjunction with diagonal picture motion.
-Do \\[command-apropos] picture-movement to see commands which control motion."
- (interactive "p")
+Use \"\\[command-apropos] picture-movement\" to see commands which control motion."
+ (interactive "^p")
(picture-motion (- arg)))
(defun picture-mouse-set-point (event)
(spacing (when (display-graphic-p frame)
(or (with-current-buffer (window-buffer window)
line-spacing)
- (frame-parameter frame 'line-spacing))))
- rows cols)
+ (frame-parameter frame 'line-spacing)))))
(cond ((floatp spacing)
(setq spacing (truncate (* spacing char-ht))))
((null spacing)
"Insert this character in place of character previously at the cursor.
The cursor then moves in the direction you previously specified
with the commands `picture-movement-right', `picture-movement-up', etc.
-Do \\[command-apropos] `picture-movement' to see those commands."
+Use \"\\[command-apropos] picture-movement\" to see those commands."
(interactive "p")
(picture-update-desired-column (not (eq this-command last-command)))
(picture-insert last-command-event arg)) ; Always a character in this case.
"Move to the beginning of the following line.
With argument, moves that many lines (up, if negative argument);
always moves to the beginning of a line."
- (interactive "p")
- (if (< arg 0)
- (forward-line arg)
- (while (> arg 0)
- (end-of-line)
- (if (eobp) (newline) (forward-char 1))
- (setq arg (1- arg)))))
+ (interactive "^p")
+ (let ((start (point))
+ (lines-left (forward-line arg)))
+ (if (and (eobp)
+ (> (point) start))
+ (newline))
+ (if (> lines-left 0)
+ (newline lines-left))))
(defun picture-open-line (arg)
"Insert an empty line after the current line.
(defcustom picture-tab-chars "!-~"
"A character set which controls behavior of commands.
-\\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
-regular expression, any regexp special characters will be quoted.
+\\[picture-set-tab-stops] and \\[picture-tab-search].
+The syntax for this variable is like the syntax used inside of `[...]'
+in a regular expression--but without the `[' and the `]'.
+It is NOT a regular expression, any regexp special characters will be quoted.
It defines a set of \"interesting characters\" to look for when setting
\(or searching for) tab stops, initially \"!-~\" (all printing characters).
For example, suppose that you are editing a table which is formatted thus:
line. The character must be preceded by whitespace.
\"interesting characters\" are defined by variable `picture-tab-chars'.
If no such character is found, move to beginning of line."
- (interactive "P")
+ (interactive "^P")
(let ((target (current-column)))
(save-excursion
(if (and (not arg)
With prefix arg, overwrite the traversed text with spaces. The tab stop
list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
See also documentation for variable `picture-tab-chars'."
- (interactive "P")
+ (interactive "^P")
(let* ((opoint (point)))
(move-to-tab-stop)
(if arg
\f
;; Picture Keymap, entry and exit points.
-(defvar picture-mode-map nil)
-
-(defun picture-substitute (oldfun newfun)
- (define-key picture-mode-map (vector 'remap oldfun) newfun))
-
-(if (not picture-mode-map)
- (progn
- (setq picture-mode-map (make-keymap))
- (picture-substitute 'self-insert-command 'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-command
- 'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-autofilling
- 'picture-self-insert)
- (picture-substitute 'forward-char 'picture-forward-column)
- (picture-substitute 'backward-char 'picture-backward-column)
- (picture-substitute 'delete-char 'picture-clear-column)
- ;; There are two possibilities for what is normally on DEL.
- (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
- (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
- (picture-substitute 'kill-line 'picture-clear-line)
- (picture-substitute 'open-line 'picture-open-line)
- (picture-substitute 'newline 'picture-newline)
- (picture-substitute 'newline-and-indent 'picture-duplicate-line)
- (picture-substitute 'next-line 'picture-move-down)
- (picture-substitute 'previous-line 'picture-move-up)
- (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
- (picture-substitute 'end-of-line 'picture-end-of-line)
- (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
-
- (define-key picture-mode-map "\C-c\C-d" 'delete-char)
- (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
- (define-key picture-mode-map "\t" 'picture-tab)
- (define-key picture-mode-map "\e\t" 'picture-tab-search)
- (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
- (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
- (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
- (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
- (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
- (define-key picture-mode-map "\C-c\C-r" 'picture-draw-rectangle)
- (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
- (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
- (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
- (define-key picture-mode-map "\C-c<" 'picture-movement-left)
- (define-key picture-mode-map "\C-c>" 'picture-movement-right)
- (define-key picture-mode-map "\C-c^" 'picture-movement-up)
- (define-key picture-mode-map "\C-c." 'picture-movement-down)
- (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
- (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
- (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
- (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
- (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
- (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
- (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
- (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
- (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
- (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
- (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
- (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
+(defalias 'picture-delete-char 'delete-char)
+
+(defvar picture-mode-map
+ (let ((map (make-keymap)))
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap completion-separator-self-insert-command]
+ 'picture-self-insert)
+ (define-key map [remap completion-separator-self-insert-autofilling]
+ 'picture-self-insert)
+ (define-key map [remap forward-char] 'picture-forward-column)
+ (define-key map [remap backward-char] 'picture-backward-column)
+ (define-key map [remap delete-char] 'picture-clear-column)
+ ;; There are two possibilities for what is normally on DEL.
+ (define-key map [remap backward-delete-char-untabify]
+ 'picture-backward-clear-column)
+ (define-key map [remap delete-backward-char] 'picture-backward-clear-column)
+ (define-key map [remap kill-line] 'picture-clear-line)
+ (define-key map [remap open-line] 'picture-open-line)
+ (define-key map [remap newline] 'picture-newline)
+ (define-key map [remap newline-and-indent] 'picture-duplicate-line)
+ (define-key map [remap next-line] 'picture-move-down)
+ (define-key map [remap previous-line] 'picture-move-up)
+ (define-key map [remap move-beginning-of-line] 'picture-beginning-of-line)
+ (define-key map [remap move-end-of-line] 'picture-end-of-line)
+ (define-key map [remap mouse-set-point] 'picture-mouse-set-point)
+ (define-key map "\C-c\C-d" 'picture-delete-char)
+ (define-key map "\e\t" 'picture-toggle-tab-state)
+ (define-key map "\t" 'picture-tab)
+ (define-key map "\e\t" 'picture-tab-search)
+ (define-key map "\C-c\t" 'picture-set-tab-stops)
+ (define-key map "\C-c\C-k" 'picture-clear-rectangle)
+ (define-key map "\C-c\C-w" 'picture-clear-rectangle-to-register)
+ (define-key map "\C-c\C-y" 'picture-yank-rectangle)
+ (define-key map "\C-c\C-x" 'picture-yank-rectangle-from-register)
+ (define-key map "\C-c\C-r" 'picture-draw-rectangle)
+ (define-key map "\C-c\C-c" 'picture-mode-exit)
+ (define-key map "\C-c\C-f" 'picture-motion)
+ (define-key map "\C-c\C-b" 'picture-motion-reverse)
+ (define-key map "\C-c<" 'picture-movement-left)
+ (define-key map "\C-c>" 'picture-movement-right)
+ (define-key map "\C-c^" 'picture-movement-up)
+ (define-key map "\C-c." 'picture-movement-down)
+ (define-key map "\C-c`" 'picture-movement-nw)
+ (define-key map "\C-c'" 'picture-movement-ne)
+ (define-key map "\C-c/" 'picture-movement-sw)
+ (define-key map "\C-c\\" 'picture-movement-se)
+ (define-key map [(control ?c) left] 'picture-movement-left)
+ (define-key map [(control ?c) right] 'picture-movement-right)
+ (define-key map [(control ?c) up] 'picture-movement-up)
+ (define-key map [(control ?c) down] 'picture-movement-down)
+ (define-key map [(control ?c) home] 'picture-movement-nw)
+ (define-key map [(control ?c) prior] 'picture-movement-ne)
+ (define-key map [(control ?c) end] 'picture-movement-sw)
+ (define-key map [(control ?c) next] 'picture-movement-se)
+ map)
+ "Keymap used in `picture-mode'.")
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
You can manipulate text with these commands:
Clear ARG columns after point without moving: \\[picture-clear-column]
- Delete char at point: \\[delete-char]
+ Delete char at point: \\[picture-delete-char]
Clear ARG columns backward: \\[picture-backward-clear-column]
Clear ARG lines, advancing over them: \\[picture-clear-line]
(the cleared text is saved in the kill ring)
Entry to this mode calls the value of `picture-mode-hook' if non-nil.
Note that Picture mode commands will work outside of Picture mode, but
-they are not defaultly assigned to keys."
+they are not by default assigned to keys."
(interactive)
(if (eq major-mode 'picture-mode)
(error "You are already editing a picture")