xemacs-beta: lisp/gnus/message.el comparison

comparison lisp/gnus/message.el @ 24:4103f0995bd7 r19-15b95

Import from CVS: tag r19-15b95

author	cvs
date	Mon, 13 Aug 2007 08:51:03 +0200
parents	8fc7fe29b841
children	1917ad0d78d7

comparison

equal deleted inserted replaced

-:0edd3412f124
+:4103f0995bd7
 "Alist used for formatting headers.")
 (eval-and-compile
 (autoload 'message-setup-toolbar "messagexmas")
 (autoload 'mh-send-letter "mh-comp")
+(autoload 'gnus-point-at-eol "gnus-util")
+(autoload 'gnus-point-at-bol "gnus-util")
 (autoload 'gnus-output-to-mail "gnus-util")
 (autoload 'gnus-output-to-rmail "gnus-util"))
 ;;;
 ;;; Utility functions.
 ;;;
-(defun message-point-at-bol ()
-"Return point at the beginning of the line."
-(let ((p (point)))
-(beginning-of-line)
-(prog1
-	(point)
-(goto-char p))))
-(defun message-point-at-eol ()
-"Return point at the end of the line."
-(let ((p (point)))
-(end-of-line)
-(prog1
-	(point)
-(goto-char p))))
 (defmacro message-y-or-n-p (question show &rest text)
 "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
 `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
 (unless (or (zerop n)			; no action needed for a rot of 0
 	      (= b e))			; no region to rotate
 ;; We build the table, if necessary.
 (when (or (not message-caesar-translation-table)
 	      (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
-(let ((i -1)
+	(setq message-caesar-translation-table
-	    (table (make-string 256 0)))
+	      (message-make-caesar-translation-table n)))
-	(while (< (incf i) 256)
-	  (aset table i i))
-	(setq table
-	      (concat
-	       (substring table 0 ?A)
-	       (substring table (+ ?A n) (+ ?A n (- 26 n)))
-	       (substring table ?A (+ ?A n))
-	       (substring table (+ ?A 26) ?a)
-	       (substring table (+ ?a n) (+ ?a n (- 26 n)))
-	       (substring table ?a (+ ?a n))
-	       (substring table (+ ?a 26) 255)))
-	(setq message-caesar-translation-table table)))
 ;; Then we translate the region.  Do it this way to retain
 ;; text properties.
 (while (< b e)
 (subst-char-in-region
 b (1+ b) (char-after b)
 (aref message-caesar-translation-table (char-after b)))
 (incf b))))
+(defun message-make-caesar-translation-table (n)
+"Create a rot table with offset N."
+(let ((i -1)
+	(table (make-string 256 0)))
+(while (< (incf i) 256)
+(aset table i i))
+(concat
+(substring table 0 ?A)
+(substring table (+ ?A n) (+ ?A n (- 26 n)))
+(substring table ?A (+ ?A n))
+(substring table (+ ?A 26) ?a)
+(substring table (+ ?a n) (+ ?a n (- 26 n)))
+(substring table ?a (+ ?a n))
+(substring table (+ ?a 26) 255))))
 (defun message-caesar-buffer-body (&optional rotnum)
 "Caesar rotates all letters in the current buffer by 13 places.
 Used to encode/decode possibly offensive messages (commonly in net.jokes).
 With prefix arg, specifies the number of places to rotate each letter forward.
 		    (goto-char (point-max))
 		    (insert (symbol-name header) ": " value "\n")
 		    (forward-line -1))
 		;; The value of this header was empty, so we clear
 		;; totally and insert the new value.
-		(delete-region (point) (message-point-at-eol))
+		(delete-region (point) (gnus-point-at-eol))
 		(insert value))
 	      ;; Add the deletable property to the headers that require it.
 	      (and (memq header message-deletable-headers)
 		   (progn (beginning-of-line) (looking-at "[^:]+: "))
 		   (add-text-properties
 (let ((cur (current-buffer))
 	from subject date reply-to mct
 	references message-id follow-to
 	(inhibit-point-motion-hooks t)
 	(message-this-is-news t)
-	followup-to distribution newsgroups gnus-warning)
+	followup-to distribution newsgroups gnus-warning posted-to)
 (save-restriction
 (narrow-to-region
 (goto-char (point-min))
 (if (search-forward "\n\n" nil t)
 	   (1- (point))
 	    subject (or (message-fetch-field "subject") "none")
 	    references (message-fetch-field "references")
 	    message-id (message-fetch-field "message-id" t)
 	    followup-to (message-fetch-field "followup-to")
 	    newsgroups (message-fetch-field "newsgroups")
+	    posted-to (message-fetch-field "posted-to")
 	    reply-to (message-fetch-field "reply-to")
 	    distribution (message-fetch-field "distribution")
 	    mct (message-fetch-field "mail-copies-to"))
 (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
 		 (string-match "<[^>]+>" gnus-warning))
 `Followup-To: poster' sends your response via e-mail instead of news.
 A typical situation where `Followup-To: poster' is used is when the poster
 does not read the newsgroup, so he wouldn't see any replies sent to it."))
-		  (cons 'To (or reply-to from ""))
+		  (progn
+		    (setq message-this-is-news nil)
+		    (cons 'To (or reply-to from "")))
 		(cons 'Newsgroups newsgroups)))
 	     (t
 	      (if (or (equal followup-to newsgroups)
 		      (not (eq message-use-followup-to 'ask))
 		      (message-y-or-n-p
 Also, some source/announcement newsgroups are not indented for discussion;
 responses here are directed to other newsgroups."))
 		  (cons 'Newsgroups followup-to)
 		(cons 'Newsgroups newsgroups))))))
+	  (posted-to
+	   `((Newsgroups . ,posted-to)))
 	  (t
 	   `((Newsgroups . ,newsgroups))))
 ,@(and distribution (list (cons 'Distribution distribution)))
 ,@(if (or references message-id)
 	     `((References . ,(concat (or references "") (and references " ")

Mercurial > hg > xemacs-beta

comparison lisp/gnus/message.el @ 24:4103f0995bd7 r19-15b95