diff options
| author | Dave Love | 2000-02-03 15:14:15 +0000 |
|---|---|---|
| committer | Dave Love | 2000-02-03 15:14:15 +0000 |
| commit | 048d06bdf5b6401a1b28854f6d4df9f0f6af73ff (patch) | |
| tree | 730318432cc5671c1ddfe17be334eedf9132351c | |
| parent | 19e262bd592f154a4afbd407494b7621f7536a97 (diff) | |
| download | emacs-048d06bdf5b6401a1b28854f6d4df9f0f6af73ff.tar.gz emacs-048d06bdf5b6401a1b28854f6d4df9f0f6af73ff.zip | |
Replace tar-dolist, tar-dotimes with dolist, dotimes.
| -rw-r--r-- | lisp/tar-mode.el | 57 |
1 files changed, 13 insertions, 44 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 234e99c79d3..46d595ffeaa 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el | |||
| @@ -139,9 +139,6 @@ This information is useful, but it takes screen space away from file names." | |||
| 139 | (put 'tar-superior-buffer 'permanent-local t) | 139 | (put 'tar-superior-buffer 'permanent-local t) |
| 140 | (put 'tar-superior-descriptor 'permanent-local t) | 140 | (put 'tar-superior-descriptor 'permanent-local t) |
| 141 | 141 | ||
| 142 | ;;; First, duplicate some Common Lisp functions; I used to just (require 'cl) | ||
| 143 | ;;; but "cl.el" was messing some people up (also it's really big). | ||
| 144 | |||
| 145 | (defmacro tar-setf (form val) | 142 | (defmacro tar-setf (form val) |
| 146 | "A mind-numbingly simple implementation of setf." | 143 | "A mind-numbingly simple implementation of setf." |
| 147 | (let ((mform (macroexpand form (and (boundp 'byte-compile-macro-environment) | 144 | (let ((mform (macroexpand form (and (boundp 'byte-compile-macro-environment) |
| @@ -155,34 +152,6 @@ This information is useful, but it takes screen space away from file names." | |||
| 155 | ((eq (car mform) 'cdr) | 152 | ((eq (car mform) 'cdr) |
| 156 | (list 'setcdr (nth 1 mform) val)) | 153 | (list 'setcdr (nth 1 mform) val)) |
| 157 | (t (error "don't know how to setf %s" form))))) | 154 | (t (error "don't know how to setf %s" form))))) |
| 158 | |||
| 159 | (defmacro tar-dolist (control &rest body) | ||
| 160 | "syntax: (dolist (var-name list-expr &optional return-value) &body body)" | ||
| 161 | (let ((var (car control)) | ||
| 162 | (init (car (cdr control))) | ||
| 163 | (val (car (cdr (cdr control))))) | ||
| 164 | (list 'let (list (list '_dolist_iterator_ init)) | ||
| 165 | (list 'while '_dolist_iterator_ | ||
| 166 | (cons 'let | ||
| 167 | (cons (list (list var '(car _dolist_iterator_))) | ||
| 168 | (append body | ||
| 169 | (list (list 'setq '_dolist_iterator_ | ||
| 170 | (list 'cdr '_dolist_iterator_))))))) | ||
| 171 | val))) | ||
| 172 | |||
| 173 | (defmacro tar-dotimes (control &rest body) | ||
| 174 | "syntax: (dolist (var-name count-expr &optional return-value) &body body)" | ||
| 175 | (let ((var (car control)) | ||
| 176 | (n (car (cdr control))) | ||
| 177 | (val (car (cdr (cdr control))))) | ||
| 178 | (list 'let (list (list '_dotimes_end_ n) | ||
| 179 | (list var 0)) | ||
| 180 | (cons 'while | ||
| 181 | (cons (list '< var '_dotimes_end_) | ||
| 182 | (append body | ||
| 183 | (list (list 'setq var (list '1+ var)))))) | ||
| 184 | val))) | ||
| 185 | |||
| 186 | 155 | ||
| 187 | ;;; down to business. | 156 | ;;; down to business. |
| 188 | 157 | ||
| @@ -316,7 +285,7 @@ write-date, checksum, link-type, and link-name." | |||
| 316 | (defun tar-parse-octal-integer-safe (string) | 285 | (defun tar-parse-octal-integer-safe (string) |
| 317 | (let ((L (length string))) | 286 | (let ((L (length string))) |
| 318 | (if (= L 0) (error "empty string")) | 287 | (if (= L 0) (error "empty string")) |
| 319 | (tar-dotimes (i L) | 288 | (dotimes (i L) |
| 320 | (if (or (< (aref string i) ?0) | 289 | (if (or (< (aref string i) ?0) |
| 321 | (> (aref string i) ?7)) | 290 | (> (aref string i) ?7)) |
| 322 | (error "`%c' is not an octal digit")))) | 291 | (error "`%c' is not an octal digit")))) |
| @@ -352,7 +321,7 @@ write-date, checksum, link-type, and link-name." | |||
| 352 | (l (length chk-string))) | 321 | (l (length chk-string))) |
| 353 | (aset hblock 154 0) | 322 | (aset hblock 154 0) |
| 354 | (aset hblock 155 32) | 323 | (aset hblock 155 32) |
| 355 | (tar-dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1))))) | 324 | (dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1))))) |
| 356 | hblock) | 325 | hblock) |
| 357 | 326 | ||
| 358 | (defun tar-clip-time-string (time) | 327 | (defun tar-clip-time-string (time) |
| @@ -428,22 +397,22 @@ MODE should be an integer which is a file mode value." | |||
| 428 | (setq gid (if (= 0 (length gname)) (int-to-string gid) gname)) | 397 | (setq gid (if (= 0 (length gname)) (int-to-string gid) gname)) |
| 429 | (setq size (int-to-string size)) | 398 | (setq size (int-to-string size)) |
| 430 | (setq time (tar-clip-time-string time)) | 399 | (setq time (tar-clip-time-string time)) |
| 431 | (tar-dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1)))) | 400 | (dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1)))) |
| 432 | (aset string (1+ slash) ?/) | 401 | (aset string (1+ slash) ?/) |
| 433 | (tar-dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i))) | 402 | (dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i))) |
| 434 | (tar-dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1)))) | 403 | (dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1)))) |
| 435 | (if tar-mode-show-date | 404 | (if tar-mode-show-date |
| 436 | (tar-dotimes (i (length time)) (aset string (+ datestart i) (aref time i)))) | 405 | (dotimes (i (length time)) (aset string (+ datestart i) (aref time i)))) |
| 437 | (if multibyte | 406 | (if multibyte |
| 438 | (setq string (concat string name)) | 407 | (setq string (concat string name)) |
| 439 | (tar-dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))) | 408 | (dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))) |
| 440 | (if (or (eq link-p 1) (eq link-p 2)) | 409 | (if (or (eq link-p 1) (eq link-p 2)) |
| 441 | (if multibyte | 410 | (if multibyte |
| 442 | (setq string (concat string | 411 | (setq string (concat string |
| 443 | (if (= link-p 1) " ==> " " --> ") | 412 | (if (= link-p 1) " ==> " " --> ") |
| 444 | link-name)) | 413 | link-name)) |
| 445 | (tar-dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i))) | 414 | (dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i))) |
| 446 | (tar-dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i))))) | 415 | (dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i))))) |
| 447 | (put-text-property namestart (length string) | 416 | (put-text-property namestart (length string) |
| 448 | 'mouse-face 'highlight string) | 417 | 'mouse-face 'highlight string) |
| 449 | string))) | 418 | string))) |
| @@ -505,7 +474,7 @@ is visible (and the real data of the buffer is hidden)." | |||
| 505 | (summaries nil)) | 474 | (summaries nil)) |
| 506 | ;; Collect summary lines and insert them all at once since tar files | 475 | ;; Collect summary lines and insert them all at once since tar files |
| 507 | ;; can be pretty big. | 476 | ;; can be pretty big. |
| 508 | (tar-dolist (tar-desc (reverse tar-parse-info)) | 477 | (dolist (tar-desc (reverse tar-parse-info)) |
| 509 | (setq summaries | 478 | (setq summaries |
| 510 | (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) | 479 | (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) |
| 511 | (cons "\n" | 480 | (cons "\n" |
| @@ -922,7 +891,7 @@ the current tar-entry." | |||
| 922 | With a prefix argument, mark that many files." | 891 | With a prefix argument, mark that many files." |
| 923 | (interactive "p") | 892 | (interactive "p") |
| 924 | (beginning-of-line) | 893 | (beginning-of-line) |
| 925 | (tar-dotimes (i (if (< p 0) (- p) p)) | 894 | (dotimes (i (if (< p 0) (- p) p)) |
| 926 | (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. | 895 | (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. |
| 927 | (progn | 896 | (progn |
| 928 | (delete-char 1) | 897 | (delete-char 1) |
| @@ -981,7 +950,7 @@ With a prefix argument, un-mark that many files backward." | |||
| 981 | ;; iteration over the files that remain, or only iterate up to | 950 | ;; iteration over the files that remain, or only iterate up to |
| 982 | ;; the next file to be deleted. | 951 | ;; the next file to be deleted. |
| 983 | (let ((data-length (- data-end data-start))) | 952 | (let ((data-length (- data-end data-start))) |
| 984 | (tar-dolist (desc following-descs) | 953 | (dolist (desc following-descs) |
| 985 | (tar-setf (tar-desc-data-start desc) | 954 | (tar-setf (tar-desc-data-start desc) |
| 986 | (- (tar-desc-data-start desc) data-length)))) | 955 | (- (tar-desc-data-start desc) data-length)))) |
| 987 | )) | 956 | )) |
| @@ -1214,7 +1183,7 @@ to make your changes permanent." | |||
| 1214 | ;; update the data pointer of this and all following files... | 1183 | ;; update the data pointer of this and all following files... |
| 1215 | (tar-setf (tar-header-size tokens) subfile-size) | 1184 | (tar-setf (tar-header-size tokens) subfile-size) |
| 1216 | (let ((difference (- subfile-size-pad size-pad))) | 1185 | (let ((difference (- subfile-size-pad size-pad))) |
| 1217 | (tar-dolist (desc following-descs) | 1186 | (dolist (desc following-descs) |
| 1218 | (tar-setf (tar-desc-data-start desc) | 1187 | (tar-setf (tar-desc-data-start desc) |
| 1219 | (+ (tar-desc-data-start desc) difference)))) | 1188 | (+ (tar-desc-data-start desc) difference)))) |
| 1220 | ;; | 1189 | ;; |