[patch] mailcap.el: Error in parsing mailcap entries

[patch] mailcap.el: Error in parsing mailcap entries

[Elias Oltmanns]

[-- Attachment #1: Type: text/plain, Size: 754 bytes --]

Hi all,

in current cvs trunk gnus' mailcap parsing has been corrupted. The
problem is that mailcap-viewer-passes-test caches its results even if
the symbol test is nil. This makes (nil nil) appear in
mailcap-viewer-test-cache and all subsequent tests for viewers that do
have a test clause of any kind will fail in consequence. The little
patch attached fixes this problem.

Additionally, I'd like to have the tests performed in
mailcap-mailcap-entry-passes-test incorporated into the caching
system. That way, you would just have to flush the cache whenever
something changes in the environment; just consider the case when you
connect to a screen session on a remote machine with emacs already
running. What do you think about that?

Regards,

Elias


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mailcap.el-1.patch --]
[-- Type: text/x-patch, Size: 538 bytes --]

--- gnus/lisp/mailcap.el.orig	2006-01-31 02:11:48.000000000 +0100
+++ gnus/lisp/mailcap.el	2006-07-28 17:54:39.000000000 +0200
@@ -647,11 +647,11 @@
     (cond ((setq cache (assoc test mailcap-viewer-test-cache))
 	   (cadr cache))
 	  ((not test-info) t)		; No test clause
+	  ((not test) nil)		; Already failed test
 	  (t
 	   (setq
 	    result
 	    (cond
-	     ((not test) nil)		; Already failed test
 	     ((eq test t) t)		; Already passed test
 	     ((functionp test)		; Lisp function as test
 	      (funcall test type-info))

[patch] mailcap.el: Error in parsing mailcap entries

[Elias Oltmanns]

[-- Attachment #1: Type: text/plain, Size: 755 bytes --]

Hi all,

in current cvs trunk, gnus' mailcap parsing has been corrupted. The
problem is that mailcap-viewer-passes-test caches its results even if
the symbol test is nil. This makes (nil nil) appear in
mailcap-viewer-test-cache and all subsequent tests for viewers that do
have a test clause of any kind will fail in consequence. The little
patch attached fixes this problem.

Additionally, I'd like to have the tests performed in
mailcap-mailcap-entry-passes-test incorporated into the caching
system. That way, you would just have to flush the cache whenever
something changes in the environment; just consider the case when you
connect to a screen session on a remote machine with emacs already
running. What do you think about that?

Regards,

Elias


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mailcap.el-1.patch --]
[-- Type: text/x-patch, Size: 538 bytes --]

--- gnus/lisp/mailcap.el.orig	2006-01-31 02:11:48.000000000 +0100
+++ gnus/lisp/mailcap.el	2006-07-28 17:54:39.000000000 +0200
@@ -647,11 +647,11 @@
     (cond ((setq cache (assoc test mailcap-viewer-test-cache))
 	   (cadr cache))
 	  ((not test-info) t)		; No test clause
+	  ((not test) nil)		; Already failed test
 	  (t
 	   (setq
 	    result
 	    (cond
-	     ((not test) nil)		; Already failed test
 	     ((eq test t) t)		; Already passed test
 	     ((functionp test)		; Lisp function as test
 	      (funcall test type-info))

Re: [patch] mailcap.el: Error in parsing mailcap entries

[Elias Oltmanns]

[-- Attachment #1: Type: text/plain, Size: 1578 bytes --]

First of all, sorry for the duplicated posting. For some reason, the
first copy didn't show up in my gnus group buffer (no new messages
indicated for gmane.emacs.gnus.general). One wonders, whether this is
another bug in gnus or in the inner workings of the OP.

Elias Oltmanns <oltmanns@uni-bonn.de> wrote:
[...]
> Additionally, I'd like to have the tests performed in
> mailcap-mailcap-entry-passes-test incorporated into the caching
> system.

In fact, mailcap-mailcap-entry-passes-test seems to be flawed anyway.
If I haven't missed something, a line like
application/zip; /usr/bin/file-roller '%s'; test=test -n "$DISPLAY" -a -e /usr/bin/unzip
from my /etc/mailcap is preevaluated by
mailcap-mailcap-entry-passes-test ignoring everything after "$DISPLAY"
in the test clause. Since the actual test clause is discarded
afterwards and replaced by the result of the test of the DISPLAY
variable, the existence of /usr/bin/unzip is never checked. Besides,
mailcap-mailcap-entry-passes-test is the only function that evaluates
a "needsterm\(inal\)?" or "needsx11" clause in the mime-data. Since
this function is only applied to mailcap entries read from external
sources, a "needs\(x11\|term\{inal\}?\)" clause of any mailcap entry
in the default definition of the variable mailcap-mime-data is simly
ignored.

In an attempt to eliminate these flaws and to make the whole testing
business more consistent, i.e., integrating checks for $DISPLAY into
the caching mechanism, I'd like to ask for your comments on the patch
attached below (applying to current cvs).

Regards,

Elias


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mailcap.el-2.patch --]
[-- Type: text/x-patch, Size: 4850 bytes --]

--- gnus/lisp/mailcap.el.orig	2006-07-30 11:07:30.000000000 +0200
+++ gnus/lisp/mailcap.el	2006-07-31 00:11:37.000000000 +0200
@@ -487,7 +487,6 @@
 						      (if (string= minor ".*")
 							  "*" minor))))
 			    (mailcap-parse-mailcap-extras save-pos (point))))
-	  (mailcap-mailcap-entry-passes-test info)
 	  (mailcap-add-mailcap-entry major minor info))
 	(beginning-of-line)))))
 
@@ -541,32 +540,6 @@
 	(skip-chars-forward " \";\n\t"))
       results)))
 
-(defun mailcap-mailcap-entry-passes-test (info)
-  "Return non-nil iff mailcap entry INFO passes its test clause.
-Also return non-nil if no test clause is present."
-  (let ((test (assq 'test info))	; The test clause
-	status)
-    (setq status (and test (split-string (cdr test) " ")))
-    (if (and (or (assoc "needsterm" info)
-		 (assoc "needsterminal" info)
-		 (assoc "needsx11" info))
-	     (not (getenv "DISPLAY")))
-	(setq status nil)
-      (cond
-       ((and (equal (nth 0 status) "test")
-	     (equal (nth 1 status) "-n")
-	     (or (equal (nth 2 status) "$DISPLAY")
-		 (equal (nth 2 status) "\"$DISPLAY\"")))
-	(setq status (if (getenv "DISPLAY") t nil)))
-       ((and (equal (nth 0 status) "test")
-	     (equal (nth 1 status) "-z")
-	     (or (equal (nth 2 status) "$DISPLAY")
-		 (equal (nth 2 status) "\"$DISPLAY\"")))
-	(setq status (if (getenv "DISPLAY") nil t)))
-       (test nil)
-       (t nil)))
-    (and test (listp test) (setcdr test status))))
-
 ;;;
 ;;; The action routines.
 ;;;
@@ -641,34 +614,66 @@
   (let* ((test-info (assq 'test viewer-info))
 	 (test (cdr test-info))
 	 (otest test)
-	 (viewer (cdr (assoc 'viewer viewer-info)))
+	 (viewer (cdr (assq 'viewer viewer-info)))
 	 (default-directory (expand-file-name "~/"))
 	 status parsed-test cache result)
-    (cond ((setq cache (assoc test mailcap-viewer-test-cache))
-	   (cadr cache))
-	  ((not test-info) t)		; No test clause
-	  (t
-	   (setq
-	    result
-	    (cond
-	     ((not test) nil)		; Already failed test
-	     ((eq test t) t)		; Already passed test
-	     ((functionp test)		; Lisp function as test
-	      (funcall test type-info))
-	     ((and (symbolp test)	; Lisp variable as test
-		   (boundp test))
-	      (symbol-value test))
-	     ((and (listp test)		; List to be eval'd
-		   (symbolp (car test)))
-	      (eval test))
-	     (t
-	      (setq test (mailcap-unescape-mime-test test type-info)
-		    test (list shell-file-name nil nil nil
-			       shell-command-switch test)
-		    status (apply 'call-process test))
-	      (eq 0 status))))
-	   (push (list otest result) mailcap-viewer-test-cache)
-	   result))))
+    (if (setq cache (assq 'display viewer-info))
+	(if (cdr cache)
+	    (if (setq cache (assq 'display mailcap-viewer-test-cache))
+		(setq status (cadr cache))
+	      (push (list 'display (setq status (getenv "DISPLAY")))
+		    mailcap-viewer-test-cache))
+	  (setq status t))
+      (setq status (and test (stringp test) (split-string test " ")))
+      (if (or (assoc "needsterm" viewer-info)
+	      (assoc "needsterminal" viewer-info)
+	      (assoc "needsx11" viewer-info)
+	      (and (equal (nth 0 status) "test")
+		   (or (and (equal (nth 1 status) "-n")
+			    (or (equal (nth 2 status) "$DISPLAY")
+				(equal (nth 2 status) "\"$DISPLAY\"")))
+		       (and (equal (nth 1 status) "-z")
+			    (or (equal (nth 2 status) "$DISPLAY")
+				(equal (nth 2 status) "\"$DISPLAY\"")))
+		       (and (equal (nth 1 status) "\"$DISPLAY\"")
+			    (equal (nth 2 status) "!=")
+			    (equal (nth 3 status) "\"\"")))))
+	  (progn
+	    (nconc viewer-info (list (cons 'display t)))
+	    (setq
+	     status
+	     (if (setq cache (assq 'display mailcap-viewer-test-cache))
+		 (cadr cache)
+	       (push (list 'display (setq status (getenv "DISPLAY")))
+		     mailcap-viewer-test-cache))))
+	(nconc viewer-info (list (cons 'display nil)))
+	(setq status t)))
+    (when status
+      (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+	     (cadr cache))
+	    ((not test-info) t)		; No test clause
+	    ((not test) nil)		; Already failed test
+	    (t
+	     (setq
+	      result
+	      (cond
+	       ((eq test t) t)		; Already passed test
+	       ((functionp test)		; Lisp function as test
+		(funcall test type-info))
+	       ((and (symbolp test)	; Lisp variable as test
+		     (boundp test))
+		(symbol-value test))
+	       ((and (listp test)		; List to be eval'd
+		     (symbolp (car test)))
+		(eval test))
+	       (t
+		(setq test (mailcap-unescape-mime-test test type-info)
+		      test (list shell-file-name nil nil nil
+				 shell-command-switch test)
+		      status (apply 'call-process test))
+		(eq 0 status))))
+	     (push (list otest result) mailcap-viewer-test-cache)
+	     result)))))
 
 (defun mailcap-add-mailcap-entry (major minor info)
   (let ((old-major (assoc major mailcap-mime-data)))