emacs: lisp/gnus/gnus-art.el comparison

comparison lisp/gnus/gnus-art.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

author	Juanma Barranquero <lekktu@gmail.com>
date	Tue, 04 Feb 2003 13:24:35 +0000
parents	52d99cc2e9e3
children	629f8ae0c58f d7ddb3e565de

comparison

equal deleted inserted replaced

-:e88404e8f2cf
+:0d8b17d428b5
 :type '(choice regexp (const nil))
 :group 'gnus-article-washing)
 (defcustom gnus-article-banner-alist nil
 "Banner alist for stripping.
 For example,
 ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 :version "21.1"
 :type '(repeat (cons symbol regexp))
 :group 'gnus-article-washing)
 :type 'boolean)
 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
 "Function called with a MIME handle as the argument.
 This is meant for people who want to view first matched part.
 For `undisplayed-alternative' (default), the first undisplayed
 part or alternative part is used.  For `undisplayed', the first
 undisplayed part is used.  For a function, the first part which
 the function return `t' is used.  For `nil', the first part is
 used."
 :version "21.1"
 :group 'gnus-article-mime
 :type '(choice
 	  (item :tag "first" :value nil)
 	  (item :tag "undisplayed" :value undisplayed)
 	  (item :tag "undisplayed or alternative"
 		:value undisplayed-alternative)
 	  (function)))
 (defcustom gnus-mime-action-alist
 '(("save to file" . gnus-mime-save-part)
 See the manual for details."
 :group 'gnus-article-treat
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 (defcustom gnus-treat-emphasize
 (and (or window-system
 	   (featurep 'xemacs)
 	   (>= (string-to-number emacs-version) 21))
 50000)
 "Emphasize text.
 See the manual for details."
 :group 'gnus-article-treat
 :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
 (defcustom gnus-treat-display-xface
 (and (or (and (fboundp 'image-type-available-p)
 		(image-type-available-p 'xbm)
 		(string-match "^0x" (shell-command-to-string "uncompface")))
 	   (and (featurep 'xemacs) (featurep 'xface)))
 'head)
 :group 'gnus-article-treat
 :version "21.1"
 :type gnus-article-treat-head-custom)
 (put 'gnus-treat-display-xface 'highlight t)
 (defcustom gnus-treat-display-smileys
 (if (or (and (featurep 'xemacs)
 	       (featurep 'xpm))
 	  (and (fboundp 'image-type-available-p)
 	       (image-type-available-p 'pbm)))
 t nil)
 (save-excursion
 (set-buffer gnus-article-buffer)
 (let ((inhibit-point-motion-hooks t)
 	  buffer-read-only
 	  (mail-parse-charset gnus-newsgroup-charset)
 	  (mail-parse-ignored-charsets
 	   (save-excursion (set-buffer gnus-summary-buffer)
 			   gnus-newsgroup-ignored-charsets)))
 (mail-decode-encoded-word-region (point-min) (point-max)))))
 (defun article-decode-charset (&optional prompt)
 If PROMPT (the prefix), prompt for a coding system to use."
 (interactive "P")
 (let ((inhibit-point-motion-hooks t) (case-fold-search t)
 	buffer-read-only
 	(mail-parse-charset gnus-newsgroup-charset)
 	(mail-parse-ignored-charsets
 	 (save-excursion (condition-case nil
 			     (set-buffer gnus-summary-buffer)
 			   (error))
 			 gnus-newsgroup-ignored-charsets))
 	ct cte ctl charset format)
 		     (ctl
 		      (mail-content-type-get ctl 'charset)))
 	    format (and ctl (mail-content-type-get ctl 'format)))
 (when cte
 	(setq cte (mail-header-strip cte)))
 (if (and ctl (not (string-match "/" (car ctl))))
 	  (setq ctl nil))
 (goto-char (point-max)))
 (forward-line 1)
 (save-restriction
 (narrow-to-region (point) (point-max))
 (defun article-decode-encoded-words ()
 "Remove encoded-word encoding from headers."
 (let ((inhibit-point-motion-hooks t)
 	(mail-parse-charset gnus-newsgroup-charset)
 	(mail-parse-ignored-charsets
 	 (save-excursion (condition-case nil
 			     (set-buffer gnus-summary-buffer)
 			   (error))
 			 gnus-newsgroup-ignored-charsets))
 	buffer-read-only)
 (if (gnus-buffer-live-p gnus-original-article-buffer)
 	  (with-current-buffer gnus-original-article-buffer
 	    (setq type
 		  (gnus-fetch-field "content-transfer-encoding"))
 	    (let* ((ct (gnus-fetch-field "content-type"))
 		   (ctl (and ct
 			     (ignore-errors
 			       (mail-header-parse-content-type ct)))))
 	      (setq charset (and ctl
 				 (mail-content-type-get ctl 'charset)))
 	      (if (stringp charset)
 		  (setq charset (intern (downcase charset)))))))
 (unless charset
 	(setq charset gnus-newsgroup-charset))
 (when (or force
 		(and type (let ((case-fold-search t))
 			    (string-match "quoted-printable" type))))
 	(article-goto-body)
 (if (gnus-buffer-live-p gnus-original-article-buffer)
 	  (with-current-buffer gnus-original-article-buffer
 	    (setq type
 		  (gnus-fetch-field "content-transfer-encoding"))
 	    (let* ((ct (gnus-fetch-field "content-type"))
 		   (ctl (and ct
 			     (ignore-errors
 			       (mail-header-parse-content-type ct)))))
 	      (setq charset (and ctl
 				 (mail-content-type-get ctl 'charset)))
 	      (if (stringp charset)
 		  (setq charset (intern (downcase charset)))))))
 (unless charset
 	(setq charset gnus-newsgroup-charset))
 (when (or force
 		(and type (let ((case-fold-search t))
 			    (string-match "base64" type))))
 	(article-goto-body)
 (let ((buffer-read-only nil)
 	  charset)
 (if (gnus-buffer-live-p gnus-original-article-buffer)
 	  (with-current-buffer gnus-original-article-buffer
 	    (let* ((ct (gnus-fetch-field "content-type"))
 		   (ctl (and ct
 			     (ignore-errors
 			       (mail-header-parse-content-type ct)))))
 	      (setq charset (and ctl
 				 (mail-content-type-get ctl 'charset)))
 	      (if (stringp charset)
 		  (setq charset (intern (downcase charset)))))))
 (unless charset
 	(setq charset gnus-newsgroup-charset))
 (article-goto-body)
 (save-window-excursion
 	(save-restriction
 	  (narrow-to-region (point) (point-max))
 	(let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers
 			(mapconcat 'identity gnus-list-identifiers " *\\|"))))
 	  (when regexp
 	    (goto-char (point-min))
 	    (when (re-search-forward
 		   (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp
 			   " *\\)\\)+\\(Re: +\\)?\\)")
 		   nil t)
 	      (let ((s (or (match-string 3) (match-string 5))))
 		(delete-region (match-beginning 1) (match-end 1))
 		(when s
 (defun gnus-article-show-hidden-text (type &optional dummy)
 "Show all hidden text of type TYPE.
 Originally it is hide instead of DUMMY."
 (let ((buffer-read-only nil)
 	(inhibit-point-motion-hooks t))
 (gnus-remove-text-properties-when
 'article-type type
 (point-min) (point-max)
 (cons 'article-type (cons type
 			       gnus-hidden-properties)))))
 (defconst article-time-units
 `((year . ,(* 365.25 24 60 60))
 ;; functions since they aren't particularly resistant to
 ;; buggy dates.
 ((eq type 'local)
 (let ((tz (car (current-time-zone time))))
 	(format "Date: %s %s%02d%02d" (current-time-string time)
 		(if (> tz 0) "+" "-") (/ (abs tz) 3600)
 		(/ (% (abs tz) 3600) 60))))
 ;; Convert to Universal Time.
 ((eq type 'ut)
 (concat "Date: "
 	      (current-time-string
 (let ((tz (car (current-time-zone time))))
 	(concat
 	 "Date: "
 	 (format-time-string "%Y%m%dT%H%M%S" time)
 	 (format "%s%02d%02d"
 		 (if (> tz 0) "+" "-") (/ (abs tz) 3600)
 		 (/ (% (abs tz) 3600) 60)))))
 ;; 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.
 (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 (or
 		    (condition-case nil
 			(with-current-buffer gnus-summary-buffer
 			  gnus-article-emphasis-alist)
 		      (error))
 		    gnus-emphasis-alist))
 	    (buffer-read-only nil)
 	    (props (append '(article-type emphasis)
 			   gnus-hidden-properties))
 "Setup newsgroup emphasis alist."
 (unless gnus-article-emphasis-alist
 (let ((name (and gnus-newsgroup-name
 		     (gnus-group-real-name gnus-newsgroup-name))))
 (make-local-variable 'gnus-article-emphasis-alist)
 (setq gnus-article-emphasis-alist
 	    (nconc
 	     (let ((alist gnus-group-highlight-words-alist) elem highlight)
 	       (while (setq elem (pop alist))
 		 (when (and name (string-match (car elem) name))
 		   (setq alist nil
 			 highlight (copy-sequence (cdr elem)))))
 	       highlight)
 	     (copy-sequence highlight-words)
 	     (if gnus-newsgroup-name
 		 (copy-sequence (gnus-group-find-parameter
 				 gnus-newsgroup-name 'highlight-words t)))
 	     gnus-emphasis-alist)))))
 (eval-when-compile
 (defvar gnus-summary-article-menu)
 					function group headers variable)
 (let ((default-name
 	  (funcall function group headers (symbol-value variable)))
 	result)
 (setq result
 	  (expand-file-name
 	   (cond
 	    ((eq filename 'default)
 	     default-name)
 	    ((eq filename t)
 	     default-name)
 ["Decode HZ" gnus-article-decode-HZ t]))
 ;; Note "Commands" menu is defined in gnus-sum.el for consistency
 (when (boundp 'gnus-summary-post-menu)
 (cond
 ((not (keymapp gnus-summary-post-menu))
 	(setq gnus-article-post-menu gnus-summary-post-menu))
 ((not gnus-article-post-menu)
 	;; Don't share post menu.
 	(setq gnus-article-post-menu
 	  (set-buffer name)
 	  (when gnus-article-mime-handles
 	    (mm-destroy-parts gnus-article-mime-handles)
 	    (setq gnus-article-mime-handles nil))
 	  ;; Set it to nil in article-buffer!
 	  (setq gnus-article-mime-handle-alist nil)
 	  (buffer-disable-undo)
 	  (setq buffer-read-only t)
 	  (unless (eq major-mode 'gnus-article-mode)
 	    (gnus-article-mode))
 	  (current-buffer))
 (interactive)
 (save-current-buffer
 (set-buffer gnus-article-buffer)
 (let ((handles (or handles gnus-article-mime-handles))
 	  (mail-parse-charset gnus-newsgroup-charset)
 	  (mail-parse-ignored-charsets
 	   (save-excursion (set-buffer gnus-summary-buffer)
 			   gnus-newsgroup-ignored-charsets)))
 (if (stringp (car handles))
 	  (gnus-mime-view-all-parts (cdr handles))
 	(mapcar 'mm-display-part handles)))))
 	(setq charset (or (mail-content-type-get
 			   (mm-handle-type handle) 'charset)
 			  gnus-newsgroup-charset)))
 ((numberp arg)
 	(setq charset
 	      (or (cdr (assq arg
 			     gnus-summary-show-article-charset-alist))
 		  (read-coding-system "Charset: ")))))
 (forward-line 2)
 (mm-insert-inline handle
 			(if (and charset
 				 (setq charset (mm-charset-to-coding-system
 						charset))
 				 (not (eq charset 'ascii)))
 			    (mm-decode-coding-string contents charset)
 			  contents))
 (goto-char b))))
 (gnus-article-check-buffer)
 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
 	 (mm-user-display-methods nil)
 	 (mm-inlined-types nil)
 	 (mail-parse-charset gnus-newsgroup-charset)
 	 (mail-parse-ignored-charsets
 	  (save-excursion (set-buffer gnus-summary-buffer)
 			  gnus-newsgroup-ignored-charsets)))
 (if (mm-handle-undisplayer handle)
 	(mm-remove-part handle)
 (mm-display-part handle))))
 (gnus-article-check-buffer)
 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
 	 (mm-inlined-types '(".*"))
 	 (mm-inline-large-images t)
 	 (mail-parse-charset gnus-newsgroup-charset)
 	 (mail-parse-ignored-charsets
 	  (save-excursion (set-buffer gnus-summary-buffer)
 			  gnus-newsgroup-ignored-charsets)))
 (if (mm-handle-undisplayer handle)
 	(mm-remove-part handle)
 (mm-display-part handle))))
 (defun gnus-article-mime-match-handle-first (condition)
 (if condition
 (let ((alist gnus-article-mime-handle-alist) ihandle n)
 	(while (setq ihandle (pop alist))
 	  (if (and (cond
 		    ((functionp condition)
 		     (funcall condition (cdr ihandle)))
 		    ((eq condition 'undisplayed)
 		     (not (or (mm-handle-undisplayer (cdr ihandle))
 			      (equal (mm-handle-media-type (cdr ihandle))
 				     "multipart/alternative"))))
 		    ((eq condition 'undisplayed-alternative)
 		     (not (mm-handle-undisplayer (cdr ihandle))))
 (defun gnus-article-view-part (&optional n)
 "View MIME part N, which is the numerical prefix."
 (interactive "P")
 (save-current-buffer
 (set-buffer gnus-article-buffer)
 (or (numberp n) (setq n (gnus-article-mime-match-handle-first
 			     gnus-article-mime-match-handle-function)))
 (when (> n (length gnus-article-mime-handle-alist))
 (error "No such part"))
 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
 (when (gnus-article-goto-part n)
 	buffer-read-only)
 (forward-line 1)
 (prog1
 	(let ((window (selected-window))
 	      (mail-parse-charset gnus-newsgroup-charset)
 	      (mail-parse-ignored-charsets
 	       (save-excursion (set-buffer gnus-summary-buffer)
 			       gnus-newsgroup-ignored-charsets)))
 	  (save-excursion
 	    (unwind-protect
 		(let ((win (get-buffer-window (current-buffer) t))
 	   (display
 	    (when move
 	      (forward-line -2)
 	      (setq beg (point)))
 	    (let ((mail-parse-charset gnus-newsgroup-charset)
 		  (mail-parse-ignored-charsets
 		   (save-excursion (condition-case ()
 				       (set-buffer gnus-summary-buffer)
 				     (error))
 				   gnus-newsgroup-ignored-charsets)))
 	      (mm-display-part handle t))
 	  ;; Do highlighting.
 	  (save-excursion
 	    (save-restriction
 	      (narrow-to-region beg (point))
 	      (gnus-treat-article
 	       nil id
 	       (gnus-article-mime-total-parts)
 	       (mm-handle-media-type handle)))))))))
 (defun gnus-unbuttonized-mime-type-p (type)
 "Say whether TYPE is to be unbuttonized."
 	  (insert "\n\n"))
 	(when preferred
 	  (if (stringp (car preferred))
 	      (gnus-display-mime preferred)
 	    (let ((mail-parse-charset gnus-newsgroup-charset)
 		  (mail-parse-ignored-charsets
 		   (save-excursion (set-buffer gnus-summary-buffer)
 				   gnus-newsgroup-ignored-charsets)))
 	      (mm-display-part preferred)
 	      ;; Do highlighting.
 	      (save-excursion
 (let (gnus-pick-mode)
 (push (or key last-command-event) unread-command-events)
 (setq keys (if (featurep 'xemacs)
 		       (events-to-keys (read-key-sequence nil))
 		     (read-key-sequence nil)))))
 (message "")
 (if (or (member keys nosaves)
 (member keys nosave-but-article)
 (member keys nosave-in-article))
 	    'article)
 	   ;; Get the article and put into the article buffer.
 	   ((or (stringp article)
 		(numberp article))
 	    (let ((gnus-override-method gnus-override-method)
 		  (methods (and (stringp article)
 				gnus-refer-article-method))
 		  result
 		  (buffer-read-only nil))
 	      (if (or (not (listp methods))
 		      (and (symbolp (car methods))
 		(gnus-kill-all-overlays)
 		(let ((gnus-newsgroup-name group))
 		  (gnus-check-group-server))
 		(when (gnus-request-article article group (current-buffer))
 		  (when (numberp article)
 		    (gnus-async-prefetch-next group article
 					      gnus-summary-buffer)
 		    (when gnus-keep-backlog
 		      (gnus-backlog-enter-article
 		       group article (current-buffer))))
 		  (setq result 'article))
 ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
 ;;; Internal Variables:
 (defcustom gnus-button-url-regexp
 (if (string-match "[[:digit:]]" "1") ;; support POSIX?
 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-zA-Z0-9_=#$@~`%&*+|\\/[:word:]]\\)"
 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)")
 "Regular expression that matches URLs."
 :group 'gnus-article-buttons

Mercurial > emacs

comparison lisp/gnus/gnus-art.el @ 49598:0d8b17d428b5