1 ;;; sex-mode.el --- Shell EXecute mode / Send to EXternal program
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2008-06-01T18:41:50+0200 Sun
5 (defconst sex-mode:version "0.71")
6 ;; Last-Updated: 2009-01-06 Tue
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; Open urls belonging to other programs with those programs. To
20 ;; enable this turn on the global minor mode `sex-mode'.
22 ;; If you for example open a .pdf file with C-x C-f it can be opened
23 ;; by the .pdf application you have set your computer to use. (Or, if
24 ;; that such settings are not possible on your OS, with the
25 ;; application you have choosen here.)
27 ;; There is also a defmacro `sex-with-temporary-apps' that you can use
28 ;; for example with `find-file' to open files in external
31 ;; The functions used to open files in external applications are
32 ;; borrowed from `org-mode'. There is some small differences:
34 ;; - There is an extra variable here `sex-file-apps' that is checked
35 ;; before the corresponding lists in `org-mode'.
37 ;; - In `org-mode' any file that is not found in the lists (and is not
38 ;; remote or a directory) is sent to an external application. This
39 ;; would create trouble when used here in a file handler so the
40 ;; logic is the reverse here: Any file that is not found in the
41 ;; lists is opened inside Emacs. (Actually I think that might be a
42 ;; good default in `org-mode' too, but I am not sure.)
44 ;; - Because of the above I have to guess which function is the one
45 ;; that sends a file to an external application.
47 ;; (Currently the integration with org.el is not the best code wise.
48 ;; We hope to improve that soon.)
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 ;; This program is free software; you can redistribute it and/or
57 ;; modify it under the terms of the GNU General Public License as
58 ;; published by the Free Software Foundation; either version 2, or
59 ;; (at your option) any later version.
61 ;; This program is distributed in the hope that it will be useful,
62 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
63 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
64 ;; General Public License for more details.
66 ;; You should have received a copy of the GNU General Public License
67 ;; along with this program; see the file COPYING. If not, write to
68 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
69 ;; Floor, Boston, MA 02110-1301, USA.
71 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;;(org-open-file "c:/EmacsW32/nxhtml/nxhtml/doc/nxhtml-changes.html")
76 (eval-when-compile (require 'cl))
77 (eval-when-compile (require 'org))
78 (eval-when-compile (require 'mailcap))
80 (defcustom sex-file-apps
86 "Application for opening a file.
87 See `sex-get-file-open-cmd'."
90 (cons (choice :value ""
91 (string :tag "Extension")
92 (const :tag "Default for unrecognized files" t)
93 (const :tag "Remote file" remote)
94 (const :tag "Links to a directory" directory))
96 (const :tag "Visit with Emacs" emacs)
97 (const :tag "Use system default" default)
98 (string :tag "Command")
99 (sexp :tag "Lisp form")))))
103 (defvar sex-with-temporary-file-apps nil)
105 (defun sex-get-apps ()
106 (or sex-with-temporary-file-apps
107 (append sex-file-apps org-file-apps (org-default-apps))))
109 ;; (sex-get-file-open-cmd "temp.el")
110 ;; (sex-get-file-open-cmd "http://some.where/temp.el")
111 ;; (sex-get-file-open-cmd "temp.c")
112 ;; (sex-get-file-open-cmd "temp.pdf")
113 ;; (sex-get-file-open-cmd "temp.doc")
114 ;; (sex-get-file-open-cmd "/ftp:temp.doc")
115 ;; (sex-get-file-open-cmd "http://some.host/temp.doc")
116 ;; (sex-get-file-open-cmd "http://some.host/temp.html")
118 (defun sex-get-file-open-cmd (path)
119 "Get action for opening file.
120 Construct a key from PATH:
121 - If PATH specifies a location on a remote system then set key to
123 - If PATH is a directory set key to 'directory.
124 - Otherwise use the file extension of PATH as key.
126 Search with this key against the combined association list of
127 `sex-file-apps', `org-file-apps' and `org-default-apps'. The
128 first matching entry is used.
130 If cdr of this entry is 'default then search again with key equal
131 to t for the default action for the operating system you are on
132 \(or your own default action if you have defined one in the
135 Return the cdr of the found entry.
137 If no entry was found return `emacs' for opening inside Emacs."
138 (let* ((apps (sex-get-apps))
139 (key (if (org-file-remote-p path)
141 (if (file-directory-p path)
143 (let ((ext (file-name-extension path)))
145 ;; t should be a check for case insensitive
146 ;; file names ... - how do you do that?
149 (cmd (or (cdr (assoc key apps))
151 (when (eq cmd 'default)
152 (setq cmd (or (cdr (assoc t apps))
154 (when (eq cmd 'mailcap)
156 (mailcap-parse-mailcaps)
157 (let* ((mime-type (mailcap-extension-to-mime (or key "")))
158 (command (mailcap-mime-info mime-type)))
159 (if (stringp command)
162 ;;(message "cmd=%s" cmd)
167 "Customization group for `sex-mode'."
170 ;;(setq sex-handle-urls t)
171 (defcustom sex-handle-urls nil
172 "When non-nil `sex-mode' also handles urls.
173 Turn on `url-handler-mode' when turning on `sex-mode' if this is
174 non-nil. Open urls in a web browser."
178 ;; (setq sex-keep-dummy-buffer nil)
179 ;; (setq sex-keep-dummy-buffer 'visible)
180 ;; (setq sex-keep-dummy-buffer 'burried)
181 (defcustom sex-keep-dummy-buffer 'visible
182 "Keep dummy buffer after opening file.
183 When opening a file with the shell a dummy buffer is created in
184 Emacs in `sex-file-mode' and an external program is called to
185 handle the file. How this dummy buffer is handled is governed by
187 :type '(choice (const :tag "Visible" visible)
188 (const :tag "Burried" burried)
189 (const :tag "Do not keep it" nil))
192 (defcustom sex-reopen-on-buffer-entry nil
193 "If non-nil send file to shell again on buffer entry."
197 (defun sex-post-command ()
198 "Run post command in `sex-file-mode' buffers.
199 If `sex-reopen-on-buffer-entry' is non-nil then send the buffer
200 file to system again."
201 (when sex-reopen-on-buffer-entry
202 (if (and (boundp 'url-handler-regexp)
203 (string-match url-handler-regexp buffer-file-name))
204 (sex-browse-url buffer-file-name)
205 (sex-handle-by-external buffer-file-name))
208 (defun sex-browse-url (url)
209 "Ask a web browser to open URL."
211 (list (browse-url url) "Opened URL in web browser")
212 (error (list nil (error-message-string err)))))
214 (defun sex-url-insert-file-contents (url &optional visit beg end replace)
215 (sex-generic-insert-file-contents
217 (concat "This dummy buffer is used just for opening a URL.\n"
218 "To open the URL again click here:\n\n ")
219 (concat "Tried to open URL in web browser, "
220 "but it failed with message\n\n ")
221 url visit beg end replace))
223 (defun sex-file-insert-file-contents (url &optional visit beg end replace)
224 ;;(message "sex-file-insert-file-contents %s %s %s %s %s" url visit beg end replace)
225 (sex-generic-insert-file-contents
226 'sex-handle-by-external
227 (concat "This dummy buffer is used just for opening a file.\n"
228 "The file itself was sent to system for opening.\n\n"
229 "To open the file again click here:\n\n ")
230 (concat "Tried to send file"
231 " to system but it failed with message\n\n ")
232 url visit beg end replace))
234 (defun sex-write-file-function ()
235 (set-buffer-modified-p nil)
236 (error "Can't write this to file, it is just a dummy buffer"))
238 (defun sex-generic-insert-file-contents (insert-fun
241 url &optional visit beg end replace)
242 (let ((window-config (current-window-configuration)))
243 (unless (= 0 (buffer-size))
244 (error "Buffer must be empty"))
245 (set (make-local-variable 'write-file-functions)
246 '(sex-write-file-function))
248 ;;(result (sex-browse-url name))
249 (result (funcall insert-fun name))
250 (success (nth 0 result))
251 (msg (nth 1 result)))
252 (setq buffer-file-name name)
255 (insert success-header)
256 (sex-setup-restore-window-config window-config)
258 (insert (propertize "Error: " 'face 'font-lock-warning-face)
260 "\n\nTo try again click here:\n\n "))
264 'insert-fun insert-fun
265 'action (lambda (button)
266 ;;(sex-browse-url buffer-file-name)
267 (funcall (button-get button 'insert-fun) buffer-file-name)
270 (defun sex-file-handler (operation &rest args)
271 "Handler for `insert-file-contents'."
272 ;;(message "\noperation=%s, args=%s" operation args)
275 ;; Always open files inside Emacs if the file opening request came
276 ;; through Emacs client. Here is a primitive test if we are called
277 ;; from outside, client-record is bound in `server-visit-files'
279 (when (not (boundp 'client-record))
280 (let* ((filename (car args))
281 (insert-handling (sex-get-file-open-cmd filename)))
282 ;;(message "insert-handling=%s" insert-handling)
283 (when insert-handling
284 (setq ftype insert-handling))
285 ;;(message "ftype=%s, filename=%s" ftype filename)
287 (unless (eq ftype 'emacs)
288 ;;(message "using sex-file-insert-file-contents for %s" args)
289 (apply 'sex-file-insert-file-contents args)
291 ;; Handle any operation we don't know about.
293 ;;(message "fallback for operation=%s, args=%s" operation args)
294 (let ((inhibit-file-name-handlers
295 (cons 'sex-file-handler
296 (and (eq inhibit-file-name-operation operation)
297 inhibit-file-name-handlers)))
298 (inhibit-file-name-operation operation))
299 (apply operation args)))))
300 ;; Note: Because of a bug in Emacs we must restrict the use of this
301 ;; file handler to only 'insert-file-contents. (We should of course
303 (put 'sex-file-handler 'operations '(insert-file-contents))
305 (defun sex-setup-restore-window-config (window-config)
306 (when (not (eq sex-keep-dummy-buffer 'visible))
307 (run-with-idle-timer 0 nil
308 'sex-restore-window-config
311 (unless sex-keep-dummy-buffer
314 (defun sex-restore-window-config (frame win-config buffer)
315 (save-match-data ;; runs in timer
316 (with-selected-frame frame
317 (set-window-configuration win-config))
318 (when buffer (kill-buffer buffer))))
320 (defun sex-handle-by-external (&optional file)
321 "Give file FILE to external program.
326 where SUCCESS is non-nil if operation succeeded and MESSAGE is an
327 informational message."
328 (unless file (setq file buffer-file-name))
329 (let ((cmd (sex-get-file-open-cmd file)))
330 (assert (not (eq cmd 'emacs)))
332 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
333 ;; Remove quotes around the file name - we'll use shell-quote-argument.
334 (while (string-match "['\"]%s['\"]" cmd)
335 (setq cmd (replace-match "%s" t t cmd)))
336 (while (string-match "%s" cmd)
337 (setq cmd (replace-match
339 (shell-quote-argument
340 (convert-standard-filename file)))
342 (save-window-excursion
343 (start-process-shell-command cmd nil cmd)
344 ;;(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
346 (list t (format "Opened %s in external application" file)))
348 (let ((file (convert-standard-filename file)))
350 (list t (format "Opened %s in external application" file)))
351 (t (list nil (format "Don't know how to handle %s" file))))
355 (define-derived-mode sex-file-mode nil
357 "Mode for files opened in external programs."
358 (add-hook 'post-command-hook 'sex-post-command nil t)
359 (set-keymap-parent (current-local-map) button-buffer-map)
360 (set-buffer-modified-p nil)
361 (setq buffer-read-only t))
364 (defvar sex-old-url-insert-file-contents nil)
365 (defvar sex-old-url-handler-mode nil)
368 (define-minor-mode sex-mode
369 "Open certain files in external programs.
370 See `sex-get-file-open-cmd' for how to determine which files to
371 open by external applications. Note that this selection is
372 nearly the same as in `org-mode'. The main difference is that
373 the fallback always is to open a file in Emacs. \(This is
374 necessary to avoid to disturb many of Emacs operations.)
376 This affects all functions that opens files, like `find-file',
377 `find-file-noselect' etc.
379 However it does not affect files opened through Emacs client.
381 Urls can also be handled, see `sex-handle-urls'.
383 When opening a file with the shell a \(temporary) dummy buffer is
384 created in Emacs with major mode `sex-file-mode' and an external
385 program is called to handle the file. How this dummy buffer is
386 handled is governed by `sex-keep-dummy-buffer'."
388 ;; On MS Windows `w32-shell-execute' is called to open files in an
389 ;; external application. Be aware that this may run scripts if the
390 ;; script file extension is not blocked in `sex-open-alist'.
394 ;; fix-me: better list handling
398 (dolist (rec (sex-get-apps))
399 (let* ((ext (car rec))
401 (patt (when (and (stringp ext)
402 (not (eq app 'emacs)))
403 (concat "\\." ext "\\'"))))
406 (setq patt (concat ".*\\'"))))
409 (add-to-list 'auto-mode-alist (cons patt 'sex-file-mode)))
410 (add-to-list 'file-name-handler-alist
411 (cons patt 'sex-file-handler) t))))
412 (setq sex-old-url-insert-file-contents
413 (get 'insert-file-contents 'url-file-handlers))
414 (setq sex-old-url-handler-mode url-handler-mode)
415 (when sex-handle-urls
416 ;;(message "req url, before")
417 (require 'url-handlers)
418 ;;(message "req url, after")
419 (put 'insert-file-contents 'url-file-handlers
420 'sex-url-insert-file-contents)
421 (unless url-handler-mode
423 ;;(message "after url-handler-mode 1")
425 ;; Remove from the lists:
426 ;;(let ((handler-list (copy-list file-name-handler-alist)))
427 (let ((handler-list (copy-sequence file-name-handler-alist)))
428 (dolist (handler handler-list)
429 (when (eq 'sex-file-handler (cdr handler))
430 (setq file-name-handler-alist
431 (delete handler file-name-handler-alist)))))
432 ;;(let ((mode-alist (copy-list auto-mode-alist)))
433 (let ((mode-alist (copy-sequence auto-mode-alist)))
434 (dolist (auto-mode mode-alist)
435 (when (eq 'sex-file-mode (cdr auto-mode))
436 (setq auto-mode-alist
437 (delete auto-mode auto-mode-alist)))))
438 (put 'insert-file-contents 'url-file-handlers
439 sex-old-url-insert-file-contents)
440 (unless sex-old-url-handler-mode (url-handler-mode 0))))
442 (defmacro sex-with-temporary-apps (open-alist &rest body)
443 "Run BODY with `sex-mode' on.
444 If OPEN-ALIST is not t it replaces the list normally used by
445 `sex-get-file-open-cmd'."
446 (declare (indent 1) (debug t))
447 `(let ((old-sex-mode sex-mode)
448 (sex-with-temporary-file-apps
449 (if (eq ,open-alist t)
452 (when sex-mode (sex-mode -1))
455 (setq sex-with-temporary-file-apps nil)
456 (unless old-sex-mode (sex-mode -1))))
458 ;; (with-sex t (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf"))
459 ;; (with-sex nil (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf"))
462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
463 ;;; sex-mode.el ends here