diff options
Diffstat (limited to 'emacs.d/nxhtml/util/sex-mode.el')
| -rw-r--r-- | emacs.d/nxhtml/util/sex-mode.el | 463 |
1 files changed, 463 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/sex-mode.el b/emacs.d/nxhtml/util/sex-mode.el new file mode 100644 index 0000000..290a1a0 --- /dev/null +++ b/emacs.d/nxhtml/util/sex-mode.el @@ -0,0 +1,463 @@ +;;; sex-mode.el --- Shell EXecute mode / Send to EXternal program +;; +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Created: 2008-06-01T18:41:50+0200 Sun +(defconst sex-mode:version "0.71") +;; Last-Updated: 2009-01-06 Tue +;; URL: +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; None +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Open urls belonging to other programs with those programs. To +;; enable this turn on the global minor mode `sex-mode'. +;; +;; If you for example open a .pdf file with C-x C-f it can be opened +;; by the .pdf application you have set your computer to use. (Or, if +;; that such settings are not possible on your OS, with the +;; application you have choosen here.) +;; +;; There is also a defmacro `sex-with-temporary-apps' that you can use +;; for example with `find-file' to open files in external +;; applications. +;; +;; The functions used to open files in external applications are +;; borrowed from `org-mode'. There is some small differences: +;; +;; - There is an extra variable here `sex-file-apps' that is checked +;; before the corresponding lists in `org-mode'. +;; +;; - In `org-mode' any file that is not found in the lists (and is not +;; remote or a directory) is sent to an external application. This +;; would create trouble when used here in a file handler so the +;; logic is the reverse here: Any file that is not found in the +;; lists is opened inside Emacs. (Actually I think that might be a +;; good default in `org-mode' too, but I am not sure.) +;; +;; - Because of the above I have to guess which function is the one +;; that sends a file to an external application. +;; +;; (Currently the integration with org.el is not the best code wise. +;; We hope to improve that soon.) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change log: +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;(org-open-file "c:/EmacsW32/nxhtml/nxhtml/doc/nxhtml-changes.html") +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'org)) +(eval-when-compile (require 'mailcap)) + +(defcustom sex-file-apps + '( + ("html" . emacs) + ("pdf" . default) + ("wnk" . default) + ) + "Application for opening a file. +See `sex-get-file-open-cmd'." + :group 'sex + :type '(repeat + (cons (choice :value "" + (string :tag "Extension") + (const :tag "Default for unrecognized files" t) + (const :tag "Remote file" remote) + (const :tag "Links to a directory" directory)) + (choice :value "" + (const :tag "Visit with Emacs" emacs) + (const :tag "Use system default" default) + (string :tag "Command") + (sexp :tag "Lisp form"))))) + +;;(sex-get-apps) + +(defvar sex-with-temporary-file-apps nil) + +(defun sex-get-apps () + (or sex-with-temporary-file-apps + (append sex-file-apps org-file-apps (org-default-apps)))) + +;; (sex-get-file-open-cmd "temp.el") +;; (sex-get-file-open-cmd "http://some.where/temp.el") +;; (sex-get-file-open-cmd "temp.c") +;; (sex-get-file-open-cmd "temp.pdf") +;; (sex-get-file-open-cmd "temp.doc") +;; (sex-get-file-open-cmd "/ftp:temp.doc") +;; (sex-get-file-open-cmd "http://some.host/temp.doc") +;; (sex-get-file-open-cmd "http://some.host/temp.html") + +(defun sex-get-file-open-cmd (path) + "Get action for opening file. +Construct a key from PATH: +- If PATH specifies a location on a remote system then set key to + 'remote. +- If PATH is a directory set key to 'directory. +- Otherwise use the file extension of PATH as key. + +Search with this key against the combined association list of +`sex-file-apps', `org-file-apps' and `org-default-apps'. The +first matching entry is used. + +If cdr of this entry is 'default then search again with key equal +to t for the default action for the operating system you are on +\(or your own default action if you have defined one in the +variables above). + +Return the cdr of the found entry. + +If no entry was found return `emacs' for opening inside Emacs." + (let* ((apps (sex-get-apps)) + (key (if (org-file-remote-p path) + 'remote + (if (file-directory-p path) + 'directory + (let ((ext (file-name-extension path))) + (if (and t ext) + ;; t should be a check for case insensitive + ;; file names ... - how do you do that? + (downcase ext) + ext))))) + (cmd (or (cdr (assoc key apps)) + 'emacs))) + (when (eq cmd 'default) + (setq cmd (or (cdr (assoc t apps)) + 'emacs))) + (when (eq cmd 'mailcap) + (require 'mailcap) + (mailcap-parse-mailcaps) + (let* ((mime-type (mailcap-extension-to-mime (or key ""))) + (command (mailcap-mime-info mime-type))) + (if (stringp command) + (setq cmd command) + (setq cmd 'emacs)))) + ;;(message "cmd=%s" cmd) + cmd)) + +;;;###autoload +(defgroup sex nil + "Customization group for `sex-mode'." + :group 'external) + +;;(setq sex-handle-urls t) +(defcustom sex-handle-urls nil + "When non-nil `sex-mode' also handles urls. +Turn on `url-handler-mode' when turning on `sex-mode' if this is +non-nil. Open urls in a web browser." + :type 'boolean + :group 'sex) + +;; (setq sex-keep-dummy-buffer nil) +;; (setq sex-keep-dummy-buffer 'visible) +;; (setq sex-keep-dummy-buffer 'burried) +(defcustom sex-keep-dummy-buffer 'visible + "Keep dummy buffer after opening file. +When opening a file with the shell a dummy buffer is created in +Emacs in `sex-file-mode' and an external program is called to +handle the file. How this dummy buffer is handled is governed by +this variable." + :type '(choice (const :tag "Visible" visible) + (const :tag "Burried" burried) + (const :tag "Do not keep it" nil)) + :group 'sex) + +(defcustom sex-reopen-on-buffer-entry nil + "If non-nil send file to shell again on buffer entry." + :type 'boolean + :group 'sex) + +(defun sex-post-command () + "Run post command in `sex-file-mode' buffers. +If `sex-reopen-on-buffer-entry' is non-nil then send the buffer +file to system again." + (when sex-reopen-on-buffer-entry + (if (and (boundp 'url-handler-regexp) + (string-match url-handler-regexp buffer-file-name)) + (sex-browse-url buffer-file-name) + (sex-handle-by-external buffer-file-name)) + (bury-buffer))) + +(defun sex-browse-url (url) + "Ask a web browser to open URL." + (condition-case err + (list (browse-url url) "Opened URL in web browser") + (error (list nil (error-message-string err))))) + +(defun sex-url-insert-file-contents (url &optional visit beg end replace) + (sex-generic-insert-file-contents + 'sex-browse-url + (concat "This dummy buffer is used just for opening a URL.\n" + "To open the URL again click here:\n\n ") + (concat "Tried to open URL in web browser, " + "but it failed with message\n\n ") + url visit beg end replace)) + +(defun sex-file-insert-file-contents (url &optional visit beg end replace) + ;;(message "sex-file-insert-file-contents %s %s %s %s %s" url visit beg end replace) + (sex-generic-insert-file-contents + 'sex-handle-by-external + (concat "This dummy buffer is used just for opening a file.\n" + "The file itself was sent to system for opening.\n\n" + "To open the file again click here:\n\n ") + (concat "Tried to send file" + " to system but it failed with message\n\n ") + url visit beg end replace)) + +(defun sex-write-file-function () + (set-buffer-modified-p nil) + (error "Can't write this to file, it is just a dummy buffer")) + +(defun sex-generic-insert-file-contents (insert-fun + success-header + fail-header + url &optional visit beg end replace) + (let ((window-config (current-window-configuration))) + (unless (= 0 (buffer-size)) + (error "Buffer must be empty")) + (set (make-local-variable 'write-file-functions) + '(sex-write-file-function)) + (let* ((name url) + ;;(result (sex-browse-url name)) + (result (funcall insert-fun name)) + (success (nth 0 result)) + (msg (nth 1 result))) + (setq buffer-file-name name) + (if success + (progn + (insert success-header) + (sex-setup-restore-window-config window-config) + (message "%s" msg)) + (insert (propertize "Error: " 'face 'font-lock-warning-face) + fail-header msg + "\n\nTo try again click here:\n\n ")) + (save-excursion + (insert-text-button + buffer-file-name + 'insert-fun insert-fun + 'action (lambda (button) + ;;(sex-browse-url buffer-file-name) + (funcall (button-get button 'insert-fun) buffer-file-name) + )))))) + +(defun sex-file-handler (operation &rest args) + "Handler for `insert-file-contents'." + ;;(message "\noperation=%s, args=%s" operation args) + (let ((done nil) + (ftype 'emacs)) + ;; Always open files inside Emacs if the file opening request came + ;; through Emacs client. Here is a primitive test if we are called + ;; from outside, client-record is bound in `server-visit-files' + ;; ... + (when (not (boundp 'client-record)) + (let* ((filename (car args)) + (insert-handling (sex-get-file-open-cmd filename))) + ;;(message "insert-handling=%s" insert-handling) + (when insert-handling + (setq ftype insert-handling)) + ;;(message "ftype=%s, filename=%s" ftype filename) + )) + (unless (eq ftype 'emacs) + ;;(message "using sex-file-insert-file-contents for %s" args) + (apply 'sex-file-insert-file-contents args) + (setq done t)) + ;; Handle any operation we don't know about. + (unless done + ;;(message "fallback for operation=%s, args=%s" operation args) + (let ((inhibit-file-name-handlers + (cons 'sex-file-handler + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) + (apply operation args))))) +;; Note: Because of a bug in Emacs we must restrict the use of this +;; file handler to only 'insert-file-contents. (We should of course +;; anyway do that.) +(put 'sex-file-handler 'operations '(insert-file-contents)) + +(defun sex-setup-restore-window-config (window-config) + (when (not (eq sex-keep-dummy-buffer 'visible)) + (run-with-idle-timer 0 nil + 'sex-restore-window-config + (selected-frame) + window-config + (unless sex-keep-dummy-buffer + (current-buffer))))) + +(defun sex-restore-window-config (frame win-config buffer) + (save-match-data ;; runs in timer + (with-selected-frame frame + (set-window-configuration win-config)) + (when buffer (kill-buffer buffer)))) + +(defun sex-handle-by-external (&optional file) + "Give file FILE to external program. +Return a list: + + (SUCCESS MESSAGE) + +where SUCCESS is non-nil if operation succeeded and MESSAGE is an +informational message." + (unless file (setq file buffer-file-name)) + (let ((cmd (sex-get-file-open-cmd file))) + (assert (not (eq cmd 'emacs))) + (cond + ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) + ;; Remove quotes around the file name - we'll use shell-quote-argument. + (while (string-match "['\"]%s['\"]" cmd) + (setq cmd (replace-match "%s" t t cmd))) + (while (string-match "%s" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument + (convert-standard-filename file))) + t t cmd))) + (save-window-excursion + (start-process-shell-command cmd nil cmd) + ;;(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) + ) + (list t (format "Opened %s in external application" file))) + ((consp cmd) + (let ((file (convert-standard-filename file))) + (eval cmd)) + (list t (format "Opened %s in external application" file))) + (t (list nil (format "Don't know how to handle %s" file)))) + )) + + +(define-derived-mode sex-file-mode nil + "External" + "Mode for files opened in external programs." + (add-hook 'post-command-hook 'sex-post-command nil t) + (set-keymap-parent (current-local-map) button-buffer-map) + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + + +(defvar sex-old-url-insert-file-contents nil) +(defvar sex-old-url-handler-mode nil) + +;;;###autoload +(define-minor-mode sex-mode + "Open certain files in external programs. +See `sex-get-file-open-cmd' for how to determine which files to +open by external applications. Note that this selection is +nearly the same as in `org-mode'. The main difference is that +the fallback always is to open a file in Emacs. \(This is +necessary to avoid to disturb many of Emacs operations.) + +This affects all functions that opens files, like `find-file', +`find-file-noselect' etc. + +However it does not affect files opened through Emacs client. + +Urls can also be handled, see `sex-handle-urls'. + +When opening a file with the shell a \(temporary) dummy buffer is +created in Emacs with major mode `sex-file-mode' and an external +program is called to handle the file. How this dummy buffer is +handled is governed by `sex-keep-dummy-buffer'." + + ;; On MS Windows `w32-shell-execute' is called to open files in an + ;; external application. Be aware that this may run scripts if the + ;; script file extension is not blocked in `sex-open-alist'. + nil + :group 'sex + :global t + ;; fix-me: better list handling + (if sex-mode + (progn + (require 'org) + (dolist (rec (sex-get-apps)) + (let* ((ext (car rec)) + (app (cdr rec)) + (patt (when (and (stringp ext) + (not (eq app 'emacs))) + (concat "\\." ext "\\'")))) + (unless patt + (when (eq ext t) + (setq patt (concat ".*\\'")))) + (when patt + (unless (eq ext t) + (add-to-list 'auto-mode-alist (cons patt 'sex-file-mode))) + (add-to-list 'file-name-handler-alist + (cons patt 'sex-file-handler) t)))) + (setq sex-old-url-insert-file-contents + (get 'insert-file-contents 'url-file-handlers)) + (setq sex-old-url-handler-mode url-handler-mode) + (when sex-handle-urls + ;;(message "req url, before") + (require 'url-handlers) + ;;(message "req url, after") + (put 'insert-file-contents 'url-file-handlers + 'sex-url-insert-file-contents) + (unless url-handler-mode + (url-handler-mode 1) + ;;(message "after url-handler-mode 1") + ))) + ;; Remove from the lists: + ;;(let ((handler-list (copy-list file-name-handler-alist))) + (let ((handler-list (copy-sequence file-name-handler-alist))) + (dolist (handler handler-list) + (when (eq 'sex-file-handler (cdr handler)) + (setq file-name-handler-alist + (delete handler file-name-handler-alist))))) + ;;(let ((mode-alist (copy-list auto-mode-alist))) + (let ((mode-alist (copy-sequence auto-mode-alist))) + (dolist (auto-mode mode-alist) + (when (eq 'sex-file-mode (cdr auto-mode)) + (setq auto-mode-alist + (delete auto-mode auto-mode-alist))))) + (put 'insert-file-contents 'url-file-handlers + sex-old-url-insert-file-contents) + (unless sex-old-url-handler-mode (url-handler-mode 0)))) + +(defmacro sex-with-temporary-apps (open-alist &rest body) + "Run BODY with `sex-mode' on. +If OPEN-ALIST is not t it replaces the list normally used by +`sex-get-file-open-cmd'." + (declare (indent 1) (debug t)) + `(let ((old-sex-mode sex-mode) + (sex-with-temporary-file-apps + (if (eq ,open-alist t) + nil + ,open-alist))) + (when sex-mode (sex-mode -1)) + (sex-mode 1) + ,@body + (setq sex-with-temporary-file-apps nil) + (unless old-sex-mode (sex-mode -1)))) + +;; (with-sex t (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf")) +;; (with-sex nil (find-file "c:/emacs-lisp/gimp-mode-v1.40/gimpmode.pdf")) + +(provide 'sex-mode) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; sex-mode.el ends here |