Commit 92b1f7ab authored by Glenn Morris's avatar Glenn Morris
Browse files

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

calendar-for-loop.
parent d7489fd9
......@@ -210,76 +210,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)
(idate (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month idate))
(day (extract-calendar-day idate))
(year (extract-calendar-year idate)))
(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-islamic-month-name-array)
(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 islamic-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)
(idate (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month idate))
(day (extract-calendar-day idate))
(year (extract-calendar-year idate)))
(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-islamic-month-name-array)
(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 islamic-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-islamic-diary-entries ()
"Mark days in the calendar window that have Islamic date diary entries.
......
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