emacs/nxhtml/util/sex-mode.el

   1 ;;; sex-mode.el --- Shell EXecute mode / Send to EXternal program
   2 ;;
   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
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; Open urls belonging to other programs with those programs. To
  20 ;; enable this turn on the global minor mode `sex-mode'.
  21 ;;
  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.)
  26 ;;
  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
  29 ;; applications.
  30 ;;
  31 ;; The functions used to open files in external applications are
  32 ;; borrowed from `org-mode'.  There is some small differences:
  33 ;;
  34 ;; - There is an extra variable here `sex-file-apps' that is checked
  35 ;;   before the corresponding lists in `org-mode'.
  36 ;;
  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.)
  43 ;;
  44 ;; - Because of the above I have to guess which function is the one
  45 ;;   that sends a file to an external application.
  46 ;;
  47 ;; (Currently the integration with org.el is not the best code wise.
  48 ;; We hope to improve that soon.)
  49 ;;
  50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51 ;;
  52 ;;; Change log:
  53 ;;
  54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55 ;;
  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.
  60 ;;
  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.
  65 ;;
  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.
  70 ;;
  71 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72 ;;
  73 ;;; Code:
  74
  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))
  79
  80 (defcustom sex-file-apps
  81   '(
  82     ("html" . emacs)
  83     ("pdf"  . default)
  84     ("wnk"  . default)
  85     )
  86   "Application for opening a file.
  87 See `sex-get-file-open-cmd'."
  88   :group 'sex
  89   :type '(repeat
  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))
  95                 (choice :value ""
  96                         (const :tag "Visit with Emacs" emacs)
  97                         (const :tag "Use system default" default)
  98                         (string :tag "Command")
  99                         (sexp :tag "Lisp form")))))
 100
 101 ;;(sex-get-apps)
 102
 103 (defvar sex-with-temporary-file-apps nil)
 104
 105 (defun sex-get-apps ()
 106   (or sex-with-temporary-file-apps
 107       (append sex-file-apps org-file-apps (org-default-apps))))
 108
 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")
 117
 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
 122   'remote.
 123 - If PATH is a directory set key to 'directory.
 124 - Otherwise use the file extension of PATH as key.
 125
 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.
 129
 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
 133 variables above).
 134
 135 Return the cdr of the found entry.
 136
 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)
 140                   'remote
 141                 (if (file-directory-p path)
 142                     'directory
 143                   (let ((ext (file-name-extension path)))
 144                     (if (and t ext)
 145                         ;; t should be a check for case insensitive
 146                         ;; file names ... - how do you do that?
 147                         (downcase ext)
 148                       ext)))))
 149          (cmd (or (cdr (assoc key apps))
 150                   'emacs)))
 151     (when (eq cmd 'default)
 152       (setq cmd (or (cdr (assoc t apps))
 153                     'emacs)))
 154     (when (eq cmd 'mailcap)
 155       (require '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)
 160             (setq cmd command)
 161           (setq cmd 'emacs))))
 162     ;;(message "cmd=%s" cmd)
 163     cmd))
 164
 165 ;;;###autoload
 166 (defgroup sex nil
 167   "Customization group for `sex-mode'."
 168   :group 'external)
 169
 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."
 175   :type 'boolean
 176   :group 'sex)
 177
 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
 186 this variable."
 187   :type '(choice (const :tag "Visible" visible)
 188                  (const :tag "Burried" burried)
 189                  (const :tag "Do not keep it" nil))
 190   :group 'sex)
 191
 192 (defcustom sex-reopen-on-buffer-entry nil
 193   "If non-nil send file to shell again on buffer entry."
 194   :type 'boolean
 195   :group 'sex)
 196
 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))
 206     (bury-buffer)))
 207
 208 (defun sex-browse-url (url)
 209   "Ask a web browser to open URL."
 210   (condition-case err
 211       (list (browse-url url) "Opened URL in web browser")
 212     (error (list nil (error-message-string err)))))
 213
 214 (defun sex-url-insert-file-contents (url &optional visit beg end replace)
 215   (sex-generic-insert-file-contents
 216    'sex-browse-url
 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))
 222
 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))
 233
 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"))
 237
 238 (defun sex-generic-insert-file-contents (insert-fun
 239                                          success-header
 240                                          fail-header
 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))
 247     (let* ((name url)
 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)
 253       (if success
 254           (progn
 255             (insert success-header)
 256             (sex-setup-restore-window-config window-config)
 257             (message "%s" msg))
 258         (insert (propertize "Error: " 'face 'font-lock-warning-face)
 259                 fail-header msg
 260                 "\n\nTo try again click here:\n\n  "))
 261       (save-excursion
 262         (insert-text-button
 263          buffer-file-name
 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)
 268                    ))))))
 269
 270 (defun sex-file-handler (operation &rest args)
 271   "Handler for `insert-file-contents'."
 272   ;;(message "\noperation=%s, args=%s" operation args)
 273   (let ((done nil)
 274         (ftype 'emacs))
 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'
 278     ;; ...
 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)
 286         ))
 287     (unless (eq ftype 'emacs)
 288       ;;(message "using sex-file-insert-file-contents for %s" args)
 289       (apply 'sex-file-insert-file-contents args)
 290       (setq done t))
 291     ;; Handle any operation we don't know about.
 292     (unless done
 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
 302 ;; anyway do that.)
 303 (put 'sex-file-handler 'operations '(insert-file-contents))
 304
 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
 309                          (selected-frame)
 310                          window-config
 311                          (unless sex-keep-dummy-buffer
 312                            (current-buffer)))))
 313
 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))))
 319
 320 (defun sex-handle-by-external (&optional file)
 321   "Give file FILE to external program.
 322 Return a list:
 323
 324   (SUCCESS MESSAGE)
 325
 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)))
 331     (cond
 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
 338                    (save-match-data
 339                      (shell-quote-argument
 340                       (convert-standard-filename file)))
 341                    t t cmd)))
 342       (save-window-excursion
 343         (start-process-shell-command cmd nil cmd)
 344         ;;(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
 345         )
 346       (list t (format "Opened %s in external application" file)))
 347      ((consp cmd)
 348       (let ((file (convert-standard-filename file)))
 349         (eval cmd))
 350       (list t (format "Opened %s in external application" file)))
 351      (t (list nil (format "Don't know how to handle %s" file))))
 352     ))
 353
 354
 355 (define-derived-mode sex-file-mode nil
 356   "External"
 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))
 362
 363
 364 (defvar sex-old-url-insert-file-contents nil)
 365 (defvar sex-old-url-handler-mode nil)
 366
 367 ;;;###autoload
 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.)
 375
 376 This affects all functions that opens files, like `find-file',
 377 `find-file-noselect' etc.
 378
 379 However it does not affect files opened through Emacs client.
 380
 381 Urls can also be handled, see `sex-handle-urls'.
 382
 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'."
 387
 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'.
 391   nil
 392   :group 'sex
 393   :global t
 394   ;; fix-me: better list handling
 395   (if sex-mode
 396       (progn
 397         (require 'org)
 398         (dolist (rec (sex-get-apps))
 399           (let* ((ext (car rec))
 400                  (app (cdr rec))
 401                  (patt (when (and (stringp ext)
 402                                   (not (eq app 'emacs)))
 403                          (concat "\\." ext "\\'"))))
 404             (unless patt
 405               (when (eq ext t)
 406                 (setq patt (concat ".*\\'"))))
 407             (when patt
 408               (unless (eq ext t)
 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
 422             (url-handler-mode 1)
 423             ;;(message "after url-handler-mode 1")
 424             )))
 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))))
 441
 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)
 450               nil
 451             ,open-alist)))
 452      (when sex-mode (sex-mode -1))
 453      (sex-mode 1)
 454      ,@body
 455      (setq sex-with-temporary-file-apps nil)
 456      (unless old-sex-mode (sex-mode -1))))
 457
 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"))
 460
 461 (provide 'sex-mode)
 462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 463 ;;; sex-mode.el ends here