Package: emacs;
Reported by: Teemu Likonen <tlikonen <at> iki.fi>
Date: Sat, 2 Apr 2016 07:50:02 UTC
Severity: wishlist
Found in version 25.0.92
Done: Tassilo Horn <tsdh <at> gnu.org>
Bug is archived. No further changes may be made.
Message #14 received at 23184 <at> debbugs.gnu.org (full text, mbox):
From: Tassilo Horn <tsdh <at> gnu.org> To: Eli Zaretskii <eliz <at> gnu.org> Cc: tlikonen <at> iki.fi, 23184 <at> debbugs.gnu.org Subject: Re: bug#23184: 25.0.92; User-friendly way to override doc-view-mode as MIME viewer Date: Sat, 09 Apr 2016 10:57:04 +0200
Eli Zaretskii <eliz <at> gnu.org> writes:
>> From: Tassilo Horn <tsdh <at> gnu.org>
>> Date: Fri, 08 Apr 2016 22:46:49 +0200
>> Cc: 23184 <at> debbugs.gnu.org
>>
>> (In case I'd implement that, should that go only into master or
>> emacs-25?)
>
> It should go to master. Thanks.
Ok. Does that approach look sensible?
--8<---------------cut here---------------start------------->8---
1 file changed, 102 insertions(+), 29 deletions(-)
lisp/net/mailcap.el | 131 ++++++++++++++++++++++++++++++++++++++++------------
modified lisp/net/mailcap.el
@@ -58,6 +58,59 @@ mailcap-print-command
" ")
"Shell command (including switches) used to print PostScript files.")
+(defun mailcap--get-user-mime-data (sym)
+ (let ((val (default-value sym))
+ res)
+ (dolist (entry val)
+ (setq res (cons (list (cdr (assq 'viewer entry))
+ (cdr (assq 'type entry))
+ (cdr (assq 'test entry)))
+ res)))
+ (nreverse res)))
+
+(defun mailcap--set-user-mime-data (sym val)
+ (let (res)
+ (dolist (entry val)
+ (setq res (cons `((viewer . ,(car entry))
+ (type . ,(cadr entry))
+ ,@(when (caddr entry)
+ `((test . ,(caddr entry)))))
+ res)))
+ (set-default sym (nreverse res))))
+
+(defcustom mailcap-user-mime-data nil
+ "A list of viewers preferred for different MIME types.
+The elements of the list are alists of the following structure
+
+ ((viewer . VIEWER)
+ (type . MIME-TYPE)
+ (test . TEST))
+
+where VIEWER is either a lisp command, e.g., a major-mode, or a
+string containing a shell command for viewing files of the
+defined MIME-TYPE. In case of a shell command, %s will be
+replaced with the file.
+
+MIME-TYPE is a regular expression being matched against the
+actual MIME type. It is implicitly surrounded with ^ and $.
+
+TEST is an lisp form which is evaluated in order to test if the
+entry should be chosen. The `test' entry is optional.
+
+When selecting a viewer for a given MIME type, the first viewer
+in this list with a matching MIME-TYPE and successful TEST is
+selected. Only if none matches, the standard `mailcap-mime-data'
+is consulted."
+ :type '(repeat
+ (list
+ (choice (function :tag "Function or mode")
+ (string :tag "Shell command"))
+ (regexp :tag "MIME Type")
+ (sexp :tag "Test (optional)")))
+ :get #'mailcap--get-user-mime-data
+ :set #'mailcap--set-user-mime-data
+ :group 'mailcap)
+
;; Postpone using defcustom for this as it's so big and we essentially
;; have to have two copies of the data around then. Perhaps just
;; customize the Lisp viewers and rely on the normal configuration
@@ -700,6 +753,20 @@ mailcap-viewer-lessp
t)
(t nil))))
+(defun mailcap-select-preferred-viewer (type-info)
+ "Return an applicable viewer entry from `mailcap-user-mime-data'."
+ (let ((info (mapcar (lambda (a) (cons (symbol-name (car a))
+ (cdr a)))
+ (cdr type-info)))
+ viewer)
+ (dolist (entry mailcap-user-mime-data)
+ (when (and (null viewer)
+ (string-match (concat "^" (cdr (assq 'type entry)) "$")
+ (car type-info))
+ (mailcap-viewer-passes-test entry info))
+ (setq viewer entry)))
+ viewer))
+
(defun mailcap-mime-info (string &optional request no-decode)
"Get the MIME viewer command for STRING, return nil if none found.
Expects a complete content-type header line as its argument.
@@ -732,41 +799,47 @@ mailcap-mime-info
(if no-decode
(list (or string "text/plain"))
(mail-header-parse-content-type (or string "text/plain"))))
- (setq major (split-string (car ctl) "/"))
- (setq minor (cadr major)
- major (car major))
- (when (setq major-info (cdr (assoc major mailcap-mime-data)))
- (when (setq viewers (mailcap-possible-viewers major-info minor))
- (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
- (cdr a)))
- (cdr ctl)))
- (while viewers
- (if (mailcap-viewer-passes-test (car viewers) info)
- (setq passed (cons (car viewers) passed)))
- (setq viewers (cdr viewers)))
- (setq passed (sort passed 'mailcap-viewer-lessp))
- (setq viewer (car passed))))
- (when (and (stringp (cdr (assq 'viewer viewer)))
- passed)
- (setq viewer (car passed)))
+ ;; Check if there's a user-defined viewer from `mailcap-user-mime-data'.
+ (setq viewer (mailcap-select-preferred-viewer ctl))
+ (if viewer
+ (setq passed (list viewer))
+ ;; None found, so heuristically select some applicable viewer
+ ;; from `mailcap-mime-data'.
+ (setq major (split-string (car ctl) "/"))
+ (setq minor (cadr major)
+ major (car major))
+ (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+ (when (setq viewers (mailcap-possible-viewers major-info minor))
+ (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
+ (cdr a)))
+ (cdr ctl)))
+ (while viewers
+ (if (mailcap-viewer-passes-test (car viewers) info)
+ (setq passed (cons (car viewers) passed)))
+ (setq viewers (cdr viewers)))
+ (setq passed (sort passed 'mailcap-viewer-lessp))
+ (setq viewer (car passed))))
+ (when (and (stringp (cdr (assq 'viewer viewer)))
+ passed)
+ (setq viewer (car passed))))
(cond
((and (null viewer) (not (equal major "default")) request)
- (mailcap-mime-info "default" request no-decode))
+ (mailcap-mime-info "default" request no-decode))
((or (null request) (equal request ""))
- (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
+ (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
- (mailcap-unescape-mime-test
- (cdr-safe (assoc request viewer)) info))
+ (mailcap-unescape-mime-test
+ (cdr-safe (assoc request viewer)) info))
((eq request 'all)
- passed)
+ passed)
(t
- ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
- (setq viewer (copy-sequence viewer))
- (let ((view (assq 'viewer viewer))
- (test (assq 'test viewer)))
- (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
- (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
- viewer)))))
+ ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+ (setq viewer (copy-sequence viewer))
+ (let ((view (assq 'viewer viewer))
+ (test (assq 'test viewer)))
+ (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
+ (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
+ viewer)))))
;;;
;;; Experimental MIME-types parsing
--8<---------------cut here---------------end--------------->8---
Bye,
Tassilo
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.