/[emacs]/emacs/lisp/emulation/cua-rect.el
ViewVC logotype

Diff of /emacs/lisp/emulation/cua-rect.el

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

revision 1.5 by kfstorm, Sat May 25 00:08:36 2002 UTC revision 1.5.2.1 by miles, Fri Apr 4 06:20:17 2003 UTC
# Line 88  Knows about CUA rectangle highlighting i Line 88  Knows about CUA rectangle highlighting i
88    (let ((l cua--undo-list))    (let ((l cua--undo-list))
89      (while l      (while l
90        (if (eq (car (car l)) pending-undo-list)        (if (eq (car (car l)) pending-undo-list)
91            (setq cua--restored-rectangle            (setq cua--restored-rectangle
92                  (and (vectorp (cdr (car l))) (cdr (car l)))                  (and (vectorp (cdr (car l))) (cdr (car l)))
93                  l nil)                  l nil)
94          (setq l (cdr l)))))          (setq l (cdr l)))))
# Line 126  Knows about CUA rectangle highlighting i Line 126  Knows about CUA rectangle highlighting i
126                    (setcdr cul nil))                    (setcdr cul nil))
127                  (setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter))                  (setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter))
128                  (if cua--debug                  (if cua--debug
129                      (message "Clean undo list in %s (%d)"                      (message "Clean undo list in %s (%d)"
130                               (buffer-name) cc)))))))                               (buffer-name) cc)))))))
131        (setq buffers (cdr buffers)))        (setq buffers (cdr buffers)))
132      (/= cnt cua--tidy-undo-counter)))      (/= cnt cua--tidy-undo-counter)))
# Line 176  Knows about CUA rectangle highlighting i Line 176  Knows about CUA rectangle highlighting i
176    (let ((c (aref cua--rectangle 4)))    (let ((c (aref cua--rectangle 4)))
177      (if (not (integerp advance))      (if (not (integerp advance))
178          c          c
179        (aset cua--rectangle 4        (aset cua--rectangle 4
180              (if (= advance 0)              (if (= advance 0)
181                  (- 3 c) ; opposite corner                  (- 3 c) ; opposite corner
182                (mod (+ c 4 advance) 4)))                (mod (+ c 4 advance) 4)))
# Line 302  Knows about CUA rectangle highlighting i Line 302  Knows about CUA rectangle highlighting i
302          (cua--rectangle-right (1+ (cua--rectangle-right)))          (cua--rectangle-right (1+ (cua--rectangle-right)))
303          (move-to-column (cua--rectangle-right) pad))          (move-to-column (cua--rectangle-right) pad))
304         ((cua--rectangle-right-side)         ((cua--rectangle-right-side)
305          (forward-char 1)                          (forward-char 1)
306          (cua--rectangle-right (current-column)))          (cua--rectangle-right (current-column)))
307         ((or pad (eolp))                           ((or pad (eolp))
308          (cua--rectangle-left (1+ (cua--rectangle-left)))          (cua--rectangle-left (1+ (cua--rectangle-left)))
309          (move-to-column (cua--rectangle-right) pad))          (move-to-column (cua--rectangle-right) pad))
310         (t         (t
# Line 575  If command is repeated at same position, Line 575  If command is repeated at same position,
575                (forward-char 1))                (forward-char 1))
576            (set-marker m (point))            (set-marker m (point))
577            (move-to-column l pad)            (move-to-column l pad)
578            (if fct            (if (and fct (>= (current-column) l) (<= (current-column) r))
579                (let ((v t) (p (point)))                (let ((v t) (p (point)))
580                  (when sel                  (when sel
581                    (if (car (cdr sel))                    (if (car (cdr sel))
# Line 614  If command is repeated at same position, Line 614  If command is repeated at same position,
614  (defun cua--delete-rectangle ()  (defun cua--delete-rectangle ()
615    (cua--rectangle-operation nil nil t 2    (cua--rectangle-operation nil nil t 2
616      '(lambda (s e l r)      '(lambda (s e l r)
617         (delete-region s (if (> e s) e (1+ e))))))         (if (and (> e s) (<= e (point-max)))
618               (delete-region s e)))))
619    
620  (defun cua--extract-rectangle ()  (defun cua--extract-rectangle ()
621    (let (rect)    (let (rect)
# Line 665  If command is repeated at same position, Line 666  If command is repeated at same position,
666    ;; Turn on rectangular marking mode by disabling transient mark mode    ;; Turn on rectangular marking mode by disabling transient mark mode
667    ;; and manually handling highlighting from a post command hook.    ;; and manually handling highlighting from a post command hook.
668    ;; Be careful if we are already marking a rectangle.    ;; Be careful if we are already marking a rectangle.
669    (setq cua--rectangle    (setq cua--rectangle
670          (if (and cua--last-rectangle          (if (and cua--last-rectangle
671                   (eq (car cua--last-rectangle) (current-buffer))                   (eq (car cua--last-rectangle) (current-buffer))
672                   (eq (car (cdr cua--last-rectangle)) (point)))                   (eq (car (cdr cua--last-rectangle)) (point)))
673              (cdr (cdr cua--last-rectangle))              (cdr (cdr cua--last-rectangle))
# Line 683  If command is repeated at same position, Line 684  If command is repeated at same position,
684  (defun cua--deactivate-rectangle ()  (defun cua--deactivate-rectangle ()
685    ;; This is used to clean up after `cua--activate-rectangle'.    ;; This is used to clean up after `cua--activate-rectangle'.
686    (mapcar (function delete-overlay) cua--rectangle-overlays)    (mapcar (function delete-overlay) cua--rectangle-overlays)
687    (setq cua--last-rectangle (cons (current-buffer)    (setq cua--last-rectangle (cons (current-buffer)
688                                    (cons (point) ;; cua-save-point                                    (cons (point) ;; cua-save-point
689                                          cua--rectangle))                                          cua--rectangle))
690          cua--rectangle nil          cua--rectangle nil
# Line 826  With prefix argument, the toggle restric Line 827  With prefix argument, the toggle restric
827            (cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))            (cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))
828          (cua--rectangle-restriction "" nil nil))          (cua--rectangle-restriction "" nil nil))
829        (cua--rectangle-restriction        (cua--rectangle-restriction
830         (format "[%c]"         (format "[%c]"
831                 (read-char "Restrictive rectangle (char): ")) t arg))))                 (read-char "Restrictive rectangle (char): ")) t arg))))
832    
833  (defun cua-move-rectangle-up ()  (defun cua-move-rectangle-up ()
# Line 1039  The length of STRING need not be the sam Line 1040  The length of STRING need not be the sam
1040  (defun cua-sequence-rectangle (first incr fmt)  (defun cua-sequence-rectangle (first incr fmt)
1041    "Resequence each line of CUA rectangle starting from FIRST.    "Resequence each line of CUA rectangle starting from FIRST.
1042  The numbers are formatted according to the FORMAT string."  The numbers are formatted according to the FORMAT string."
1043    (interactive    (interactive
1044     (list (if current-prefix-arg     (list (if current-prefix-arg
1045               (prefix-numeric-value current-prefix-arg)               (prefix-numeric-value current-prefix-arg)
1046             (string-to-number             (string-to-number
# Line 1168  With prefix arg, replace rectangle with Line 1169  With prefix arg, replace rectangle with
1169    (interactive (list    (interactive (list
1170                  current-prefix-arg                  current-prefix-arg
1171                  (read-from-minibuffer "Shell command on rectangle: "                  (read-from-minibuffer "Shell command on rectangle: "
1172                                        nil nil nil                                        nil nil nil
1173                                        'shell-command-history)))                                        'shell-command-history)))
1174    (cua--rectangle-aux-replace -1 t t replace 1    (cua--rectangle-aux-replace -1 t t replace 1
1175      '(lambda (s e)      '(lambda (s e)
# Line 1184  With prefix arg, replace rectangle with Line 1185  With prefix arg, replace rectangle with
1185    "Remove the first line of the rectangle and scroll remaining lines up."    "Remove the first line of the rectangle and scroll remaining lines up."
1186    (interactive)    (interactive)
1187    (cua--rectangle-aux-replace 0 t t t t    (cua--rectangle-aux-replace 0 t t t t
1188      '(lambda (s e)      '(lambda (s e)
1189         (if (= (forward-line 1) 0)         (if (= (forward-line 1) 0)
1190             (delete-region s (point))))))             (delete-region s (point))))))
1191    
# Line 1224  With prefix arg, indent to that column." Line 1225  With prefix arg, indent to that column."
1225          indent)          indent)
1226      (cua--rectangle-operation 'corners nil t pad      (cua--rectangle-operation 'corners nil t pad
1227       '(lambda (s e l r)       '(lambda (s e l r)
1228          (move-to-column          (move-to-column
1229           (if (cua--rectangle-right-side t)           (if (cua--rectangle-right-side t)
1230               (max (1+ r) col) l)               (max (1+ r) col) l)
1231           pad)           pad)
# Line 1242  With prefix arg, indent to that column." Line 1243  With prefix arg, indent to that column."
1243  (defun cua-help-for-rectangle (&optional help)  (defun cua-help-for-rectangle (&optional help)
1244    (interactive)    (interactive)
1245    (let ((M (if cua-use-hyper-key " H-" " M-")))    (let ((M (if cua-use-hyper-key " H-" " M-")))
1246      (message      (message
1247       (concat (if help "C-?:help" "")       (concat (if help "C-?:help" "")
1248               M "p:pad" M "o:open" M "c:close" M "b:blank"               M "p:pad" M "o:open" M "c:close" M "b:blank"
1249               M "s:string" M "f:fill" M "i:incr" M "n:seq"))))               M "s:string" M "f:fill" M "i:incr" M "n:seq"))))
1250    
1251    
# Line 1272  With prefix arg, indent to that column." Line 1273  With prefix arg, indent to that column."
1273            (cua--rectangle-bot t)            (cua--rectangle-bot t)
1274          (cua--rectangle-top t))          (cua--rectangle-top t))
1275        (if (cua--rectangle-padding)        (if (cua--rectangle-padding)
1276            (setq unread-command-events            (setq unread-command-events
1277                  (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))                  (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
1278    (if cua--rectangle    (if cua--rectangle
1279        (if (and mark-active        (if (and mark-active
# Line 1332  With prefix arg, indent to that column." Line 1333  With prefix arg, indent to that column."
1333    (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)    (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
1334    (define-key cua--rectangle-keymap [remap self-insert-command]  'cua-insert-char-rectangle)    (define-key cua--rectangle-keymap [remap self-insert-command]  'cua-insert-char-rectangle)
1335    (define-key cua--rectangle-keymap [remap self-insert-iso]      'cua-insert-char-rectangle)    (define-key cua--rectangle-keymap [remap self-insert-iso]      'cua-insert-char-rectangle)
1336      
1337    ;; Catch self-inserting characters which are "stolen" by other modes    ;; Catch self-inserting characters which are "stolen" by other modes
1338    (define-key cua--rectangle-keymap [t]    (define-key cua--rectangle-keymap [t]
1339      '(menu-item "sic" cua-insert-char-rectangle :filter cua--self-insert-char-p))      '(menu-item "sic" cua-insert-char-rectangle :filter cua--self-insert-char-p))

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.5.2.1

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