Function: gnus-diary-check-message

gnus-diary-check-message is an interactive and byte-compiled function defined in gnus-diary.el.gz.

Signature

(gnus-diary-check-message ARG)

Documentation

Ensure that the current message is a valid for NNDiary.

This function checks that all NNDiary required headers are present and valid, and prompts for values / correction otherwise.

If ARG (or prefix) is non-nil, force prompting for all fields.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-diary.el.gz
(defun gnus-diary-check-message (arg)
  "Ensure that the current message is a valid for NNDiary.
This function checks that all NNDiary required headers are present and
valid, and prompts for values / correction otherwise.

If ARG (or prefix) is non-nil, force prompting for all fields."
  (interactive "P" gnus-summary-mode)
  (save-excursion
    (mapcar
     (lambda (head)
       (let ((header (concat "X-Diary-" (car head)))
	     (ask arg)
	     value invalid)
	 ;; First, try to find the header, and checks for validity:
	 (save-restriction
	   (gnus-diary-narrow-to-headers)
	   (when (re-search-forward (concat "^" header ":") nil t)
	     (unless (eq (char-after) ? )
	       (insert " "))
             (setq value (buffer-substring (point) (line-end-position)))
	     (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
		  (setq value (match-string 1 value)))
	     (condition-case ()
		 (nndiary-parse-schedule-value value
					       (nth 1 head) (nth 2 head))
	       (error
		(setq invalid t)))
	     ;; #### NOTE: this (along with the `gnus-diary-add-header'
	     ;; function) could be rewritten in a better way, in particular
	     ;; not to blindly remove an already present header and reinsert
	     ;; it somewhere else afterwards.
	     (when (or ask invalid)
	       (gnus-diary-kill-entire-line))
	     ))
	 ;; Now, loop until a valid value is provided:
	 (while (or ask (not value) invalid)
	   (let ((prompt (concat (and invalid
				      (prog1 "(current value invalid) "
					(beep)))
				 header ": ")))
	     (setq value
		   (if (listp (nth 1 head))
		       (gnus-completing-read prompt (cons "*" (mapcar #'car (nth 1 head)))
                                             t value
                                             'gnus-diary-header-value-history)
		     (read-string prompt value
				  'gnus-diary-header-value-history))))
	   (setq ask nil)
	   (setq invalid nil)
	   (condition-case ()
	       (nndiary-parse-schedule-value value
					     (nth 1 head) (nth 2 head))
	     (error
	      (setq invalid t))))
	 (gnus-diary-add-header (concat header ": " value))
	 ))
     nndiary-headers)
    ))