+(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
+(defun article-decode-rfc1522 ()
+ "Hack to remove QP encoding from headers."
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ (buffer-read-only nil)
+ string)
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
+ (setq string (match-string 1))
+ (save-restriction
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (article-mime-decode-quoted-printable
+ (goto-char (point-min)) (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (goto-char (point-max)))
+ (goto-char (point-min))))))
+
+(defun article-de-quoted-unreadable (&optional force)
+ "Do a naive translation of a quoted-printable-encoded article.
+This is in no way, shape or form meant as a replacement for real MIME
+processing, but is simply a stop-gap measure until MIME support is
+written.
+If FORCE, decode the article whether it is marked as quoted-printable
+or not."
+ (interactive (list 'force))
+ (save-excursion
+ (let ((case-fold-search t)
+ (buffer-read-only nil)
+ (type (gnus-fetch-field "content-transfer-encoding")))
+ (gnus-article-decode-rfc1522)
+ (when (or force
+ (and type (string-match "quoted-printable" (downcase type))))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (article-mime-decode-quoted-printable (point) (point-max))))))
+
+(defun article-mime-decode-quoted-printable-buffer ()
+ "Decode Quoted-Printable in the current buffer."
+ (article-mime-decode-quoted-printable (point-min) (point-max)))
+
+(defun article-mime-decode-quoted-printable (from to)
+ "Decode Quoted-Printable in the region between FROM and TO."
+ (interactive "r")
+ (goto-char from)
+ (while (search-forward "=" to t)
+ (cond ((eq (following-char) ?\n)
+ (delete-char -1)
+ (delete-char 1))
+ ((looking-at "[0-9A-F][0-9A-F]")
+ (subst-char-in-region
+ (1- (point)) (point) ?=
+ (hexl-hex-string-to-integer
+ (buffer-substring (point) (+ 2 (point)))))
+ (delete-char 2))
+ ((looking-at "=")
+ (delete-char 1))
+ ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+
+(defun article-hide-pgp (&optional arg)
+ "Toggle hiding of any PGP headers and signatures in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'pgp arg)
+ (save-excursion
+ (let (buffer-read-only beg end)
+ (widen)
+ (goto-char (point-min))
+ ;; Hide the "header".
+ (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
+ (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
+ (setq beg (point))
+ ;; Hide the actual signature.
+ (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-article-hide-text-type
+ end
+ (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
+ (match-end 0)
+ ;; Perhaps we shouldn't hide to the end of the buffer
+ ;; if there is no end to the signature?
+ (point-max))
+ 'pgp))
+ ;; Hide "- " PGP quotation markers.
+ (when (and beg end)
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "^- " nil t)
+ (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
+ (widen))))))
+
+(defun article-hide-pem (&optional arg)
+ "Toggle hiding of any PEM headers and signatures in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'pem arg)
+ (save-excursion
+ (let (buffer-read-only end)
+ (widen)
+ (goto-char (point-min))
+ ;; hide the horrendously ugly "header".
+ (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-article-hide-text-type
+ end
+ (if (search-forward "\n\n" nil t)
+ (match-end 0)
+ (point-max))
+ 'pem))
+ ;; hide the trailer as well
+ (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (gnus-article-hide-text-type
+ (match-beginning 0) (match-end 0) 'pem))))))
+
+(defun article-hide-signature (&optional arg)
+ "Hide the signature in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'signature arg)
+ (save-excursion
+ (save-restriction
+ (let ((buffer-read-only nil))
+ (when (gnus-article-narrow-to-signature)
+ (gnus-article-hide-text-type
+ (point-min) (point-max) 'signature)))))))
+
+(defun article-strip-leading-blank-lines ()
+ "Remove all blank lines from the beginning of the article."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (while (and (not (eobp))
+ (looking-at "[ \t]*$"))
+ (gnus-delete-line))))))
+
+(defun article-strip-multiple-blank-lines ()
+ "Replace consecutive blank lines with one empty line."
+ (interactive)
+ (save-excursion
+ (let (buffer-read-only)
+ ;; First make all blank lines empty.
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]+$" nil t)
+ (replace-match "" nil t))
+ ;; Then replace multiple empty lines with a single empty line.
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n\n+" nil t)
+ (replace-match "\n\n" t t)))))
+
+(defun article-strip-blank-lines ()
+ "Strip leading, trailing and multiple blank lines."
+ (interactive)
+ (article-strip-leading-blank-lines)
+ (article-remove-trailing-blank-lines)
+ (article-strip-multiple-blank-lines))
+
+(defvar mime::preview/content-list)
+(defvar mime::preview-content-info/point-min)
+(defun gnus-article-narrow-to-signature ()
+ "Narrow to the signature; return t if a signature is found, else nil."
+ (widen)
+ (when (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ ;; We have a MIMEish article, so we use the MIME data to narrow.
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (ignore-errors
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max)))))
+
+ (when (gnus-article-search-signature)
+ (forward-line 1)
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (gnus-functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
+
+(defun gnus-article-search-signature ()
+ "Search the current buffer for the signature separator.
+Put point at the beginning of the signature separator."
+ (let ((cur (point)))
+ (goto-char (point-max))
+ (if (if (stringp gnus-signature-separator)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((seps gnus-signature-separator))
+ (while (and seps
+ (not (re-search-backward (car seps) nil t)))
+ (pop seps))
+ seps))
+ t
+ (goto-char cur)
+ nil)))
+
+(defun gnus-article-hidden-arg ()
+ "Return the current prefix arg as a number, or 0 if no prefix."
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 0)))
+
+(defun gnus-article-check-hidden-text (type arg)
+ "Return nil if hiding is necessary.
+Arg can be nil or a number. Nil and positive means hide, negative
+means show, 0 means toggle."
+ (save-excursion
+ (let ((hide (gnus-article-hidden-text-p type)))
+ (cond
+ ((or (null arg)
+ (> arg 0))
+ nil)
+ ((< arg 0)
+ (gnus-article-show-hidden-text type))
+ (t
+ (if (eq hide 'hidden)
+ (gnus-article-show-hidden-text type)
+ nil))))))
+
+(defun gnus-article-hidden-text-p (type)
+ "Say whether the current buffer contains hidden text of type TYPE."
+ (let ((pos (text-property-any (point-min) (point-max) 'article-type type)))
+ (when pos
+ (if (get-text-property pos 'invisible)
+ 'hidden
+ 'shown))))
+
+(defun gnus-article-show-hidden-text (type &optional hide)
+ "Show all hidden text of type TYPE.
+If HIDE, hide the text instead."
+ (save-excursion
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (end (point-min))
+ beg)
+ (while (setq beg (text-property-any end (point-max) 'article-type type))
+ (goto-char beg)
+ (setq end (or
+ (text-property-not-all beg (point-max) 'article-type type)
+ (point-max)))
+ (if hide
+ (gnus-article-hide-text beg end gnus-hidden-properties)
+ (gnus-article-unhide-text beg end))
+ (goto-char end))
+ t)))
+
+(defconst article-time-units
+ `((year . ,(* 365.25 24 60 60))
+ (week . ,(* 7 24 60 60))
+ (day . ,(* 24 60 60))
+ (hour . ,(* 60 60))
+ (minute . 60)
+ (second . 1))
+ "Mapping from time units to seconds.")
+
+(defun article-date-ut (&optional type highlight header)
+ "Convert DATE date to universal time in the current article.
+If TYPE is `local', convert to local time; if it is `lapsed', output
+how much time has lapsed since DATE."
+ (interactive (list 'ut t))
+ (let* ((header (or header
+ (mail-header-date gnus-current-headers)
+ (message-fetch-field "date")
+ ""))
+ (date (if (vectorp header) (mail-header-date header)
+ header))
+ (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
+ (inhibit-point-motion-hooks t)
+ bface eface)
+ (when (and date (not (string= date "")))
+ (save-excursion
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (let ((buffer-read-only nil))
+ ;; Delete any old Date headers.
+ (if (re-search-forward date-regexp nil t)
+ (progn
+ (setq bface (get-text-property (gnus-point-at-bol) 'face)
+ eface (get-text-property (1- (gnus-point-at-eol))
+ 'face))
+ (message-remove-header date-regexp t)
+ (beginning-of-line))
+ (goto-char (point-max)))
+ (insert (article-make-date-line date type))
+ ;; Do highlighting.
+ (forward-line -1)
+ (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face bface)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'face eface))))))))
+
+(defun article-make-date-line (date type)
+ "Return a DATE line of TYPE."
+ (cond
+ ;; Convert to the local timezone. We have to slap a
+ ;; `condition-case' round the calls to the timezone
+ ;; functions since they aren't particularly resistant to
+ ;; buggy dates.
+ ((eq type 'local)
+ (concat "Date: " (condition-case ()
+ (timezone-make-date-arpa-standard date)
+ (error date))
+ "\n"))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (condition-case ()
+ (timezone-make-date-arpa-standard date nil "UT")
+ (error date))
+ "\n"))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " date "\n"))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
+ (let* ((now (current-time))
+ (real-time
+ (ignore-errors
+ (gnus-time-minus
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ (current-time-string now)
+ (current-time-zone now) "UT"))
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
+ num prev)
+ (cond
+ ((null real-time)
+ "X-Sent: Unknown\n")
+ ((zerop sec)
+ "X-Sent: Now\n")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago\n"
+ " in the future\n"))))))
+ (t
+ (error "Unknown conversion type: %s" type))))
+
+(defun article-date-local (&optional highlight)
+ "Convert the current article date to the local timezone."
+ (interactive (list t))
+ (article-date-ut 'local highlight))
+
+(defun article-date-original (&optional highlight)
+ "Convert the current article date to what it was originally.
+This is only useful if you have used some other date conversion
+function and want to see what the date was before converting."
+ (interactive (list t))
+ (article-date-ut 'original highlight))
+
+(defun article-date-lapsed (&optional highlight)
+ "Convert the current article date to time lapsed since it was sent."
+ (interactive (list t))
+ (article-date-ut 'lapsed highlight))
+
+(defun article-show-all ()
+ "Show all hidden text in the article buffer."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (gnus-article-unhide-text (point-min) (point-max)))))
+
+(defun article-emphasize (&optional arg)
+ "Emphasize text according to `gnus-emphasis-alist'."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'emphasis arg)
+ (save-excursion
+ (let ((alist gnus-emphasis-alist)
+ (buffer-read-only nil)
+ (props (append '(gnus-article-type emphasis)
+ gnus-hidden-properties))
+ regexp elem beg invisible visible face)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (setq beg (point))
+ (while (setq elem (pop alist))
+ (goto-char beg)
+ (setq regexp (car elem)
+ invisible (nth 1 elem)
+ visible (nth 2 elem)
+ face (nth 3 elem))
+ (while (re-search-forward regexp nil t)
+ (when (and (match-beginning visible) (match-beginning invisible))
+ (gnus-article-hide-text
+ (match-beginning invisible) (match-end invisible) props)
+ (gnus-article-unhide-text-type
+ (match-beginning visible) (match-end visible) 'emphasis)
+ (gnus-put-text-property-excluding-newlines
+ (match-beginning visible) (match-end visible) 'face face)
+ (goto-char (match-end invisible)))))))))
+
+(defvar gnus-summary-article-menu)
+(defvar gnus-summary-post-menu)