emacs: lisp/calendar/diary-lib.el comparison

comparison lisp/calendar/diary-lib.el @ 92859:15bd5abe194e

Whitespace only.

author	Glenn Morris <rgm@gnu.org>
date	Thu, 13 Mar 2008 06:29:03 +0000
parents	de680a2b3b3b
children	532b44d84fec

comparison

equal deleted inserted replaced

-:7096add7a945
+:15bd5abe194e
 (defcustom diary-face 'diary
 "Face name to use for diary entries."
 :type 'face
 :group 'diary)
 (make-obsolete-variable 'diary-face "customize the face `diary' instead."
-			"23.1")
+"23.1")
 ;; Face markup of calendar and diary displays: Any entry line that
 ;; ends with [foo:value] where foo is a face attribute (except :box
 ;; :stipple) or with [face:blah] tags, will have these values applied
 ;; to the calendar and fancy diary displays.  These attributes "stack"
 specifies which face attribute (e.g. `:foreground') to modify, or
 that this is a face (`:face') to apply.  TYPE is the type of
 attribute being applied.  Available TYPES (see `diary-attrtype-convert')
 are: `string', `symbol', `int', `tnil',`stringtnil.'"
 :type '(repeat (list (string :tag "Regular expression")
-		       (integer :tag "Sub-expression")
+(integer :tag "Sub-expression")
-		       (symbol :tag "Attribute (e.g. :foreground)")
+(symbol :tag "Attribute (e.g. :foreground)")
-		       (choice (const string :tag "A string")
+(choice (const string :tag "A string")
-			       (const symbol :tag "A symbol")
+(const symbol :tag "A symbol")
-			       (const int :tag "An integer")
+(const int :tag "An integer")
-			       (const tnil :tag "`t' or `nil'")
+(const tnil :tag "`t' or `nil'")
-			       (const stringtnil
+(const stringtnil
-				      :tag "A string, `t', or `nil'"))))
+:tag "A string, `t', or `nil'"))))
 :group 'diary)
 (defcustom diary-glob-file-regexp-prefix "^\\#"
 "Regular expression prepended to `diary-face-attrs' for file-wide specifiers."
 :type 'regexp
 `list-hebrew-diary-entries', `list-islamic-diary-entries' and
 `diary-bahai-list-entries'.  The documentation for these functions
 describes the style of such diary entries."
 :type 'hook
 :options '(list-hebrew-diary-entries
-	     list-islamic-diary-entries
+list-islamic-diary-entries
-	     diary-bahai-list-entries)
+diary-bahai-list-entries)
 :group 'diary)
 (defcustom nongregorian-diary-marking-hook nil
 "List of functions called for marking diary file and included files.
 As the files are processed for diary entries, these functions are used
 `mark-hebrew-diary-entries', `mark-islamic-diary-entries' and
 `bahai-mark-diary-entries'.  The documentation for these functions
 describes the style of such diary entries."
 :type 'hook
 :options '(mark-hebrew-diary-entries
-	     mark-islamic-diary-entries
+mark-islamic-diary-entries
-	     diary-bahai-mark-entries)
+diary-bahai-mark-entries)
 :group 'diary)
 (defcustom print-diary-entries-hook 'lpr-buffer
 "List of functions called after a temporary diary buffer is prepared.
 The buffer shows only the diary entries currently visible in the diary
 If the template is actually a function, it is called with the message
 body text as argument, and may use `match-string' etc. to make a
 template following the rules above."
 :type '(alist :key-type (regexp :tag "Regexp matching time/place")
-		:value-type (choice
+:value-type (choice
-			     (string :tag "Template for entry")
+(string :tag "Template for entry")
-			     (function :tag
+(function :tag
-				       "Unary function providing template")))
+"Unary function providing template")))
 :version "22.1"
 :group 'diary)
 ;;; More user options below and in calendar.el.
 (defun diary-attrtype-convert (attrvalue type)
 "Convert string ATTRVALUE to TYPE appropriate for a face description.
 Valid TYPEs are: string, symbol, int, stringtnil, tnil."
 (cond ((eq type 'string) attrvalue)
-	((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft?
+((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft?
-	((eq type 'int) (string-to-number attrvalue))
+((eq type 'int) (string-to-number attrvalue))
-	((eq type 'stringtnil)
+((eq type 'stringtnil)
-	 (cond ((string-equal "t" attrvalue) t)
+(cond ((string-equal "t" attrvalue) t)
-	       ((string-equal "nil" attrvalue) nil)
+((string-equal "nil" attrvalue) nil)
-	       (t attrvalue)))
+(t attrvalue)))
-	((eq type 'tnil) (string-equal "t" attrvalue))))
+((eq type 'tnil) (string-equal "t" attrvalue))))
 (defun diary-pull-attrs (entry fileglobattrs)
 "Search for matches for regexps from `diary-face-attrs'.
 If ENTRY is nil, searches from the start of the current buffer, and
 prepends all regexps with `diary-glob-file-regexp-prefix'.
 Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
 When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
 pairs."
 (let (regexp regnum attrname attrname attrvalue type ret-attr)
 (if (null entry)
-	(save-excursion
+(save-excursion
-	  (dolist (attr diary-face-attrs)
+(dolist (attr diary-face-attrs)
-	    ;; FIXME inefficient searching.
+;; FIXME inefficient searching.
-	    (goto-char (point-min))
+(goto-char (point-min))
-	    (setq regexp (concat diary-glob-file-regexp-prefix (car attr))
+(setq regexp (concat diary-glob-file-regexp-prefix (car attr))
-		  regnum (cadr attr)
+regnum (cadr attr)
-		  attrname (nth 2 attr)
+attrname (nth 2 attr)
-		  type (nth 3 attr)
+type (nth 3 attr)
-		  attrvalue (if (re-search-forward regexp nil t)
+attrvalue (if (re-search-forward regexp nil t)
-				(match-string-no-properties regnum)))
+(match-string-no-properties regnum)))
-	    (and attrvalue
+(and attrvalue
-		 (setq attrvalue (diary-attrtype-convert attrvalue type))
+(setq attrvalue (diary-attrtype-convert attrvalue type))
-		 (setq ret-attr (append ret-attr
+(setq ret-attr (append ret-attr
-					(list attrname attrvalue))))))
+(list attrname attrvalue))))))
 (setq ret-attr fileglobattrs)
 (dolist (attr diary-face-attrs)
-	(setq regexp (car attr)
+(setq regexp (car attr)
-	      regnum (cadr attr)
+regnum (cadr attr)
-	      attrname (nth 2 attr)
+attrname (nth 2 attr)
-	      type (nth 3 attr)
+type (nth 3 attr)
-	      attrvalue nil)
+attrvalue nil)
-	;; FIXME multiple matches?
+;; FIXME multiple matches?
-	(if (string-match regexp entry)
+(if (string-match regexp entry)
-	    (setq attrvalue (match-string-no-properties regnum entry)
+(setq attrvalue (match-string-no-properties regnum entry)
-		  entry (replace-match "" t t entry)))
+entry (replace-match "" t t entry)))
-	(and attrvalue
+(and attrvalue
-	     (setq attrvalue (diary-attrtype-convert attrvalue type))
+(setq attrvalue (diary-attrtype-convert attrvalue type))
-	     (setq ret-attr (append ret-attr (list attrname attrvalue))))))
+(setq ret-attr (append ret-attr (list attrname attrvalue))))))
 (list entry ret-attr)))
 ;;;###cal-autoload
 (defun diary-set-maybe-redraw (symbol value)
 "Set SYMBOL's value to VALUE, and redraw the diary if necessary.
 This variable does not affect the diary display with the `d' command
 from the calendar; in that case, the prefix argument controls the
 number of days of diary entries displayed."
 :type '(choice (integer :tag "Entries")
-		 (vector :value [0 0 0 0 0 0 0]
+(vector :value [0 0 0 0 0 0 0]
-			 (integer :tag "Sunday")
+(integer :tag "Sunday")
-			 (integer :tag "Monday")
+(integer :tag "Monday")
-			 (integer :tag "Tuesday")
+(integer :tag "Tuesday")
-			 (integer :tag "Wednesday")
+(integer :tag "Wednesday")
-			 (integer :tag "Thursday")
+(integer :tag "Thursday")
-			 (integer :tag "Friday")
+(integer :tag "Friday")
-			 (integer :tag "Saturday")))
+(integer :tag "Saturday")))
 :initialize 'custom-initialize-default
 :set 'diary-set-maybe-redraw
 :group 'diary)
 "Function applied to entry string before putting it into the entries list.
 Can be used by programs integrating a diary list into other buffers (e.g.
 org.el and planner.el) to modify the string or add properties to it.
 The function takes a string argument and must return a string.")
-(defvar diary-entries-list)		; bound in diary-list-entries
+(defvar diary-entries-list)             ; bound in diary-list-entries
 (defun add-to-diary-list (date string specifier &optional marker
 globcolor literal)
 "Add an entry to `diary-entries-list'.
 Do nothing if DATE or STRING is nil.  DATE is the (MONTH DAY
 (let ((prefix (funcall diary-file-name-prefix-function
 (buffer-file-name))))
 (or (string-equal prefix "")
 (setq string (format "[%s] %s" prefix string)))))
 (and diary-modify-entry-list-string-function
-	 (setq string (funcall diary-modify-entry-list-string-function
+(setq string (funcall diary-modify-entry-list-string-function
-			       string)))
+string)))
 (setq diary-entries-list
 (append diary-entries-list
 (list (list date string specifier
 (list marker (buffer-file-name) literal)
 globcolor))))))
 (unless number
 (setq number (if (vectorp number-of-diary-entries)
 (aref number-of-diary-entries (calendar-day-of-week date))
 number-of-diary-entries)))
 (when (> number 0)
-(let ((original-date date)	  ; save for possible use in the hooks
+(let ((original-date date)    ; save for possible use in the hooks
 diary-entries-list
 file-glob-attrs
 (date-string (calendar-date-string date))
 (d-file (substitute-in-file-name diary-file)))
 (message "Preparing diary...")
 (day (extract-calendar-day date))
 (year (extract-calendar-year date))
 (entry-found (list-sexp-diary-entries date)))
 (dolist (date-form diary-date-forms)
 (let* ((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
-"^" mark "?\\("
+			       "^" mark "?\\("
-			     ;; This must be let* so that date-form
+			       ;; This must be let* so that date-form
-			     ;; can use day etc.
+			       ;; can use day etc.
-(mapconcat 'eval date-form "\\)\\(?:")
+			       (mapconcat 'eval date-form "\\)\\(?:")
-"\\)"))
+			       "\\)"))
-(case-fold-search t))
+			     (case-fold-search t))
 (goto-char (point-min))
 (while (re-search-forward regexp nil t)
 (if backup (re-search-backward "\\<" nil t))
-(if (and (bolp) (not (looking-at "[ \t]")))
+			  (if (and (bolp) (not (looking-at "[ \t]")))
 ;;  Diary entry that consists only of date.
 (backward-char 1)
 ;; Found a nonempty diary entry--make it
 ;; visible and add it to the list.
 (setq entry-found t)
-(if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
+			    (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
 (let ((entry-start (point))
 date-start temp)
-(setq date-start
+			      (setq date-start
-(line-end-position
+				    (line-end-position
-(if (and (bolp) (> number 1)) -1 0)))
+				     (if (and (bolp) (> number 1)) -1 0)))
-(forward-line 1)
+			      (forward-line 1)
-(while (looking-at "[ \t]")
+			      (while (looking-at "[ \t]")
-(forward-line 1))
+				(forward-line 1))
 (unless (and (eobp) (not (bolp)))
 (backward-char 1))
 (unless list-only
 (remove-overlays date-start (point)
 'invisible 'diary))
-			      (setq temp (diary-pull-attrs
+(setq temp (diary-pull-attrs
-					  (buffer-substring entry-start (point))
+(buffer-substring entry-start (point))
-					  file-glob-attrs))
+file-glob-attrs))
 (add-to-diary-list
 date
 (car temp)
 (buffer-substring
 (1+ date-start) (1- entry-start))
 (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))))))
 (defun diary-unhide-everything ()
 "Show all invisible text in the diary."
 (kill-local-variable 'diary-selective-display)
 (remove-overlays (point-min) (point-max) 'invisible 'diary)
 (kill-local-variable 'mode-line-format))
-(defvar original-date)			; bound in diary-list-entries
+(defvar original-date)                  ; bound in diary-list-entries
 (defvar number)
 (defun include-other-diary-files ()
 "Include the diary entries from other diary files with those of `diary-file'.
 This function is suitable for use in `list-diary-entries-hook';
 "^"
 (regexp-quote diary-include-string)
 " \"\\([^\"]*\\)\"")
 nil t)
 (let ((diary-file (substitute-in-file-name
-		       (match-string-no-properties 1)))
+(match-string-no-properties 1)))
-	  (diary-list-include-blanks nil)
+(diary-list-include-blanks nil)
-	  (list-diary-entries-hook 'include-other-diary-files)
+(list-diary-entries-hook 'include-other-diary-files)
-	  (diary-display-hook 'ignore)
+(diary-display-hook 'ignore)
-	  (diary-hook nil))
+(diary-hook nil))
 (if (file-exists-p diary-file)
 (if (file-readable-p diary-file)
 (unwind-protect
 (setq diary-entries-list
 (append diary-entries-list
 (message "Can't read included diary file %s" diary-file)
 (sleep-for 2))
 (beep)
 (message "Can't find included diary file %s" diary-file)
 (sleep-for 2))))
 (goto-char (point-min)))
 ;; Bound in diary-list-entries.
 (defvar date-string)
 (defvar diary-saved-point)
 (set-window-point window diary-saved-point)
 (set-window-start window (point-min))))
 (message "Preparing diary...done"))))
 (defface diary-button '((((type pc) (class color))
-			 (:foreground "lightblue")))
+(:foreground "lightblue")))
 "Default face used for buttons."
 :version "22.1"
 :group 'diary)
 ;; Backward-compatibility alias. FIXME make obsolete.
 (put 'diary-button-face 'face-alias 'diary-button)
 (let ((entry-list diary-entries-list)
 (holiday-list)
 (holiday-list-last-month 1)
 (holiday-list-last-year 1)
 (date (list 0 0 0)))
-	(dolist (entry entry-list)
+(dolist (entry entry-list)
 (if (not (calendar-date-equal date (car entry)))
 (progn
 (setq date (car entry))
 (and holidays-in-diary-buffer
 (calendar-date-compare
 holiday-list-last-year))
 (list date))
 ;; We need to get the holidays for the next 3 months.
 (setq holiday-list-last-month
 (extract-calendar-month date)
-			   holiday-list-last-year
+holiday-list-last-year
 (extract-calendar-year date))
 (progn
 (increment-calendar-month
 holiday-list-last-month holiday-list-last-year 1)
 t)
 (displayed-year holiday-list-last-year))
 (calendar-holiday-list)))
 (increment-calendar-month
 holiday-list-last-month holiday-list-last-year 1))
 (let (date-holiday-list)
-		  ;; Make a list of all holidays for date.
+;; Make a list of all holidays for date.
-		  (dolist (h holiday-list)
+(dolist (h holiday-list)
-		    (if (calendar-date-equal date (car h))
+(if (calendar-date-equal date (car h))
-			(setq date-holiday-list (append date-holiday-list
+(setq date-holiday-list (append date-holiday-list
-							(cdr h)))))
+(cdr h)))))
 (insert (if (bobp) "" ?\n) (calendar-date-string date))
 (if date-holiday-list (insert ":  "))
 (let ((l (current-column))
-			(longest 0))
+(longest 0))
 (insert (mapconcat (lambda (x)
-					 (if (< longest (length x))
+(if (< longest (length x))
-					     (setq longest (length x)))
+(setq longest (length x)))
-					 x)
+x)
 date-holiday-list
 (concat "\n" (make-string l ? ))))
 (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
-	  (let ((this-entry (cadr entry))
+(let ((this-entry (cadr entry))
-		this-loc)
+this-loc)
-	    (unless (zerop (length this-entry))
+(unless (zerop (length this-entry))
-	      (if (setq this-loc (nth 3 entry))
+(if (setq this-loc (nth 3 entry))
-		  (insert-button (concat this-entry "\n")
+(insert-button (concat this-entry "\n")
-				 ;; (MARKER FILENAME SPECIFIER LITERAL)
+;; (MARKER FILENAME SPECIFIER LITERAL)
-				 'locator (list (car this-loc)
+'locator (list (car this-loc)
-						(cadr this-loc)
+(cadr this-loc)
-						(nth 2 entry)
+(nth 2 entry)
-						(or (nth 2 this-loc)
+(or (nth 2 this-loc)
-						    (nth 1 entry)))
+(nth 1 entry)))
-				 :type 'diary-entry)
+:type 'diary-entry)
-		(insert this-entry ?\n))
+(insert this-entry ?\n))
-	      (save-excursion
+(save-excursion
-		(let* ((marks (nth 4 entry))
+(let* ((marks (nth 4 entry))
-		       (faceinfo marks)
+(faceinfo marks)
-		       temp-face)
+temp-face)
-		  (when marks
+(when marks
-		    (setq temp-face (make-symbol
+(setq temp-face (make-symbol
-				     (apply
+(apply
-				      'concat "temp-face-"
+'concat "temp-face-"
-				      (mapcar (lambda (sym)
+(mapcar (lambda (sym)
-						(if (stringp sym)
+(if (stringp sym)
-						    sym
+sym
-						  (symbol-name sym)))
+(symbol-name sym)))
-					      marks))))
+marks))))
-		    (make-face temp-face)
+(make-face temp-face)
-		    ;; Remove :face info from the marks,
+;; Remove :face info from the marks,
-		    ;; copy the face info into temp-face
+;; copy the face info into temp-face
-		    (while (setq faceinfo (memq :face faceinfo))
+(while (setq faceinfo (memq :face faceinfo))
-		      (copy-face (read (nth 1 faceinfo)) temp-face)
+(copy-face (read (nth 1 faceinfo)) temp-face)
-		      (setcar faceinfo nil)
+(setcar faceinfo nil)
-		      (setcar (cdr faceinfo) nil))
+(setcar (cdr faceinfo) nil))
-		    (setq marks (delq nil marks))
+(setq marks (delq nil marks))
-		    ;; Apply the font aspects.
+;; Apply the font aspects.
-		    (apply 'set-face-attribute temp-face nil marks)
+(apply 'set-face-attribute temp-face nil marks)
-		    (search-backward this-entry)
+(search-backward this-entry)
-		    (overlay-put
+(overlay-put
-		     (make-overlay (match-beginning 0) (match-end 0))
+(make-overlay (match-beginning 0) (match-end 0))
-		     'face temp-face))))))))
+'face temp-face))))))))
 (set-buffer-modified-p nil)
 (goto-char (point-min))
 (setq buffer-read-only t)
 (display-buffer fancy-diary-buffer)
 (fancy-diary-display-mode)
 (- y 100)
 (if (> (- current-y y) 50)
 (+ y 100)
 y)))
 (string-to-number y-str)))))
-		  (setq marks (nth 1
+(setq marks (nth 1
-				   (diary-pull-attrs
+(diary-pull-attrs
-				    (buffer-substring-no-properties
+(buffer-substring-no-properties
-				     (point) (line-end-position))
+(point) (line-end-position))
-				    file-glob-attrs)))
+file-glob-attrs)))
 (if dd-name
 (mark-calendar-days-named
 (cdr (assoc-string
 dd-name
 (calendar-make-alist
 (mark-sexp-diary-entries)
 (run-hooks 'nongregorian-diary-marking-hook
 'mark-diary-entries-hook))
 (message "Marking diary entries...done")))))
-(defvar displayed-year)			; bound in generate-calendar
+(defvar displayed-year)                 ; bound in generate-calendar
 (defvar displayed-month)
 (defun mark-sexp-diary-entries ()
 "Mark days in the calendar window that have sexp diary entries.
 Each entry in the diary file (or included files) visible in the calendar window
 sexp entry entry-start marks)
 (forward-sexp)
 (setq sexp (buffer-substring-no-properties sexp-start (point)))
 (forward-char 1)
 (if (and (bolp) (not (looking-at "[ \t]")))
-	    ;; Diary entry consists only of the sexp.
+;; Diary entry consists only of the sexp.
 (progn
 (backward-char 1)
 (setq entry ""))
 (setq entry-start (point))
 ;; Find end of entry.
 (while (looking-at "[ \t]")
 (forward-line 1))
 (if (bolp) (backward-char 1))
 (setq entry (buffer-substring-no-properties entry-start (point))))
 (calendar-for-loop date from first-date to last-date do
-(if (setq mark (diary-sexp-entry sexp entry
+			   (if (setq mark (diary-sexp-entry sexp entry
-(calendar-gregorian-from-absolute date)))
+							    (calendar-gregorian-from-absolute date)))
-	      (progn
+			       (progn
-		(setq marks (diary-pull-attrs entry file-glob-attrs)
+				 (setq marks (diary-pull-attrs entry file-glob-attrs)
-		      marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
+				       marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
-		(mark-visible-calendar-date
+				 (mark-visible-calendar-date
-		 (calendar-gregorian-from-absolute date)
+				  (calendar-gregorian-from-absolute date)
-		 (if (< 0 (length marks))
+				  (if (< 0 (length marks))
-		     marks
+				      marks
-		   (if (consp mark)
+				    (if (consp mark)
-		     (car mark)))))))))))
+					(car mark)))))))))))
 (defun mark-included-diary-files ()
 "Mark the diary entries from other diary files with those of the diary file.
 This function is suitable for use as the `mark-diary-entries-hook'; it enables
 you to use shared diary files together with your own.  The files included are
 (day))
 (increment-calendar-month succ-month succ-year 1)
 (increment-calendar-month prev-month prev-year -1)
 (setq day (calendar-absolute-from-gregorian
 (calendar-nth-named-day 1 dayname prev-month prev-year))
-	    last-day (calendar-absolute-from-gregorian
+last-day (calendar-absolute-from-gregorian
-(calendar-nth-named-day -1 dayname succ-month succ-year)))
+		      (calendar-nth-named-day -1 dayname succ-month succ-year)))
 (while (<= day last-day)
 (mark-visible-calendar-date (calendar-gregorian-from-absolute day)
-				    color)
+color)
 (setq day (+ day 7))))))
 (defun mark-calendar-date-pattern (month day year &optional color)
 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
 A value of 0 in any position is a wildcard.
 (or (zerop p-year) (= year p-year)))
 (and (zerop p-month)
 (or (zerop p-year) (= year p-year))))
 (if (zerop p-day)
 (calendar-for-loop
-i from 1 to (calendar-last-day-of-month month year) do
+	   i from 1 to (calendar-last-day-of-month month year) do
-(mark-visible-calendar-date (list month i year) color))
+	   (mark-visible-calendar-date (list month i year) color))
 (mark-visible-calendar-date (list month p-day year) color))))
 (defun sort-diary-entries ()
 "Sort the list of diary entries by time of day."
 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
 Returns `diary-unknown-time' (default value -9999) if no time is recognized.
 The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
 XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM.  A period (.) can
 be used instead of a colon (:) to separate the hour and minute parts."
 (let ((case-fold-search nil))
-(cond ((string-match		; military time
+(cond ((string-match                ; military time
-	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
+"\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
 s)
-	   (+ (* 100 (string-to-number (match-string 1 s)))
+(+ (* 100 (string-to-number (match-string 1 s)))
-	      (string-to-number (match-string 2 s))))
+(string-to-number (match-string 2 s))))
-	  ((string-match		; hour only (XXam or XXpm)
+((string-match                ; hour only (XXam or XXpm)
-	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
+"\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
-	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
+(+ (* 100 (% (string-to-number (match-string 1 s)) 12))
-	      (if (equal ?a (downcase (aref s (match-beginning 2))))
+(if (equal ?a (downcase (aref s (match-beginning 2))))
-		  0 1200)))
+0 1200)))
-	  ((string-match	 ; hour and minute (XX:XXam or XX:XXpm)
+((string-match	; hour and minute (XX:XXam or XX:XXpm)
-	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
+"\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
+(+ (* 100 (% (string-to-number (match-string 1 s)) 12))
-	      (string-to-number (match-string 2 s))
+(string-to-number (match-string 2 s))
-	      (if (equal ?a (downcase (aref s (match-beginning 3))))
+(if (equal ?a (downcase (aref s (match-beginning 3))))
-		  0 1200)))
+0 1200)))
-	  (t diary-unknown-time))))	; unrecognizable
+(t diary-unknown-time))))     ; unrecognizable
 (defun list-sexp-diary-entries (date)
 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
 Also, make them visible in the diary file.  Returns t if any entries were
 found.
 (setq specifier
 (buffer-substring-no-properties (1+ line-start) (point))
 entry-start (1+ line-start))
 (forward-char 1)
 (if (and (bolp) (not (looking-at "[ \t]")))
-	    ;; Diary entry consists only of the sexp.
+;; Diary entry consists only of the sexp.
 (progn
 (backward-char 1)
 (setq entry ""))
 (setq entry-start (point))
 (forward-line 1)
 (message "Bad sexp at line %d in %s: %s"
 (count-lines (point-min) (point))
 diary-file sexp)
 (sleep-for 2))))))
 (cond ((stringp result) result)
-	  ((and (consp result)
+((and (consp result)
-		(stringp (cdr result))) result)
+(stringp (cdr result))) result)
-	  (result entry)
+(result entry)
 (t nil))))
 (defvar date)
 (defvar entry)
 backward from the end of the month.
 An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
 Optional MARK specifies a face or single-character string to use when
 highlighting the day in the calendar."
 ;; This is messy because the diary entry may apply, but the date on which it
 ;; is based can be in a different month/year.  For example, asking for the
 ;; first Monday after December 30.  For large values of |n| the problem is
 ;; more grotesque.
 (and (= dayname (calendar-day-of-week date))
 (let* ((m (extract-calendar-month date))
 (d (extract-calendar-day date))
 (y (extract-calendar-year date))
-	      ;; Last (n>0) or first (n<0) possible base date for entry.
+;; Last (n>0) or first (n<0) possible base date for entry.
 (limit
 (calendar-nth-named-absday (- n) dayname m y d))
 (last-abs (if (> n 0) limit (+ limit 6)))
 (first-abs (if (> n 0) (- limit 6) limit))
 (last (calendar-gregorian-from-absolute last-abs))
 (y1 (extract-calendar-year first))
 ;; m2, d2 is last possible base date.
 (m2 (extract-calendar-month last))
 (d2 (extract-calendar-day last))
 (y2 (extract-calendar-year last)))
-	 (if (or (and (= m1 m2)	; only possible base dates in one month
+(if (or (and (= m1 m2) ; only possible base dates in one month
-		      (or (eq month t)
+(or (eq month t)
-			  (if (listp month)
+(if (listp month)
 (memq m1 month)
-			    (= m1 month)))
+(= m1 month)))
-		      (let ((d (or day (if (> n 0)
+(let ((d (or day (if (> n 0)
-					   1
+1
-					 (calendar-last-day-of-month m1 y1)))))
+(calendar-last-day-of-month m1 y1)))))
-			(and (<= d1 d) (<= d d2))))
+(and (<= d1 d) (<= d d2))))
-		 ;; Only possible base dates straddle two months.
+;; Only possible base dates straddle two months.
-		 (and (or (< y1 y2)
+(and (or (< y1 y2)
-			  (and (= y1 y2) (< m1 m2)))
+(and (= y1 y2) (< m1 m2)))
-		      (or
+(or
-		       ;; m1, d1 works as a base date.
+;; m1, d1 works as a base date.
-		       (and
+(and
-			(or (eq month t)
+(or (eq month t)
-			    (if (listp month)
+(if (listp month)
 (memq m1 month)
-			      (= m1 month)))
+(= m1 month)))
-			(<= d1 (or day (if (> n 0)
+(<= d1 (or day (if (> n 0)
-					   1
+1
-					 (calendar-last-day-of-month m1 y1)))))
+(calendar-last-day-of-month m1 y1)))))
-		       ;; m2, d2 works as a base date.
+;; m2, d2 works as a base date.
-		       (and (or (eq month t)
+(and (or (eq month t)
-				(if (listp month)
+(if (listp month)
 (memq m2 month)
-				  (= m2 month)))
+(= m2 month)))
-			    (<= (or day (if (> n 0)
+(<= (or day (if (> n 0)
-					    1
+1
-					  (calendar-last-day-of-month m2 y2)))
+(calendar-last-day-of-month m2 y2)))
-				d2)))))
+d2)))))
-	     (cons mark entry)))))
+(cons mark entry)))))
 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
 (defun diary-anniversary (month day &optional year mark)
 "Anniversary diary entry.
 Entry applies if date is the anniversary of MONTH, DAY, YEAR if
 ((and diary-entry
 (or (not marking-diary-entries) marking-diary-entry))
 diary-entry)
 ;; Diary entry may apply to `days' before date.
 ((and (integerp days)
-(not diary-entry)	  ; diary entry does not apply to date
+(not diary-entry)      ; diary entry does not apply to date
 (or (not marking-diary-entries) marking))
 (let ((date (calendar-gregorian-from-absolute
 (+ (calendar-absolute-from-gregorian date) days))))
 (when (setq diary-entry (eval sexp)) ; re-evaluate with adjusted date
 ;; Discard any mark portion from diary-anniversary, etc.
 (interactive "P")
 (let ((calendar-date-display-form
 (if european-calendar-style
 '(day " " month " " year)
 '(month " " day " " year)))
-(cursor (calendar-cursor-to-date t))
+	(cursor (calendar-cursor-to-date t))
-(mark (or (car calendar-mark-ring)
+	(mark (or (car calendar-mark-ring)
-(error "No mark set in this buffer")))
+		  (error "No mark set in this buffer")))
-start end)
+	start end)
 (if (< (calendar-absolute-from-gregorian mark)
 (calendar-absolute-from-gregorian cursor))
 (setq start mark
 end cursor)
 (setq start cursor
-end mark))
+	    end mark))
 (make-diary-entry
 (format "%s(diary-block %s %s)"
-sexp-diary-entry-symbol
+	     sexp-diary-entry-symbol
-(calendar-date-string start nil t)
+	     (calendar-date-string start nil t)
-(calendar-date-string end nil t))
+	     (calendar-date-string end nil t))
 arg)))
 ;;;###cal-autoload
 (defun insert-cyclic-diary-entry (arg)
 "Insert a cyclic diary entry starting at the date given by point.
 (if (re-search-forward
 (concat "^" (regexp-quote diary-nonmarking-symbol)
 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
 limit t)
 (condition-case nil
-	  (save-restriction
+(save-restriction
-	    (narrow-to-region (point-min) limit)
+(narrow-to-region (point-min) limit)
-	    (let ((start (point)))
+(let ((start (point)))
-	      (forward-sexp 1)
+(forward-sexp 1)
-	      (store-match-data (list start (point)))
+(store-match-data (list start (point)))
-	      t))
+t))
-	(error t))))
+(error t))))
 (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
 If given, optional SYMBOL must be a prefix to entries.
 If optional ABBREV-ARRAY is present, the abbreviations constructed
 (diary-name-pattern month-array abbrev-array)))
 (month "\\([0-9]+\\|\\*\\)")
 (day "\\([0-9]+\\|\\*\\)")
 (year "-?\\([0-9]+\\|\\*\\)"))
 (mapcar (lambda (x)
-(cons
+	      (cons
-(concat "^" (regexp-quote diary-nonmarking-symbol) "?"
+	       (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
-(if symbol (regexp-quote symbol) "") "\\("
+		       (if symbol (regexp-quote symbol) "") "\\("
-(mapconcat 'eval
+		       (mapconcat 'eval
-;; If backup, omit first item (backup)
+				  ;; If backup, omit first item (backup)
-;; and last item (not part of date).
+				  ;; and last item (not part of date).
-(if (equal (car x) 'backup)
+				  (if (equal (car x) 'backup)
 (nreverse (cdr (reverse (cdr x))))
-x)
+				    x)
-"")
+				  "")
-;; With backup, last item is not part of date.
+		       ;; With backup, last item is not part of date.
-(if (equal (car x) 'backup)
+		       (if (equal (car x) 'backup)
-(concat "\\)" (eval (car (reverse x))))
+			   (concat "\\)" (eval (car (reverse x))))
-"\\)"))
+			 "\\)"))
-'(1 diary-face)))
+	       '(1 diary-face)))
 diary-date-forms)))
 (defvar calendar-hebrew-month-name-array-leap-year)
 (defvar calendar-islamic-month-name-array)
 (defvar calendar-bahai-month-name-array)
 nongregorian-diary-listing-hook))
 (require 'cal-islam)
 (diary-font-lock-date-forms
 calendar-islamic-month-name-array islamic-diary-entry-symbol))
 (when (or (memq 'diary-bahai-mark-entries
-		   nongregorian-diary-marking-hook)
+nongregorian-diary-marking-hook)
-	     (memq 'diary-bahai-list-entries
+(memq 'diary-bahai-list-entries
-		   nongregorian-diary-marking-hook))
+nongregorian-diary-marking-hook))
 (require 'cal-bahai)
 (diary-font-lock-date-forms
 calendar-bahai-month-name-array bahai-diary-entry-symbol))
 (list
 (cons
 (format "^%s.*$" (regexp-quote diary-include-string))
 'font-lock-keyword-face)
 (cons
 (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol)
-	     (regexp-quote sexp-diary-entry-symbol))
+(regexp-quote sexp-diary-entry-symbol))
 '(1 font-lock-reference-face))
 (cons
 (format "^%s" (regexp-quote diary-nonmarking-symbol))
 'font-lock-reference-face)
 (cons
 (format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
-	     (regexp-opt (mapcar 'regexp-quote
+(regexp-opt (mapcar 'regexp-quote
-				 (list hebrew-diary-entry-symbol
+(list hebrew-diary-entry-symbol
-				       islamic-diary-entry-symbol
+islamic-diary-entry-symbol
-				       bahai-diary-entry-symbol))
+bahai-diary-entry-symbol))
-			 t))
+t))
 '(1 font-lock-reference-face))
 '(diary-font-lock-sexps . font-lock-keyword-face)
 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
-	       diary-time-regexp)
+diary-time-regexp)
 . 'diary-time))))
 (defvar diary-font-lock-keywords (diary-font-lock-keywords)
 "Forms to highlight in `diary-mode'.")
 Arg TEST-ONLY non-nil means return non-nil if and only if the
 message contains an appointment, don't make a diary entry."
 (catch 'finished
 (let (format-string)
 (dotimes (i (length diary-outlook-formats))
-	(when (eq 0 (string-match (car (nth i diary-outlook-formats))
+(when (eq 0 (string-match (car (nth i diary-outlook-formats))
-				  body))
+body))
-	  (unless test-only
+(unless test-only
-	    (setq format-string (cdr (nth i diary-outlook-formats)))
+(setq format-string (cdr (nth i diary-outlook-formats)))
-	    (save-excursion
+(save-excursion
-	      (save-window-excursion
+(save-window-excursion
-		;; Fixme: References to optional fields in the format
+;; Fixme: References to optional fields in the format
-		;; are treated literally, not replaced by the empty
+;; are treated literally, not replaced by the empty
-		;; string.  I think this is an Emacs bug.
+;; string.  I think this is an Emacs bug.
-		(make-diary-entry
+(make-diary-entry
-		 (format (replace-match (if (functionp format-string)
+(format (replace-match (if (functionp format-string)
-					    (funcall format-string body)
+(funcall format-string body)
-					  format-string)
+format-string)
-					t nil (match-string 0 body))
+t nil (match-string 0 body))
-			 subject))
+subject))
-		(save-buffer))))
+(save-buffer))))
-	  (throw 'finished t))))
+(throw 'finished t))))
 nil))
 (defun diary-from-outlook (&optional noconfirm)
 "Maybe snarf diary entry from current Outlook-generated message.
 Currently knows about Gnus and Rmail modes.  Unless the optional
 argument NOCONFIRM is non-nil (which is the case when this
 function is called interactively), then if an entry is found the
 user is asked to confirm its addition."
 (interactive "p")
 (let ((func (cond
-	       ((eq major-mode 'rmail-mode)
+((eq major-mode 'rmail-mode)
-		#'diary-from-outlook-rmail)
+#'diary-from-outlook-rmail)
-	       ((memq major-mode '(gnus-summary-mode gnus-article-mode))
+((memq major-mode '(gnus-summary-mode gnus-article-mode))
-		#'diary-from-outlook-gnus)
+#'diary-from-outlook-gnus)
-	       (t (error "Don't know how to snarf in `%s'" major-mode)))))
+(t (error "Don't know how to snarf in `%s'" major-mode)))))
 (funcall func noconfirm)))
 (defvar gnus-article-mime-handles)
 (defvar gnus-article-buffer)
 Add this function to `gnus-article-prepare-hook' to notice appointments
 automatically."
 (interactive "p")
 (with-current-buffer gnus-article-buffer
 (let ((subject (gnus-fetch-field "subject"))
-	  (body (if gnus-article-mime-handles
+(body (if gnus-article-mime-handles
-		    ;; We're multipart.  Don't get confused by part
+;; We're multipart.  Don't get confused by part
-		    ;; buttons &c.  Assume info is in first part.
+;; buttons &c.  Assume info is in first part.
-		    (mm-get-part (nth 1 gnus-article-mime-handles))
+(mm-get-part (nth 1 gnus-article-mime-handles))
-		  (save-restriction
+(save-restriction
-		    (gnus-narrow-to-body)
+(gnus-narrow-to-body)
-		    (buffer-string)))))
+(buffer-string)))))
 (when (diary-from-outlook-internal t)
-	(when (or noconfirm (y-or-n-p "Snarf diary entry? "))
+(when (or noconfirm (y-or-n-p "Snarf diary entry? "))
-	  (diary-from-outlook-internal)
+(diary-from-outlook-internal)
-	  (message "Diary entry added"))))))
+(message "Diary entry added"))))))
 (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
 (defvar rmail-buffer)
 this function is called interactively), then if an entry is found the
 user is asked to confirm its addition."
 (interactive "p")
 (with-current-buffer rmail-buffer
 (let ((subject (mail-fetch-field "subject"))
-	  (body (buffer-substring (save-excursion
+(body (buffer-substring (save-excursion
-				    (rfc822-goto-eoh)
+(rfc822-goto-eoh)
-				    (point))
+(point))
-				  (point-max))))
+(point-max))))
 (when (diary-from-outlook-internal t)
-	(when (or noconfirm (y-or-n-p "Snarf diary entry? "))
+(when (or noconfirm (y-or-n-p "Snarf diary entry? "))
-	  (diary-from-outlook-internal)
+(diary-from-outlook-internal)
-	  (message "Diary entry added"))))))
+(message "Diary entry added"))))))
 (provide 'diary-lib)
 ;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010

Mercurial > emacs

comparison lisp/calendar/diary-lib.el @ 92859:15bd5abe194e