(diary-list-entries, (mark-calendar-date-pattern): Use `dotimes'

rather than `calendar-for-loop'.
author: Glenn Morris 2007-07-24 06:11:37 +0000
committer: Glenn Morris 2007-07-24 06:11:37 +0000
commit: 9e46548e642d529cc76c3cfbfb3c59c20f67d231 (patch)
tree: cb4b641651a27a12aacd1e7bf6c0586921b11be7
parent: 2ed4b0e2e4c286b18f3de11e03757360603fb1b4 (diff)
download: emacs-9e46548e642d529cc76c3cfbfb3c59c20f67d231.tar.gz
emacs-9e46548e642d529cc76c3cfbfb3c59c20f67d231.zip
1 files changed, 86 insertions, 87 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index ee93b60eb98..6918f422f24 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -461,95 +461,94 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
                    (set (make-local-variable 'diary-selective-display) t)
                    (overlay-put ol 'invisible 'diary)
                    (overlay-put ol 'evaporate t)))
-                (calendar-for-loop
+                (dotimes (idummy number)
-                 i from 1 to number do
+                  (let ((month (extract-calendar-month date))
-                 (let ((month (extract-calendar-month date))
+                        (day (extract-calendar-day date))
-                       (day (extract-calendar-day date))
+                        (year (extract-calendar-year date))
-                       (year (extract-calendar-year date))
+                        (entry-found (list-sexp-diary-entries date)))
-                       (entry-found (list-sexp-diary-entries date)))
+                    (dolist (date-form diary-date-forms)
-                   (dolist (date-form diary-date-forms)
+                      (let*
-                     (let*
+                          ((backup (when (eq (car date-form) 'backup)
-                         ((backup (when (eq (car date-form) 'backup)
+                                     (setq date-form (cdr date-form))
-                                    (setq date-form (cdr date-form))
+                                     t))
-                                    t))
+                           (dayname
-                          (dayname
+                            (format "%s\\|%s\\.?"
-                           (format "%s\\|%s\\.?"
+                                    (calendar-day-name date)
-                                   (calendar-day-name date)
+                                    (calendar-day-name date 'abbrev)))
-                                   (calendar-day-name date 'abbrev)))
+                           (monthname
-                          (monthname
+                            (format "\\*\\|%s\\|%s\\.?"
-                           (format "\\*\\|%s\\|%s\\.?"
+                                    (calendar-month-name month)
-                                   (calendar-month-name month)
+                                    (calendar-month-name month 'abbrev)))
-                                   (calendar-month-name month 'abbrev)))
+                           (month (concat "\\*\\|0*" (int-to-string month)))
-                          (month (concat "\\*\\|0*" (int-to-string month)))
+                           (day (concat "\\*\\|0*" (int-to-string day)))
-                          (day (concat "\\*\\|0*" (int-to-string day)))
+                           (year
-                          (year
+                            (concat
-                           (concat
+                             "\\*\\|0*" (int-to-string year)
-                            "\\*\\|0*" (int-to-string year)
+                             (if abbreviated-calendar-year
-                            (if abbreviated-calendar-year
+                                 (concat "\\|" (format "%02d" (% year 100)))
-                                (concat "\\|" (format "%02d" (% year 100)))
+                               "")))
-                              "")))
+                           (regexp
-                          (regexp
+                            (concat
-                           (concat
+                             "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
-                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
+                             (mapconcat 'eval date-form "\\)\\(?:")
-                            (mapconcat 'eval date-form "\\)\\(?:")
+                             "\\)"))
-                            "\\)"))
+                           (case-fold-search t))
-                          (case-fold-search t))
+                        (goto-char (point-min))
-                       (goto-char (point-min))
+                        (while (re-search-forward regexp nil t)
-                       (while (re-search-forward regexp nil t)
+                          (if backup (re-search-backward "\\<" nil t))
-                         (if backup (re-search-backward "\\<" nil t))
+                          (if (and (or (char-equal (preceding-char) ?\^M)
-                         (if (and (or (char-equal (preceding-char) ?\^M)
+                                       (char-equal (preceding-char) ?\n))
-                                      (char-equal (preceding-char) ?\n))
+                                   (not (looking-at " \\|\^I")))
-                                  (not (looking-at " \\|\^I")))
+                              ;;  Diary entry that consists only of date.
-                             ;;  Diary entry that consists only of date.
+                              (backward-char 1)
-                             (backward-char 1)
+                            ;; Found a nonempty diary entry--make it
-                           ;; Found a nonempty diary entry--make it
+                            ;; visible and add it to the list.
-                           ;; visible and add it to the list.
+                            (setq entry-found t)
-                           (setq entry-found t)
+                            (let ((entry-start (point))
-                           (let ((entry-start (point))
+                                  date-start temp)
-                                 date-start temp)
+                              (re-search-backward "\^M\\|\n\\|\\`")
-                             (re-search-backward "\^M\\|\n\\|\\`")
+                              (setq date-start (point))
-                             (setq date-start (point))
+                              ;; When selective display (rather than
-                             ;; When selective display (rather than
+                              ;; overlays) was used, diary file used to
-                             ;; overlays) was used, diary file used to
+                              ;; start in a blank line and end in a
-                             ;; start in a blank line and end in a
+                              ;; newline. Now that neither of these
-                             ;; newline. Now that neither of these
+                              ;; need be true, 'move handles the latter
-                             ;; need be true, 'move handles the latter
+                              ;; and 1/2 kludge the former.
-                             ;; and 1/2 kludge the former.
+                              (re-search-forward
-                             (re-search-forward
+                               "\^M\\|\n" nil 'move
-                              "\^M\\|\n" nil 'move
+                               (if (and (bobp) (not (looking-at "\^M\\|\n")))
-                              (if (and (bobp) (not (looking-at "\^M\\|\n")))
+                                   1
-                                  1
+                                 2))
-                                2))
+                              (while (looking-at " \\|\^I")
-                             (while (looking-at " \\|\^I")
+                                (re-search-forward "\^M\\|\n" nil 'move))
-                               (re-search-forward "\^M\\|\n" nil 'move))
+                              (unless (and (eobp) (not (bolp)))
-                             (unless (and (eobp) (not (bolp)))
+                                (backward-char 1))
-                               (backward-char 1))
+                              (unless list-only
-                             (unless list-only
+                                (remove-overlays date-start (point)
-                               (remove-overlays date-start (point)
+                                                 'invisible 'diary))
-                                                'invisible 'diary))
+                              (setq entry (buffer-substring entry-start (point))
-                             (setq entry (buffer-substring entry-start (point))
+                                    temp (diary-pull-attrs entry file-glob-attrs)
-                                   temp (diary-pull-attrs entry file-glob-attrs)
+                                    entry (nth 0 temp))
-                                   entry (nth 0 temp))
+                              (add-to-diary-list
-                             (add-to-diary-list
+                               date
-                              date
+                               entry
-                              entry
+                               (buffer-substring
-                              (buffer-substring
+                                (1+ date-start) (1- entry-start))
-                               (1+ date-start) (1- entry-start))
+                               (copy-marker entry-start) (nth 1 temp)))))))
-                              (copy-marker entry-start) (nth 1 temp)))))))
+                    (or entry-found
-                   (or entry-found
+                        (not diary-list-include-blanks)
-                       (not diary-list-include-blanks)
+                        (add-to-diary-list date "" "" "" ""))
-                       (add-to-diary-list date "" "" "" ""))
+                    (setq date
-                   (setq date
+                          (calendar-gregorian-from-absolute
-                         (calendar-gregorian-from-absolute
+                           (1+ (calendar-absolute-from-gregorian date))))
-                          (1+ (calendar-absolute-from-gregorian date))))
+                    (setq entry-found nil)))))
-                   (setq entry-found nil)))))
            (goto-char (point-min))
            (run-hooks 'nongregorian-diary-listing-hook
                       'list-diary-entries-hook)
            (unless list-only
              (if diary-display-hook
-                  (run-hooks 'diary-display-hook)
+              (run-hooks 'diary-display-hook)
-                (simple-diary-display)))
+              (simple-diary-display)))
            (run-hooks 'diary-hook)
            diary-entries-list))))))
@@ -1190,9 +1189,9 @@ A value of 0 in any position is a wildcard."
    (let ((m displayed-month)
          (y displayed-year))
      (increment-calendar-month m y -1)
-      (calendar-for-loop i from 0 to 2 do
+      (dotimes (idummy 3)
-          (mark-calendar-month m y month day year color)
+        (mark-calendar-month m y month day year color)
-          (increment-calendar-month m y 1)))))
+        (increment-calendar-month m y 1)))))
 (defun mark-calendar-month (month year p-month p-day p-year &optional color)
  "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
author	Glenn Morris	2007-07-24 06:11:37 +0000
committer	Glenn Morris	2007-07-24 06:11:37 +0000
commit	9e46548e642d529cc76c3cfbfb3c59c20f67d231 (patch)
tree	cb4b641651a27a12aacd1e7bf6c0586921b11be7
parent	2ed4b0e2e4c286b18f3de11e03757360603fb1b4 (diff)
download	emacs-9e46548e642d529cc76c3cfbfb3c59c20f67d231.tar.gz emacs-9e46548e642d529cc76c3cfbfb3c59c20f67d231.zip

diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index ee93b60eb98..6918f422f24 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el
@@ -461,95 +461,94 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
461	(set (make-local-variable 'diary-selective-display) t)	461	(set (make-local-variable 'diary-selective-display) t)
462	(overlay-put ol 'invisible 'diary)	462	(overlay-put ol 'invisible 'diary)
463	(overlay-put ol 'evaporate t)))	463	(overlay-put ol 'evaporate t)))
464	(calendar-for-loop	464	(dotimes (idummy number)
465	i from 1 to number do	465	(let ((month (extract-calendar-month date))
466	(let ((month (extract-calendar-month date))	466	(day (extract-calendar-day date))
467	(day (extract-calendar-day date))	467	(year (extract-calendar-year date))
468	(year (extract-calendar-year date))	468	(entry-found (list-sexp-diary-entries date)))
469	(entry-found (list-sexp-diary-entries date)))	469	(dolist (date-form diary-date-forms)
470	(dolist (date-form diary-date-forms)	470	(let*
471	(let*	471	((backup (when (eq (car date-form) 'backup)
472	((backup (when (eq (car date-form) 'backup)	472	(setq date-form (cdr date-form))
473	(setq date-form (cdr date-form))	473	t))
474	t))	474	(dayname
475	(dayname	475	(format "%s\\\|%s\\.?"
476	(format "%s\\\|%s\\.?"	476	(calendar-day-name date)
477	(calendar-day-name date)	477	(calendar-day-name date 'abbrev)))
478	(calendar-day-name date 'abbrev)))	478	(monthname
479	(monthname	479	(format "\\*\\\|%s\\\|%s\\.?"
480	(format "\\*\\\|%s\\\|%s\\.?"	480	(calendar-month-name month)
481	(calendar-month-name month)	481	(calendar-month-name month 'abbrev)))
482	(calendar-month-name month 'abbrev)))	482	(month (concat "\\\\\|0" (int-to-string month)))
483	(month (concat "\\\\\|0" (int-to-string month)))	483	(day (concat "\\\\\|0" (int-to-string day)))
484	(day (concat "\\\\\|0" (int-to-string day)))	484	(year
485	(year	485	(concat
486	(concat	486	"\\\\\|0" (int-to-string year)
487	"\\\\\|0" (int-to-string year)	487	(if abbreviated-calendar-year
488	(if abbreviated-calendar-year	488	(concat "\\\|" (format "%02d" (% year 100)))
489	(concat "\\\|" (format "%02d" (% year 100)))	489	"")))
490	"")))	490	(regexp
491	(regexp	491	(concat
492	(concat	492	"\\(\\`\\\|\^M\\\|\n\\)" mark "?\\("
493	"\\(\\`\\\|\^M\\\|\n\\)" mark "?\\("	493	(mapconcat 'eval date-form "\\)\\(?:")
494	(mapconcat 'eval date-form "\\)\\(?:")	494	"\\)"))
495	"\\)"))	495	(case-fold-search t))
496	(case-fold-search t))	496	(goto-char (point-min))
497	(goto-char (point-min))	497	(while (re-search-forward regexp nil t)
498	(while (re-search-forward regexp nil t)	498	(if backup (re-search-backward "\\<" nil t))
499	(if backup (re-search-backward "\\<" nil t))	499	(if (and (or (char-equal (preceding-char) ?\^M)
500	(if (and (or (char-equal (preceding-char) ?\^M)	500	(char-equal (preceding-char) ?\n))
501	(char-equal (preceding-char) ?\n))	501	(not (looking-at " \\\|\^I")))
502	(not (looking-at " \\\|\^I")))	502	;; Diary entry that consists only of date.
503	;; Diary entry that consists only of date.	503	(backward-char 1)
504	(backward-char 1)	504	;; Found a nonempty diary entry--make it
505	;; Found a nonempty diary entry--make it	505	;; visible and add it to the list.
506	;; visible and add it to the list.	506	(setq entry-found t)
507	(setq entry-found t)	507	(let ((entry-start (point))
508	(let ((entry-start (point))	508	date-start temp)
509	date-start temp)	509	(re-search-backward "\^M\\\|\n\\\|\\`")
510	(re-search-backward "\^M\\\|\n\\\|\\`")	510	(setq date-start (point))
511	(setq date-start (point))	511	;; When selective display (rather than
512	;; When selective display (rather than	512	;; overlays) was used, diary file used to
513	;; overlays) was used, diary file used to	513	;; start in a blank line and end in a
514	;; start in a blank line and end in a	514	;; newline. Now that neither of these
515	;; newline. Now that neither of these	515	;; need be true, 'move handles the latter
516	;; need be true, 'move handles the latter	516	;; and 1/2 kludge the former.
517	;; and 1/2 kludge the former.	517	(re-search-forward
518	(re-search-forward	518	"\^M\\\|\n" nil 'move
519	"\^M\\\|\n" nil 'move	519	(if (and (bobp) (not (looking-at "\^M\\\|\n")))
520	(if (and (bobp) (not (looking-at "\^M\\\|\n")))	520	1
521	1	521	2))
522	2))	522	(while (looking-at " \\\|\^I")
523	(while (looking-at " \\\|\^I")	523	(re-search-forward "\^M\\\|\n" nil 'move))
524	(re-search-forward "\^M\\\|\n" nil 'move))	524	(unless (and (eobp) (not (bolp)))
525	(unless (and (eobp) (not (bolp)))	525	(backward-char 1))
526	(backward-char 1))	526	(unless list-only
527	(unless list-only	527	(remove-overlays date-start (point)
528	(remove-overlays date-start (point)	528	'invisible 'diary))
529	'invisible 'diary))	529	(setq entry (buffer-substring entry-start (point))
530	(setq entry (buffer-substring entry-start (point))	530	temp (diary-pull-attrs entry file-glob-attrs)
531	temp (diary-pull-attrs entry file-glob-attrs)	531	entry (nth 0 temp))
532	entry (nth 0 temp))	532	(add-to-diary-list
533	(add-to-diary-list	533	date
534	date	534	entry
535	entry	535	(buffer-substring
536	(buffer-substring	536	(1+ date-start) (1- entry-start))
537	(1+ date-start) (1- entry-start))	537	(copy-marker entry-start) (nth 1 temp)))))))
538	(copy-marker entry-start) (nth 1 temp)))))))	538	(or entry-found
539	(or entry-found	539	(not diary-list-include-blanks)
540	(not diary-list-include-blanks)	540	(add-to-diary-list date "" "" "" ""))
541	(add-to-diary-list date "" "" "" ""))	541	(setq date
542	(setq date	542	(calendar-gregorian-from-absolute
543	(calendar-gregorian-from-absolute	543	(1+ (calendar-absolute-from-gregorian date))))
544	(1+ (calendar-absolute-from-gregorian date))))	544	(setq entry-found nil)))))
545	(setq entry-found nil)))))
546	(goto-char (point-min))	545	(goto-char (point-min))
547	(run-hooks 'nongregorian-diary-listing-hook	546	(run-hooks 'nongregorian-diary-listing-hook
548	'list-diary-entries-hook)	547	'list-diary-entries-hook)
549	(unless list-only	548	(unless list-only
550	(if diary-display-hook	549	(if diary-display-hook
551	(run-hooks 'diary-display-hook)	550	(run-hooks 'diary-display-hook)
552	(simple-diary-display)))	551	(simple-diary-display)))
553	(run-hooks 'diary-hook)	552	(run-hooks 'diary-hook)
554	diary-entries-list))))))	553	diary-entries-list))))))
555		554
@@ -1190,9 +1189,9 @@ A value of 0 in any position is a wildcard."
1190	(let ((m displayed-month)	1189	(let ((m displayed-month)
1191	(y displayed-year))	1190	(y displayed-year))
1192	(increment-calendar-month m y -1)	1191	(increment-calendar-month m y -1)
1193	(calendar-for-loop i from 0 to 2 do	1192	(dotimes (idummy 3)
1194	(mark-calendar-month m y month day year color)	1193	(mark-calendar-month m y month day year color)
1195	(increment-calendar-month m y 1)))))	1194	(increment-calendar-month m y 1)))))
1196		1195
1197	(defun mark-calendar-month (month year p-month p-day p-year &optional color)	1196	(defun mark-calendar-month (month year p-month p-day p-year &optional color)
1198	"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.	1197	"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.