Commit 2ed4b0e2 authored by Glenn Morris's avatar Glenn Morris

(list-hebrew-diary-entries): Use dotimes rather than

calendar-for-loop.
parent 92b1f7ab
......@@ -516,76 +516,76 @@ not be marked in the calendar. This function is provided for use with the
(diary-modified (buffer-modified-p))
(gdate original-date)
(mark (regexp-quote diary-nonmarking-symbol)))
(calendar-for-loop i from 1 to number do
(let* ((d diary-date-forms)
(hdate (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month hdate))
(day (extract-calendar-day hdate))
(year (extract-calendar-year hdate)))
(while d
(let*
((date-form (if (equal (car (car d)) 'backup)
(cdr (car d))
(car d)))
(backup (equal (car (car d)) 'backup))
(dayname
(format "%s\\|%s\\.?"
(calendar-day-name gdate)
(calendar-day-name gdate 'abbrev)))
(calendar-month-name-array
calendar-hebrew-month-name-array-leap-year)
(monthname
(concat
"\\*\\|"
(calendar-month-name month)))
(month (concat "\\*\\|0*" (int-to-string month)))
(day (concat "\\*\\|0*" (int-to-string day)))
(year
(concat
"\\*\\|0*" (int-to-string year)
(if abbreviated-calendar-year
(concat "\\|" (int-to-string (% year 100)))
"")))
(regexp
(concat
"\\(\\`\\|\^M\\|\n\\)" mark "?"
(regexp-quote hebrew-diary-entry-symbol)
"\\("
(mapconcat 'eval date-form "\\)\\(")
"\\)"))
(case-fold-search t))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(if backup (re-search-backward "\\<" nil t))
(if (and (or (char-equal (preceding-char) ?\^M)
(char-equal (preceding-char) ?\n))
(not (looking-at " \\|\^I")))
;; Diary entry that consists only of date.
(backward-char 1)
;; Found a nonempty diary entry--make it visible and
;; add it to the list.
(let ((entry-start (point))
(date-start))
(re-search-backward "\^M\\|\n\\|\\`")
(setq date-start (point))
(re-search-forward "\^M\\|\n" nil t 2)
(while (looking-at " \\|\^I")
(re-search-forward "\^M\\|\n" nil t))
(backward-char 1)
(subst-char-in-region date-start (point) ?\^M ?\n t)
(add-to-diary-list
gdate
(buffer-substring-no-properties entry-start (point))
(buffer-substring-no-properties
(1+ date-start) (1- entry-start))
(copy-marker entry-start))))))
(setq d (cdr d))))
(setq gdate
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian gdate)))))
(set-buffer-modified-p diary-modified))
(goto-char (point-min))))
(dotimes (idummy number)
(let* ((d diary-date-forms)
(hdate (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month hdate))
(day (extract-calendar-day hdate))
(year (extract-calendar-year hdate)))
(while d
(let*
((date-form (if (equal (car (car d)) 'backup)
(cdr (car d))
(car d)))
(backup (equal (car (car d)) 'backup))
(dayname
(format "%s\\|%s\\.?"
(calendar-day-name gdate)
(calendar-day-name gdate 'abbrev)))
(calendar-month-name-array
calendar-hebrew-month-name-array-leap-year)
(monthname
(concat
"\\*\\|"
(calendar-month-name month)))
(month (concat "\\*\\|0*" (int-to-string month)))
(day (concat "\\*\\|0*" (int-to-string day)))
(year
(concat
"\\*\\|0*" (int-to-string year)
(if abbreviated-calendar-year
(concat "\\|" (int-to-string (% year 100)))
"")))
(regexp
(concat
"\\(\\`\\|\^M\\|\n\\)" mark "?"
(regexp-quote hebrew-diary-entry-symbol)
"\\("
(mapconcat 'eval date-form "\\)\\(")
"\\)"))
(case-fold-search t))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(if backup (re-search-backward "\\<" nil t))
(if (and (or (char-equal (preceding-char) ?\^M)
(char-equal (preceding-char) ?\n))
(not (looking-at " \\|\^I")))
;; Diary entry that consists only of date.
(backward-char 1)
;; Found a nonempty diary entry--make it visible and
;; add it to the list.
(let ((entry-start (point))
(date-start))
(re-search-backward "\^M\\|\n\\|\\`")
(setq date-start (point))
(re-search-forward "\^M\\|\n" nil t 2)
(while (looking-at " \\|\^I")
(re-search-forward "\^M\\|\n" nil t))
(backward-char 1)
(subst-char-in-region date-start (point) ?\^M ?\n t)
(add-to-diary-list
gdate
(buffer-substring-no-properties entry-start (point))
(buffer-substring-no-properties
(1+ date-start) (1- entry-start))
(copy-marker entry-start))))))
(setq d (cdr d))))
(setq gdate
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian gdate)))))
(set-buffer-modified-p diary-modified))
(goto-char (point-min))))
(defun mark-hebrew-calendar-date-pattern (month day year)
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment