2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
[gnus] / lisp / gnus-art.el
index c6894a6..b397412 100644 (file)
@@ -280,23 +280,23 @@ directly.")
 
 (defcustom gnus-emphasis-alist
   (let ((format
-        "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
+        "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
        (types
-        '(("_" "_" underline)
+        '(("\\*" "\\*" bold)
+          ("_" "_" underline)
           ("/" "/" italic)
-          ("\\*" "\\*" bold)
           ("_/" "/_" underline-italic)
           ("_\\*" "\\*_" underline-bold)
           ("\\*/" "/\\*" bold-italic)
           ("_\\*/" "/\\*_" underline-bold-italic))))
-    `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
-       2 3 gnus-emphasis-underline)
-      ,@(mapcar
+    `(,@(mapcar
         (lambda (spec)
           (list
            (format format (car spec) (cadr spec))
            2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
-        types)))
+        types)
+       ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+        2 3 gnus-emphasis-underline)))
   "*Alist that says how to fontify certain phrases.
 Each item looks like this:
 
@@ -704,6 +704,21 @@ be controlled by `gnus-treat-body-boundary'."
   :type '(choice (item :tag "None" :value nil)
                 string))
 
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+  "*Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html"
+  :type 'directory
+  :group 'gnus-picon)
+
+(defun gnus-picons-installed-p ()
+  "Say whether picons are installed on your machine."
+  (let ((installed nil))
+    (dolist (database gnus-picon-databases)
+      (when (file-exists-p database)
+       (setq installed t)))
+    installed))
+
 (defcustom gnus-article-mime-part-function nil
   "Function called with a MIME handle as the argument.
 This is meant for people who want to do something automatic based
@@ -1079,7 +1094,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-display-smileys 'highlight t)
 
 (defcustom gnus-treat-from-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in the From header.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1090,7 +1106,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-from-picon 'highlight t)
 
 (defcustom gnus-treat-mail-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in To and Cc headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1101,7 +1118,8 @@ See Info node `(gnus)Customizing Articles' and Info node
 (put 'gnus-treat-mail-picon 'highlight t)
 
 (defcustom gnus-treat-newsgroups-picon
-  (if (gnus-image-type-available-p 'xpm)
+  (if (and (gnus-image-type-available-p 'xpm)
+          (gnus-picons-installed-p))
       'head nil)
   "Display picons in the Newsgroups and Followup-To headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1174,6 +1192,12 @@ It is a string, such as \"PGP\". If nil, ask user."
   :type 'string
   :group 'mime-security)
 
+(defcustom gnus-article-wash-function 'gnus-article-wash-html-with-w3
+  "Function used for converting HTML into text."
+  :type '(radio (function-item gnus-article-wash-html-with-w3)
+               (function-item gnus-article-wash-html-with-w3m))
+  :group 'gnus-article)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
@@ -1667,7 +1691,7 @@ unfolded."
        (goto-char (point-max))))))
 
 (defun gnus-treat-smiley ()
-  "Display textual emoticons (\"smileys\") as small graphical icons."
+  "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
   (interactive)
   (gnus-with-article-buffer
     (if (memq 'smiley gnus-article-wash-types)
@@ -2045,15 +2069,24 @@ If READ-CHARSET, ask for a coding system."
       (save-window-excursion
        (save-restriction
          (narrow-to-region (point) (point-max))
-         (mm-setup-w3)
-         (let ((w3-strict-width (window-width))
-               (url-standalone-mode t)
-               (w3-honor-stylesheets nil)
-               (w3-delay-image-loads t))
-           (condition-case var
-               (w3-region (point-min) (point-max))
-             (error))))))))
-
+         (funcall gnus-article-wash-function))))))
+
+(defun gnus-article-wash-html-with-w3 ()
+  "Wash the current buffer with w3."
+  (mm-setup-w3)
+  (let ((w3-strict-width (window-width))
+       (url-standalone-mode t)
+       (w3-honor-stylesheets nil)
+       (w3-delay-image-loads t))
+    (condition-case var
+       (w3-region (point-min) (point-max))
+      (error))))
+
+(defun gnus-article-wash-html-with-w3m ()
+  "Wash the current buffer with w3m."
+  (shell-command-on-region
+   (point) (point-max) "w3m -T text/html" t t))
+  
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
 The `gnus-list-identifiers' variable specifies what to do."
@@ -2638,12 +2671,12 @@ This format is defined by the `gnus-article-time-format' variable."
   (interactive (list t))
   (article-date-ut 'iso8601 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-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-remove-leading-whitespace ()
   "Remove excessive whitespace from all headers."
@@ -3151,7 +3184,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-emphasize
      article-treat-dumbquotes
      article-normalize-headers
-     (article-show-all . gnus-article-show-all-headers))))
+;;     (article-show-all . gnus-article-show-all-headers)
+     )))
 \f
 ;;;
 ;;; Gnus article mode
@@ -3916,8 +3950,11 @@ If no internal viewer is available, use an external viewer."
        (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)))
+              (if (gnus-buffer-live-p gnus-summary-buffer)
+                  (save-excursion
+                    (set-buffer gnus-summary-buffer)
+                    gnus-newsgroup-ignored-charsets)
+                nil)))
          (save-excursion
            (unwind-protect
                (let ((win (gnus-get-buffer-window (current-buffer) t))
@@ -4354,7 +4391,7 @@ is the string to use when it is inactive.")
 
 (defun gnus-add-wash-type (type)
   "Add a washing of TYPE to the current status."
-  (push type gnus-article-wash-types))
+  (add-to-list 'gnus-article-wash-types type))
 
 (defun gnus-delete-wash-type (type)
   "Add a washing of TYPE to the current status."
@@ -4680,7 +4717,7 @@ The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
   (interactive "P")
   (let ((article (cdr gnus-article-current)) cont)
-    (if (not mark-active)
+    (if (not (mark))
        (gnus-summary-reply (list (list article)) wide)
       (setq cont (buffer-substring (point) (mark)))
       ;; Deactivate active regions.
@@ -4731,6 +4768,9 @@ If given a prefix, show the hidden text instead."
     (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
     (gnus-request-group gnus-newsgroup-name t)))
 
+(eval-when-compile
+  (autoload 'nneething-get-file-name "nneething"))
+
 (defun gnus-request-article-this-buffer (article group)
   "Get an article and insert it into this buffer."
   (let (do-update-line sparse-header)
@@ -4780,12 +4820,10 @@ If given a prefix, show the hidden text instead."
                               gnus-newsgroup-name)))
                  (when (and (eq (car method) 'nneething)
                             (vectorp header))
-                   (let ((dir (expand-file-name
-                               (mail-header-subject header)
-                               (file-name-as-directory
-                                (or (cadr (assq 'nneething-address method))
-                                    (nth 1 method))))))
-                     (when (file-directory-p dir)
+                   (let ((dir (nneething-get-file-name
+                               (mail-header-id header))))
+                     (when (and (stringp dir)
+                                (file-directory-p dir))
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
 
@@ -5075,7 +5113,7 @@ groups."
     ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t
      gnus-button-handle-info 2)
     ;; This is how URLs _should_ be embedded in text...
-    ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
+    ("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
     ;; Raw URLs.
     (,gnus-button-url-regexp 0 t browse-url 0))
   "*Alist of regexps matching buttons in article bodies.
@@ -5497,7 +5535,7 @@ specified by `gnus-button-alist'."
       (if (not (string-match "=" cur))
          nil                           ; Grace
        (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
-             val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
+             val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
        (if downcase
            (setq key (downcase key)))
        (setq cur (assoc key retval))