-;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model.
+;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2002, 2003 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
(defgroup picture nil
- "Picture mode --- editing using quarter-plane screen model."
+ "Picture mode --- editing using quarter-plane screen model."
:prefix "picture-"
:group 'editing)
(skip-chars-backward " \t" (prog1 (point) (end-of-line)))
(setq picture-desired-column (current-column)))
-(defun picture-forward-column (arg)
+(defun picture-forward-column (arg &optional interactive)
"Move cursor right, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p")
- (picture-update-desired-column (interactive-p))
- (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
- (let ((current-column (move-to-column picture-desired-column t)))
- (if (and (> current-column picture-desired-column)
- (< arg 0))
- ;; It seems that we have just tried to move to the right
- ;; column of a multi-column character.
- (forward-char -1))))
-
-(defun picture-backward-column (arg)
+ (interactive "p\nd")
+ (let (deactivate-mark)
+ (picture-update-desired-column interactive)
+ (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
+ (let ((current-column (move-to-column picture-desired-column t)))
+ (if (and (> current-column picture-desired-column)
+ (< arg 0))
+ ;; It seems that we have just tried to move to the right
+ ;; column of a multi-column character.
+ (forward-char -1)))))
+
+(defun picture-backward-column (arg &optional interactive)
"Move cursor left, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p")
- (picture-update-desired-column (interactive-p))
+ (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")
- (picture-update-desired-column nil)
- (picture-newline arg)
- (let ((current-column (move-to-column picture-desired-column t)))
- (if (> current-column picture-desired-column)
- (forward-char -1))))
-
-(defconst picture-vertical-step 0
+ (let (deactivate-mark)
+ (picture-update-desired-column nil)
+ (picture-newline arg)
+ (let ((current-column (move-to-column picture-desired-column t)))
+ (if (> current-column picture-desired-column)
+ (forward-char -1)))))
+
+(defvar picture-vertical-step 0
"Amount to move vertically after text character in Picture mode.")
-(defconst picture-horizontal-step 1
+(defvar picture-horizontal-step 1
"Amount to move horizontally after text character in Picture mode.")
(defun picture-move-up (arg)
"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."
+Do \\[command-apropos] picture-movement to see commands which control motion."
(interactive "p")
(picture-motion (- arg)))
+(defun picture-mouse-set-point (event)
+ "Move point to the position clicked on, making whitespace if necessary."
+ (interactive "e")
+ (let* ((pos (posn-col-row (event-start event)))
+ (x (car pos))
+ (y (cdr pos))
+ (current-row (count-lines (window-start) (line-beginning-position))))
+ (unless (equal x (current-column))
+ (picture-forward-column (- x (current-column))))
+ (unless (equal y current-row)
+ (picture-move-down (- y current-row)))))
+
\f
;; Picture insertion and deletion.
(while (> arg 0)
(setq arg (1- arg))
(if (/= picture-desired-column (current-column))
- (move-to-column-force picture-desired-column))
+ (move-to-column picture-desired-column t))
(let ((col (+ picture-desired-column width)))
(or (eolp)
(let ((pos (point)))
- (move-to-column-force col)
+ (move-to-column col t)
(delete-region pos (point)))))
(insert ch)
(forward-char -1)
(let* ((original-col (current-column))
(target-col (max 0 (+ original-col arg)))
pos)
- (move-to-column-force target-col)
+ (move-to-column target-col t)
(setq pos (point))
(move-to-column original-col)
(delete-region pos (point))
(point))))
(replace-match newtext fixedcase literal)
(if (< change 0)
- (insert-char ?\ (- change)))))
+ (insert-char ?\s (- change)))))
\f
;; Picture Tabs
(skip-chars-forward " \t")
(setq tabs (cons (current-column) tabs)))
(if (null tabs)
- (error "No characters in set %s on this line."
+ (error "No characters in set %s on this line"
(regexp-quote picture-tab-chars))))))
(setq tab-stop-list tabs)
(let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
point at the other (diagonally opposed) corner."
(interactive "P")
(if (not (consp picture-killed-rectangle))
- (error "No rectangle saved.")
+ (error "No rectangle saved")
(picture-insert-rectangle picture-killed-rectangle insertp)))
(defun picture-yank-at-click (click arg)
(interactive "cRectangle from register: \nP")
(let ((rectangle (get-register register)))
(if (not (consp rectangle))
- (error "Register %c does not contain a rectangle." register)
+ (error "Register %c does not contain a rectangle" register)
(picture-insert-rectangle rectangle insertp))))
(defun picture-insert-rectangle (rectangle &optional insertp)
(top (min r1 r2))
(bottom (max r1 r2)))
(goto-line top)
- (move-to-column-force left)
+ (move-to-column left t)
(picture-update-desired-column t)
(picture-movement-right)
\f
;; Picture Keymap, entry and exit points.
-(defconst picture-mode-map nil)
+(defvar picture-mode-map nil)
(defun picture-substitute (oldfun newfun)
- (substitute-key-definition oldfun newfun picture-mode-map global-map))
+ (define-key picture-mode-map (vector 'remap oldfun) newfun))
(if (not picture-mode-map)
(progn
(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 "\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 "\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)))
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
C-c C-c Which also strips trailing whitespace from every line.
Stripping is suppressed by supplying an argument.
-Entry to this mode calls the value of picture-mode-hook if non-nil.
+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."
(interactive)
(if (eq major-mode 'picture-mode)
- (error "You are already editing a picture.")
- (make-local-variable 'picture-mode-old-local-map)
- (setq picture-mode-old-local-map (current-local-map))
+ (error "You are already editing a picture")
+ (set (make-local-variable 'picture-mode-old-local-map) (current-local-map))
(use-local-map picture-mode-map)
- (make-local-variable 'picture-mode-old-mode-name)
- (setq picture-mode-old-mode-name mode-name)
- (make-local-variable 'picture-mode-old-major-mode)
- (setq picture-mode-old-major-mode major-mode)
+ (set (make-local-variable 'picture-mode-old-mode-name) mode-name)
+ (set (make-local-variable 'picture-mode-old-major-mode) major-mode)
(setq major-mode 'picture-mode)
- (make-local-variable 'picture-killed-rectangle)
- (setq picture-killed-rectangle nil)
- (make-local-variable 'tab-stop-list)
- (setq tab-stop-list (default-value 'tab-stop-list))
- (make-local-variable 'picture-tab-chars)
- (setq picture-tab-chars (default-value 'picture-tab-chars))
+ (set (make-local-variable 'picture-killed-rectangle) nil)
+ (set (make-local-variable 'tab-stop-list) (default-value 'tab-stop-list))
+ (set (make-local-variable 'picture-tab-chars)
+ (default-value 'picture-tab-chars))
(make-local-variable 'picture-vertical-step)
(make-local-variable 'picture-horizontal-step)
- (make-local-variable 'picture-mode-old-truncate-lines)
- (setq picture-mode-old-truncate-lines truncate-lines)
+ (set (make-local-variable 'picture-mode-old-truncate-lines) truncate-lines)
(setq truncate-lines t)
(picture-set-motion 0 1)
(defalias 'edit-picture 'picture-mode)
(defun picture-mode-exit (&optional nostrip)
- "Undo picture-mode and return to previous major mode.
+ "Undo `picture-mode' and return to previous major mode.
With no argument strips whitespace from end of every line in Picture buffer
otherwise just return to previous mode."
(interactive "P")
(if (not (eq major-mode 'picture-mode))
- (error "You aren't editing a Picture.")
+ (error "You aren't editing a Picture")
(if (not nostrip) (delete-trailing-whitespace))
(setq mode-name picture-mode-old-mode-name)
(use-local-map picture-mode-old-local-map)
(provide 'picture)
+;;; arch-tag: e452d08d-a470-4fbf-896e-ea276698d1ca
;;; picture.el ends here
HCoop / bpt / emacs.git / blobdiff