* gnus-util.el (gnus-multiple-choice): New function.
* gnus-kill.el (gnus-score-insert-help): Removed, because it is
also defined in gnus-score.el.
+2002-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-fix-before-sending): Check illegible text.
+
+ * gnus-util.el (gnus-multiple-choice): New function.
+
+ * gnus-kill.el (gnus-score-insert-help): Removed, because it is
+ also defined in gnus-score.el.
+
2002-03-01 Paul Jarc <prj@po.cwru.edu>
* message.el (message-get-reply-headers): downcase email addresses
0))))
;; Parse a Gnus killfile.
-(defun gnus-score-insert-help (string alist idx)
- (save-excursion
- (pop-to-buffer "*Score Help*")
- (buffer-disable-undo)
- (erase-buffer)
- (insert string ":\n\n")
- (while alist
- (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
- (setq alist (cdr alist)))))
-
(defun gnus-kill-parse-gnus-kill-file ()
(goto-char (point-min))
(gnus-kill-file-mode)
contents)
(nth 2 value))))
+(defun gnus-multiple-choice (prompt choice &optional idx)
+ "Ask user a multiple choice question.
+CHOICE is a list of the choice char and help message at IDX."
+ (let (tchar buf)
+ (save-window-excursion
+ (save-excursion
+ (while (not tchar)
+ (setq tchar
+ (read-char
+ (format "%s (%s?): "
+ prompt
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ choice ""))))
+ (when (not (assq tchar choice))
+ (setq tchar nil)
+ (setq buf (get-buffer-create "*Gnus Help*"))
+ (pop-to-buffer buf)
+ (fundamental-mode) ; for Emacs 20.4+
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert prompt ":\n\n")
+ (let ((max -1)
+ (list choice)
+ (alist choice)
+ (idx (or idx 1))
+ (i 0)
+ n width pad format)
+ ;; find the longest string to display
+ (while list
+ (setq n (length (nth idx (car list))))
+ (unless (> max n)
+ (setq max n))
+ (setq list (cdr list)))
+ (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
+ (setq n (/ (1- (window-width)) max)) ; items per line
+ (setq width (/ (1- (window-width)) n)) ; width of each item
+ ;; insert `n' items, each in a field of width `width'
+ (while alist
+ (if (< i n)
+ ()
+ (setq i 0)
+ (delete-char -1) ; the `\n' takes a char
+ (insert "\n"))
+ (setq pad (- width 3))
+ (setq format (concat "%c: %-" (int-to-string pad) "s"))
+ (insert (format format (caar alist) (nth idx (car alist))))
+ (setq alist (cdr alist))
+ (setq i (1+ i))))))))
+ (if (buffer-live-p buf)
+ (kill-buffer buf))
+ tchar))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
'(invisible nil highlight t)))
(unless (yes-or-no-p
"Invisible text found and made visible; continue posting? ")
- (error "Invisible text found and made visible"))))))
+ (error "Invisible text found and made visible")))))
+ (message-check 'illegible-text
+ (let (found choice)
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (fboundp 'char-charset)
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic)))))
+ (add-text-properties (point) (1+ (point)) '(highlight t))
+ (forward-char)
+ (setq found t))
+ (skip-chars-forward mm-7bit-chars))
+ (when found
+ (setq choice
+ (gnus-multiple-choice
+ "Illegible text found. Continue posting? "
+ '((?d "Remove and continue posting")
+ (?r "Replace with dots and continue posting")
+ (?e "Continue editing"))))
+ (if (eq choice ?e)
+ (error "Illegible text found"))
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (fboundp 'char-charset)
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic)))))
+ (delete-char 1)
+ (if (eq choice ?r)
+ (insert ".")))
+ (skip-chars-forward mm-7bit-chars))))))
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."