/[emacs]/emacs/lisp/rect.el
ViewVC logotype

Diff of /emacs/lisp/rect.el

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

revision 1.37 by eliz, Wed Oct 3 10:51:07 2001 UTC revision 1.38 by monnier, Sat Nov 17 00:47:42 2001 UTC
# Line 37  Line 37 
37    
38  ;;;###autoload  ;;;###autoload
39  (defun move-to-column-force (column &optional flag)  (defun move-to-column-force (column &optional flag)
40    "Move point to column COLUMN rigidly in the current line.    "Obsolete.  Use `move-to-column'.
41  If COLUMN is within a multi-column character, replace it by  If COLUMN is within a multi-column character, replace it by spaces and tab.
 spaces and tab.  
   
42  As for `move-to-column', passing anything but nil or t in FLAG will move to  As for `move-to-column', passing anything but nil or t in FLAG will move to
43  the desired column only if the line is long enough."  the desired column only if the line is long enough."
44    (let ((col (move-to-column column (or flag t))))    (move-to-column column (or flag t)))
45      (if (> col column)  (make-obsolete 'move-to-column-force "move-to-column" "21.2")
         (let (pos)  
           (delete-char -1)  
           (insert-char ?  (- column (current-column)))  
           (setq pos (point))  
           (indent-to col)  
           (goto-char pos)))  
     column))  
46    
47  ;; not used any more --dv  ;; not used any more --dv
48  ;; extract-rectangle-line stores lines into this list  ;; extract-rectangle-line stores lines into this list
# Line 88  Point is at the end of the segment of th Line 79  Point is at the end of the segment of th
79       (while (< (point) endlinepos)       (while (< (point) endlinepos)
80         (let (startpos begextra endextra)         (let (startpos begextra endextra)
81           (if coerce-tabs           (if coerce-tabs
82               (move-to-column-force startcol)               (move-to-column startcol t)
83             (move-to-column startcol))             (move-to-column startcol))
84           (setq begextra (- (current-column) startcol))           (setq begextra (- (current-column) startcol))
85           (setq startpos (point))           (setq startpos (point))
86           (if coerce-tabs           (if coerce-tabs
87               (move-to-column-force endcol)               (move-to-column endcol t)
88             (move-to-column endcol))             (move-to-column endcol))
89           ;; If we overshot, move back one character           ;; If we overshot, move back one character
90           ;; so that endextra will be positive.           ;; so that endextra will be positive.
# Line 135  the function is called." Line 126  the function is called."
126      ))      ))
127    
128  (defun delete-rectangle-line (startcol endcol fill)  (defun delete-rectangle-line (startcol endcol fill)
129    (let ((pt (line-end-position)))    (when (= (move-to-column startcol (or fill 'coerce)) startcol)
130      (when (= (move-to-column-force startcol (or fill 'coerce)) startcol)      (delete-region (point)
131        (if (and (not fill) (<= pt endcol))                     (progn (move-to-column endcol 'coerce)
132            (delete-region (point) pt)                            (point)))))
         ;; else  
         (setq pt (point))  
         (move-to-column-force endcol)  
         (delete-region pt (point))))  
     ))  
133    
134  (defun delete-extract-rectangle-line (startcol endcol lines fill)  (defun delete-extract-rectangle-line (startcol endcol lines fill)
135    (let ((pt (point-at-eol)))    (let ((pt (point-at-eol)))
136      (if (< (move-to-column-force startcol (or fill 'coerce)) startcol)      (if (< (move-to-column startcol (or fill 'coerce)) startcol)
137          (setcdr lines (cons (spaces-string (- endcol startcol))          (setcdr lines (cons (spaces-string (- endcol startcol))
138                              (cdr lines)))                              (cdr lines)))
139        ;; else        ;; else
140        (setq pt (point))        (setq pt (point))
141        (move-to-column-force endcol)        (move-to-column endcol t)
142        (setcdr lines (cons (buffer-substring pt (point)) (cdr lines)))        (setcdr lines (cons (buffer-substring pt (point)) (cdr lines)))
143        (delete-region pt (point)))        (delete-region pt (point)))
144      ))      ))
# Line 277  and point is at the lower right corner." Line 263  and point is at the lower right corner."
263            (progn            (progn
264             (forward-line 1)             (forward-line 1)
265             (or (bolp) (insert ?\n))             (or (bolp) (insert ?\n))
266             (move-to-column-force insertcolumn)))             (move-to-column insertcolumn t)))
267        (setq first nil)        (setq first nil)
268        (insert (car lines))        (insert (car lines))
269        (setq lines (cdr lines)))))        (setq lines (cdr lines)))))
# Line 297  on the right side of the rectangle." Line 283  on the right side of the rectangle."
283    (goto-char start))    (goto-char start))
284    
285  (defun open-rectangle-line (startcol endcol fill)  (defun open-rectangle-line (startcol endcol fill)
286    (when (= (move-to-column-force startcol (or fill 'coerce)) startcol)    (when (= (move-to-column startcol (or fill 'coerce)) startcol)
287      (unless (and (not fill)      (unless (and (not fill)
288                   (= (point) (point-at-eol)))                   (= (point) (point-at-eol)))
289        (indent-to endcol))))        (indent-to endcol))))
290    
291  (defun delete-whitespace-rectangle-line (startcol endcol fill)  (defun delete-whitespace-rectangle-line (startcol endcol fill)
292    (when (= (move-to-column-force startcol (or fill 'coerce)) startcol)    (when (= (move-to-column startcol (or fill 'coerce)) startcol)
293      (unless (= (point) (point-at-eol))      (unless (= (point) (point-at-eol))
294        (delete-region (point) (progn (skip-syntax-forward " ") (point))))))        (delete-region (point) (progn (skip-syntax-forward " ") (point))))))
295    
# Line 324  With a prefix (or a FILL) argument, also Line 310  With a prefix (or a FILL) argument, also
310  ;; string-rectangle uses this variable to pass the string  ;; string-rectangle uses this variable to pass the string
311  ;; to string-rectangle-line.  ;; to string-rectangle-line.
312  (defvar string-rectangle-string)  (defvar string-rectangle-string)
313    (defvar string-rectangle-history nil)
314  (defun string-rectangle-line (startcol endcol string delete)  (defun string-rectangle-line (startcol endcol string delete)
315    (move-to-column-force startcol)    (move-to-column startcol t)
316    (if delete    (if delete
317        (delete-rectangle-line startcol endcol nil))        (delete-rectangle-line startcol endcol nil))
318    (insert string))    (insert string))
319    
320  ;;;###autoload  ;;;###autoload
321    
322  (defun string-rectangle (start end string)  (defun string-rectangle (start end string)
323    "Replace rectangle contents with STRING on each line.    "Replace rectangle contents with STRING on each line.
324  The length of STRING need not be the same as the rectangle width.  The length of STRING need not be the same as the rectangle width.
325    
326  Called from a program, takes three args; START, END and STRING."  Called from a program, takes three args; START, END and STRING."
327    (interactive "*r\nsString rectangle: ")    (interactive
328       (progn (barf-if-buffer-read-only)
329              (list
330               (region-beginning)
331               (region-end)
332               (read-string (format "String rectangle (default `%s'): "
333                                    (or (car string-rectangle-history) ""))
334                            nil 'string-rectangle-history
335                            (car string-rectangle-history)))))
336    (apply-on-rectangle 'string-rectangle-line start end string t))    (apply-on-rectangle 'string-rectangle-line start end string t))
337    
338  (defalias 'replace-rectangle 'string-rectangle)  (defalias 'replace-rectangle 'string-rectangle)
# Line 349  Called from a program, takes three args; Line 344  Called from a program, takes three args;
344  When called from a program, the rectangle's corners are START and END.  When called from a program, the rectangle's corners are START and END.
345  The left edge of the rectangle specifies the column for insertion.  The left edge of the rectangle specifies the column for insertion.
346  This command does not delete or overwrite any existing text."  This command does not delete or overwrite any existing text."
347    (interactive "*r\nsString insert rectangle: ")    (interactive
348       (progn (barf-if-buffer-read-only)
349              (list
350               (region-beginning)
351               (region-end)
352               (read-string (format "String insert rectangle (default `%s'): "
353                                    (or (car string-rectangle-history) ""))
354                            nil 'string-rectangle-history
355                            (car string-rectangle-history)))))
356    (apply-on-rectangle 'string-rectangle-line start end string nil))    (apply-on-rectangle 'string-rectangle-line start end string nil))
357    
358  ;;;###autoload  ;;;###autoload
# Line 366  rectangle which were empty." Line 369  rectangle which were empty."
369  (defun clear-rectangle-line (startcol endcol fill)  (defun clear-rectangle-line (startcol endcol fill)
370    (let ((pt (point-at-eol))    (let ((pt (point-at-eol))
371          spaces)          spaces)
372      (when (= (move-to-column-force startcol (or fill 'coerce)) startcol)      (when (= (move-to-column startcol (or fill 'coerce)) startcol)
373        (if (and (not fill)        (if (and (not fill)
374                 (<= (save-excursion (goto-char pt) (current-column)) endcol))                 (<= (save-excursion (goto-char pt) (current-column)) endcol))
375            (delete-region (point) pt)            (delete-region (point) pt)
376          ;; else          ;; else
377          (setq pt (point))          (setq pt (point))
378          (move-to-column-force endcol)          (move-to-column endcol t)
379          (setq spaces (- (point) pt))          (setq spaces (- (point) pt))
380          (delete-region pt (point))          (delete-region pt (point))
381          (indent-to (+ (current-column) spaces))))))          (indent-to (+ (current-column) spaces))))))

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

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