/[emacs]/emacs/lisp/textmodes/picture.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/picture.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by rms, Thu Mar 14 08:57:36 2002 UTC revision 1.39.2.1 by miles, Fri Apr 4 06:20:38 2003 UTC
# Line 1  Line 1 
1  ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model  ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
2    
3  ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.  ;; Copyright (C) 1985, 1994, 2002, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: K. Shane Hartman  ;; Author: K. Shane Hartman
6  ;; Maintainer: FSF  ;; Maintainer: FSF
# Line 104  If scan reaches end of buffer, stop ther Line 104  If scan reaches end of buffer, stop ther
104    "Move cursor right, making whitespace if necessary.    "Move cursor right, making whitespace if necessary.
105  With argument, move that many columns."  With argument, move that many columns."
106    (interactive "p\nd")    (interactive "p\nd")
107    (picture-update-desired-column interactive)    (let (deactivate-mark)
108    (setq picture-desired-column (max 0 (+ picture-desired-column arg)))      (picture-update-desired-column interactive)
109    (let ((current-column (move-to-column picture-desired-column t)))      (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
110      (if (and (> current-column picture-desired-column)      (let ((current-column (move-to-column picture-desired-column t)))
111               (< arg 0))        (if (and (> current-column picture-desired-column)
112          ;; It seems that we have just tried to move to the right                 (< arg 0))
113          ;; column of a multi-column character.            ;; It seems that we have just tried to move to the right
114          (forward-char -1))))            ;; column of a multi-column character.
115              (forward-char -1)))))
116    
117  (defun picture-backward-column (arg &optional interactive)  (defun picture-backward-column (arg &optional interactive)
118    "Move cursor left, making whitespace if necessary.    "Move cursor left, making whitespace if necessary.
# Line 124  With argument, move that many columns." Line 125  With argument, move that many columns."
125    "Move vertically down, making whitespace if necessary.    "Move vertically down, making whitespace if necessary.
126  With argument, move that many lines."  With argument, move that many lines."
127    (interactive "p")    (interactive "p")
128    (picture-update-desired-column nil)    (let (deactivate-mark)
129    (picture-newline arg)      (picture-update-desired-column nil)
130    (let ((current-column (move-to-column picture-desired-column t)))      (picture-newline arg)
131      (if (> current-column picture-desired-column)      (let ((current-column (move-to-column picture-desired-column t)))
132          (forward-char -1))))        (if (> current-column picture-desired-column)
133              (forward-char -1)))))
134    
135  (defvar picture-vertical-step 0  (defvar picture-vertical-step 0
136    "Amount to move vertically after text character in Picture mode.")    "Amount to move vertically after text character in Picture mode.")
# Line 220  Do \\[command-apropos]  picture-movement Line 222  Do \\[command-apropos]  picture-movement
222    "Move point in direction opposite of current picture motion in Picture mode.    "Move point in direction opposite of current picture motion in Picture mode.
223  With ARG do it that many times.  Useful for delineating rectangles in  With ARG do it that many times.  Useful for delineating rectangles in
224  conjunction with diagonal picture motion.  conjunction with diagonal picture motion.
225  Do \\[command-apropos] `picture-movement' to see commands which control motion."  Do \\[command-apropos]  picture-movement  to see commands which control motion."
226    (interactive "p")    (interactive "p")
227    (picture-motion (- arg)))    (picture-motion (- arg)))
228    
229    (defun picture-mouse-set-point (event)
230      "Move point to the position clicked on, making whitespace if necessary."
231      (interactive "e")
232      (let* ((pos (posn-col-row (event-start event)))
233             (x (car pos))
234             (y (cdr pos))
235             (current-row (count-lines (window-start) (line-beginning-position))))
236        (unless (equal x (current-column))
237          (picture-forward-column (- x (current-column))))
238        (unless (equal y current-row)
239          (picture-move-down (- y current-row)))))
240    
241    
242  ;; Picture insertion and deletion.  ;; Picture insertion and deletion.
243    
# Line 576  Leaves the region surrounding the rectan Line 590  Leaves the region surrounding the rectan
590  (defvar picture-mode-map nil)  (defvar picture-mode-map nil)
591    
592  (defun picture-substitute (oldfun newfun)  (defun picture-substitute (oldfun newfun)
593    (substitute-key-definition oldfun newfun picture-mode-map global-map))    (define-key picture-mode-map (vector 'remap oldfun) newfun))
594    
595  (if (not picture-mode-map)  (if (not picture-mode-map)
596      (progn      (progn
# Line 600  Leaves the region surrounding the rectan Line 614  Leaves the region surrounding the rectan
614        (picture-substitute 'previous-line 'picture-move-up)        (picture-substitute 'previous-line 'picture-move-up)
615        (picture-substitute 'beginning-of-line 'picture-beginning-of-line)        (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
616        (picture-substitute 'end-of-line 'picture-end-of-line)        (picture-substitute 'end-of-line 'picture-end-of-line)
617          (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
618    
619        (define-key picture-mode-map "\C-c\C-d" 'delete-char)        (define-key picture-mode-map "\C-c\C-d" 'delete-char)
620        (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)        (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.39.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26