Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-art.el @ 136:b980b6286996 r20-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b2
author cvs
date Mon, 13 Aug 2007 09:31:12 +0200
parents 9b50b4588a93
children 585fb297b004
comparison
equal deleted inserted replaced
135:4636a6841cd6 136:b980b6286996
409 Article buttons will be displayed in this face when the cursor is 409 Article buttons will be displayed in this face when the cursor is
410 above them." 410 above them."
411 :type 'face 411 :type 'face
412 :group 'gnus-article-buttons) 412 :group 'gnus-article-buttons)
413 413
414 (defcustom gnus-signature-face 'italic 414 (defcustom gnus-signature-face 'gnus-signature-face
415 "Face used for highlighting a signature in the article buffer.
416 Obsolete; use the face `gnus-signature-face' for customizations instead."
417 :type 'face
418 :group 'gnus-article-highlight
419 :group 'gnus-article-signature)
420
421 (defface gnus-signature-face
422 '((((type x))
423 (:italic t)))
415 "Face used for highlighting a signature in the article buffer." 424 "Face used for highlighting a signature in the article buffer."
416 :type 'face
417 :group 'gnus-article-highlight 425 :group 'gnus-article-highlight
418 :group 'gnus-article-signature) 426 :group 'gnus-article-signature)
419 427
420 (defface gnus-header-from-face 428 (defface gnus-header-from-face
421 '((((class color) 429 '((((class color)
824 from) 832 from)
825 (save-restriction 833 (save-restriction
826 (nnheader-narrow-to-headers) 834 (nnheader-narrow-to-headers)
827 (setq from (message-fetch-field "from")) 835 (setq from (message-fetch-field "from"))
828 (goto-char (point-min)) 836 (goto-char (point-min))
829 (when (and gnus-article-x-face-command 837 (while (and gnus-article-x-face-command
830 (or force 838 (or force
831 ;; Check whether this face is censored. 839 ;; Check whether this face is censored.
832 (not gnus-article-x-face-too-ugly) 840 (not gnus-article-x-face-too-ugly)
833 (and gnus-article-x-face-too-ugly from 841 (and gnus-article-x-face-too-ugly from
834 (not (string-match gnus-article-x-face-too-ugly 842 (not (string-match gnus-article-x-face-too-ugly
835 from)))) 843 from))))
836 ;; Has to be present. 844 ;; Has to be present.
837 (re-search-forward "^X-Face: " nil t)) 845 (re-search-forward "^X-Face: " nil t))
838 ;; We now have the area of the buffer where the X-Face is stored. 846 ;; We now have the area of the buffer where the X-Face is stored.
839 (let ((beg (point)) 847 (let ((beg (point))
840 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) 848 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
841 ;; We display the face. 849 (save-excursion
842 (if (symbolp gnus-article-x-face-command) 850 ;; We display the face.
843 ;; The command is a lisp function, so we call it. 851 (if (symbolp gnus-article-x-face-command)
844 (if (gnus-functionp gnus-article-x-face-command) 852 ;; The command is a lisp function, so we call it.
845 (funcall gnus-article-x-face-command beg end) 853 (if (gnus-functionp gnus-article-x-face-command)
846 (error "%s is not a function" gnus-article-x-face-command)) 854 (funcall gnus-article-x-face-command beg end)
847 ;; The command is a string, so we interpret the command 855 (error "%s is not a function" gnus-article-x-face-command))
848 ;; as a, well, command, and fork it off. 856 ;; The command is a string, so we interpret the command
849 (let ((process-connection-type nil)) 857 ;; as a, well, command, and fork it off.
850 (process-kill-without-query 858 (let ((process-connection-type nil))
851 (start-process 859 (process-kill-without-query
852 "article-x-face" nil shell-file-name shell-command-switch 860 (start-process
853 gnus-article-x-face-command)) 861 "article-x-face" nil shell-file-name shell-command-switch
854 (process-send-region "article-x-face" beg end) 862 gnus-article-x-face-command))
855 (process-send-eof "article-x-face"))))))))) 863 (process-send-region "article-x-face" beg end)
864 (process-send-eof "article-x-face"))))))))))
856 865
857 (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) 866 (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
858 (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) 867 (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
859 (defun article-decode-rfc1522 () 868 (defun article-decode-rfc1522 ()
860 "Hack to remove QP encoding from headers." 869 "Hack to remove QP encoding from headers."
1448 (file-name-nondirectory default-name) ") ") 1457 (file-name-nondirectory default-name) ") ")
1449 (file-name-directory default-name) 1458 (file-name-directory default-name)
1450 default-name)) 1459 default-name))
1451 ;; A single split name was found 1460 ;; A single split name was found
1452 ((= 1 (length split-name)) 1461 ((= 1 (length split-name))
1453 (let* ((name (car split-name)) 1462 (let* ((name (expand-file-name
1463 (car split-name) gnus-article-save-directory))
1454 (dir (cond ((file-directory-p name) 1464 (dir (cond ((file-directory-p name)
1455 (file-name-as-directory name)) 1465 (file-name-as-directory name))
1456 ((file-exists-p name) name) 1466 ((file-exists-p name) name)
1457 (t gnus-article-save-directory)))) 1467 (t gnus-article-save-directory))))
1458 (read-file-name 1468 (read-file-name