;;; emacs.jl --- Interaction with emacs

;; Copyright (C) 2009 Jeremy Hankins
;; $Date: 2009-10-23 14:49:04 -0500 (Fri, 23 Oct 2009) $
;; $Revision: 908 $

;; Author: Jeremy Hankins <nowan at nowan dot org>
;; Keywords: emacs

;;; GPL blurb

;; This file 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 file 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.

;;; Commentary

;; This module is designed to allow greater integration between emacs
;; and sawfish.  Using `emacs-eval' you can run emacs lisp, with
;; `emacs-edit' you can have emacs pop up a frame to edit a file, or
;; (if it's already displayed) pop you to that window.  It's meant to
;; be fairly open-ended; have fun.
;;
;; NOTE: One possible concern is deadlocks between sawfish and emacs.
;; If (as I do) you also call sawfish code from emacs the potential
;; exists for sawfish to call emacs code which calls sawfish code,
;; with obvious results.  To prevent this `emacs-eval' checks to see
;; if `running-from-emacs-p' is set, and if it is refuses to call
;; emacs code.  It also sets `running-from-sawfish-p' in any emacs
;; expression that it runs so that a similar check can be done on the
;; emacs side.

;;; Code:

(define-structure emacs

    (export emacs-path
            emacsclient-path
            emacs-eval
	    emacs-running-p
            emacs-start
	    emacs-run
	    emacs-edit
	    emacs-files
	    emacs-display-buffer
	    emacs-buffers-menu
	    emacs-call-info
	    running-from-emacs-p)

    (open rep
	  rep.system
	  rep.io.processes
	  rep.io.timers
	  rep.io.files
	  sawfish.wm
	  sawfish.wm.util.display-window)

  (defvar emacs-path "/usr/bin/emacs"
    "Where to find the executable for emacs.")

  (defvar emacs-check "[ ! -e /tmp/emacs`id -u`/server ]"
    "Bourne shell expression to use to make sure the emacs socket
does not yet exist -- it should evaluate to false if the socket
exists.  If nil the check will be disabled.")

  (defvar emacsclient-path "/usr/bin/emacsclient"
    "Where to find the emacsclient executable.")

  (defvar emacs-wait-secs 10
    "How long (in seconds) to wait for the emacs server to start
before giving up.")

  (defvar running-from-emacs-p nil
    "Indicates whether sawfish is currently running on behalf of
emacs, to prevent deadlocks.")

  (define (emacs-eval exp #!optional style)
    "Have the emacs server run the provided expression.  If
`style' is 'parse then emacsclient will be run synchronously and
`running-from-sawfish-p' will be set to 't -- any emacs code
which interacts with sawfish should check this to prevent
deadlocks.  Any output will be read as a lisp object and
returned.  If `style' is 'frame then emacsclient will be asked to
create a new frame.  If `style' has any other value emacsclient
will simply be run in the background."
    (if running-from-emacs-p
	(message "Refusing to call emacsclient from emacs.")
      (cond ((eq style 'parse)
	     (let* ((stream (make-string-output-stream))
		    (process (make-process stream))
		    (retval (call-process
			     process nil
			     emacsclient-path "-e"
			     (concat "(let ((running-from-sawfish-p t)) "
				     exp ")"))))
	       (if (eql retval 0)
		   (let ((s (get-output-stream-string stream)))
		     (if (eq (length s) 0)
			 nil
		       (read (make-string-input-stream s))))
		 nil)))
	    ((eq style 'frame)
	     (start-process (make-process) emacsclient-path
			    "-n" "-c" "-e" exp))
	    (t
	     (start-process (make-process) emacsclient-path
			    "-n" "-e" exp)))))


  (define (emacs-running-p)
    "Checks to see if an emacs server process is running."
    (emacs-eval "t" 'parse))

  (define (emacs-start #!optional exp style)
    "Start an emacs server process.  If the optional `exp' is
provided, call it once the emacs server is started."
    (when (not (emacs-running-p))
      ;; I really ought to rework this to report an error when the
      ;; emacs server isn't accessible, but emacs-check returns true.
      ;; XXX
      (let ((status (system (concat
			     emacs-check " && "
			     emacs-path " --daemon &"))))
	(when (and status exp)
	  (let* ((checker (make-timer
			   (lambda (timer)
			     (if (emacs-running-p)
				 (emacs-eval exp style)
			       (set-timer timer)))
			   1)))
	    (make-timer
	     (lambda ()
	       (delete-timer checker))
	     emacs-wait-secs)))
	status)))

  (define (emacs-run exp #!optional style)
    "Run `exp' in the emacs server, starting the emacs server if
necessary."
    (if (emacs-running-p)
	(emacs-eval exp style)
      (emacs-start exp style)))

  (define (emacs-files)
    "Generate a list of active emacs buffers."
    (emacs-eval
     "(delq nil
	    (mapcar (lambda (b)
		      (with-current-buffer b
			(let ((name (buffer-name))
			      (file buffer-file-name))
			  (unless
			      (or
			       ;; Don't mention internal buffers.
			       (and (string= (substring name 0 1) \" \")
				    (null file)))
			    (cons name file)))))
		    (buffer-list)))"
     'parse))

  (define (emacs-get-buffer-frame buffer)
    "Find a window displaying the given emacs buffer."
    (let ((xid (emacs-eval (concat
			    "(let ((w (get-buffer-window \"" buffer "\" t)))
			       (when w
				 (frame-parameter
				  (window-frame w)
				  'outer-window-id)))")
			   'parse)))
      (when xid
	(get-window-by-id (string->number xid)))))

  (define (emacs-display-buffer buf)
    "Display buffer in emacs, opening a new frame if the buffer is not
already being displayed."
    (let ((win (emacs-get-buffer-frame buf)))
      (if win
	  (display-window win)
	(emacs-run (concat "(switch-to-buffer \"" buf "\")")
		   'frame))))

  (define (emacs-call-info document node)
    "Call up the requested info page in emacs."
    (emacs-run (concat "(info \"(" document ")" node "\")") 'frame))

  (define (emacs-edit f)
    "Have emacs edit the file, doing the right thing if it's
already displayed."
    (let* ((file (canonical-file-name f))
	   (buf (car (car (filter (lambda (b)
				    (equal (cdr b) file))
				  (emacs-files)))))
	   (win (and buf (emacs-get-buffer-frame buf))))
      (if win
	  (display-window win)
	(system (concat
		 emacsclient-path
		 " --alternate-editor= -c '" file "' > /dev/null &")))))

  (define (emacs-buffers-menu)
    "Returns a menu of buffers open in emacs."
    (mapcar
     (lambda (i)
       (list (car i) `(emacs-display-buffer ,(car i))))
     (emacs-files)))

  )

;;; emacs.jl ends here