* message.el (message-fix-before-sending): Check illegible text.
authorShengHuo ZHU <zsh@cs.rochester.edu>
Fri, 1 Mar 2002 21:36:17 +0000 (21:36 +0000)
committerShengHuo ZHU <zsh@cs.rochester.edu>
Fri, 1 Mar 2002 21:36:17 +0000 (21:36 +0000)
* 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.

lisp/ChangeLog
lisp/gnus-kill.el
lisp/gnus-util.el
lisp/message.el

index cc1fe59..fb28351 100644 (file)
@@ -1,3 +1,12 @@
+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
index b134be9..dd6a774 100644 (file)
@@ -428,16 +428,6 @@ Returns the number of articles marked as read."
        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)
index 47708cd..532ac23 100644 (file)
@@ -1294,6 +1294,58 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
          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
index 1f93738..0361df6 100644 (file)
@@ -2704,7 +2704,42 @@ It should typically alter the sending method in some way or other."
                               '(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."