procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

mailcap: Docfix & handle function-viewer case in mailcap-view-file

Browse source 
* lisp/net/mailcap.el (mailcap-mime-data): Fix docstring: if viewer is
a symbol/function, it should have zero args and expect the file's
contents to be in the current buffer.
(mailcap-view-file): Implement the case where the chosen viewer is a
function and not a shell command.
This commit is contained in:
Tassilo Horn 2022-01-15 11:23:46 +01:00
parent 7a679953e2
commit 45f1e427fc
1 changed files with 42 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
lisp/net/mailcap.el
View file

@ -319,8 +319,9 @@ attribute name (viewer, test, etc). This looks like:
Where VIEWERINFO specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with appropriate
parameters, or a symbol, in which case the symbol is `funcall'ed if
and only if it exists as a function, with the buffer as an argument.
parameters, or a symbol, in which case the symbol must name a function
of zero arguments which is called in a buffer holding the MIME part's
content.
TESTINFO is a test for the viewer's applicability, or nil. If nil, it
means the viewer is always valid. If it is a Lisp function, it is
@ -1175,34 +1176,45 @@ See \"~/.mailcap\", `mailcap-mime-data' and related files and variables."
(mailcap-parse-mailcaps)
(let ((command (mailcap-mime-info
(mailcap-extension-to-mime (file-name-extension file)))))
(unless command
(error "No viewer for %s" (file-name-extension file)))
;; Remove quotes around the file name - we'll use shell-quote-argument.
(while (string-match "['\"]%s['\"]" command)
(setq command (replace-match "%s" t t command)))
(setq command (replace-regexp-in-string
"%s"
(shell-quote-argument (convert-standard-filename file))
command
nil t))
;; Handlers such as "gio open" and kde-open5 start viewer in background
;; and exit immediately. Avoid `start-process' since it assumes
;; :connection-type `pty' and kills children processes with SIGHUP
;; when temporary terminal session is finished (Bug#44824).
;; An alternative is `process-connection-type' let-bound to nil for
;; `start-process-shell-command' call (with no chance to report failure).
(make-process
:name "mailcap-view-file"
:connection-type 'pipe
:buffer nil ; "*Messages*" may be suitable for debugging
:sentinel (lambda (proc event)
(when (and (memq (process-status proc) '(exit signal))
(/= (process-exit-status proc) 0))
(message
"Command %s: %s."
(mapconcat #'identity (process-command proc) " ")
(substring event 0 -1))))
:command (list shell-file-name shell-command-switch command))))
(if (functionp command)
;; command is a viewer function (a mode) expecting the file
;; contents to be in the current buffer.
(let ((buf (generate-new-buffer (file-name-nondirectory file))))
(set-buffer buf)
(insert-file-contents file)
(setq buffer-file-name file)
(funcall command)
(set-buffer-modified-p nil)
(pop-to-buffer buf))
;; command is a program to run with file as an argument.
(unless command
(error "No viewer for %s" (file-name-extension file)))
;; Remove quotes around the file name - we'll use shell-quote-argument.
(while (string-match "['\"]%s['\"]" command)
(setq command (replace-match "%s" t t command)))
(setq command (replace-regexp-in-string
"%s"
(shell-quote-argument (convert-standard-filename file))
command
nil t))
;; Handlers such as "gio open" and kde-open5 start viewer in background
;; and exit immediately. Avoid `start-process' since it assumes
;; :connection-type `pty' and kills children processes with SIGHUP
;; when temporary terminal session is finished (Bug#44824).
;; An alternative is `process-connection-type' let-bound to nil for
;; `start-process-shell-command' call (with no chance to report failure).
(make-process
:name "mailcap-view-file"
:connection-type 'pipe
:buffer nil ; "*Messages*" may be suitable for debugging
:sentinel (lambda (proc event)
(when (and (memq (process-status proc) '(exit signal))
(/= (process-exit-status proc) 0))
(message
"Command %s: %s."
(mapconcat #'identity (process-command proc) " ")
(substring event 0 -1))))
:command (list shell-file-name shell-command-switch command)))))
(provide 'mailcap)