;;; Sdtemacs.el --- Emacs as an external text editor in SDT

;; Author: Manfred Persson <manfred.persson@telelogic.se>
;; Keywords: SDT

;;; Copyright by Telelogic AB 1996 - 1998
;;
;; 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 of the License, 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; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;;; VERSION:
;;

;;; HISTORY:
;;

;;; INSTALLATION:
;;
;; To use this package, put this file in a Lisp directory known to Emacs
;; (see `load-path'), byte-compile it, and put the line:
;;
;;                      (require 'sdtemacs)
;;
;; in your ~/.emacs file or in the file default.el in the ../lisp directory
;; of the Emacs distribution.

;;; DESCRIPTION:
;;

;;; USAGE:
;;
;; User commands:
;; --------------
;; emacs -post
;;
;; sdtemacs-connect
;; sdtemacs-disconnect
;; sdtemacs-show-organizer
;;
;; Development support:
;; --------------------
;; sdtemacs-message-hooks (message pid data)
;; sdtemacs-new-buffer-hooks
;;
;; sdtemacs-process
;; sdtemacs-send-to-tool (tool message data)
;; sdtemacs-send-reply (pid message data)
;; sdtemacs-broadcast (message data)
;;
;; buffer-ids
;; sdtemacs-status-value
;; sdtemacs-quote-string
;; sdtemacs-make-list
;; sdtemacs-sdt-boolean/emacs-boolean
;; sdtemacs-print-reply-error
;; sdtemacs-inhibit-dirty-flag
;; sdtemacs-debug
;;

;;; Code:

;;;; VARIABLES

(defvar sdtemacs-process nil)
(defvar sdtemacs-process-output "")
(defvar sdtemacs-buffers nil)
(defvar sdtemacs-buffer-id-counter 0)
(defvar sdtemacs-inhibit-dirty-flag nil)
(defvar sdtemacs-message-hooks nil)
(defvar sdtemacs-new-buffer-hooks nil)
(defvar sdtemacs-debug nil)
(defvar sdtemacs-sdtextte-command "$telelogicbin/sdtextte")
(defvar sdtemacs-external-start nil)
(defvar sdtemacs-waiting-for-reply nil)

;;;; SDT-BUFFERS

(defun sdtemacs-create-buffer-id ()
  (setq sdtemacs-buffer-id-counter (1+ sdtemacs-buffer-id-counter)))

(defun sdtemacs-add-buffer (buffer)
  (if (null (sdtemacs-get-buffer-id buffer))
      (setq sdtemacs-buffers (cons (cons buffer (sdtemacs-create-buffer-id))
                                   sdtemacs-buffers))))

(defun sdtemacs-remove-buffer (buffer)
  (if (sdtemacs-get-buffer-id buffer)
      (setq sdtemacs-buffers (delete (assq buffer sdtemacs-buffers) sdtemacs-buffers))))

(defun sdtemacs-get-buffer (id)
  (car (rassq id sdtemacs-buffers)))

(defun sdtemacs-get-buffer-id (buffer)
  (cdr (assq buffer sdtemacs-buffers)))

(defun sdtemacs-get-first-buffer ()
  (car (car sdtemacs-buffers)))

(defun sdtemacs-get-buffer-from-filename (filename)
  (sdtemacs-get-buffer-from-filename-hlp filename sdtemacs-buffers))

(defun sdtemacs-get-buffer-from-filename-hlp (filename buffers)
  (let ((buffer (car (car buffers))))
    (cond ((null buffers) nil)
          ((string-equal (buffer-file-name buffer) filename) buffer)
          (t (sdtemacs-get-buffer-from-filename-hlp filename (cdr buffers))))))

(defun sdtemacs-dirty-buffers-p ()
  (sdtemacs-dirty-buffers-p-hlp sdtemacs-buffers))

(defun sdtemacs-dirty-buffers-p-hlp (buffers)
  (let ((buffer (car (car buffers))))
    (cond ((null buffers) nil)
          ((buffer-modified-p buffer) t)
          (t (sdtemacs-dirty-buffers-p-hlp (cdr buffers))))))

(defun sdtemacs-kill-all-sdt-buffers (save-if-needed)
  (let (buffer)
    (if sdtemacs-external-start
      (while sdtemacs-buffers
        (save-excursion
          (setq buffer (sdtemacs-get-first-buffer))
          (set-buffer buffer)
          (if (not save-if-needed)
              (set-buffer-modified-p nil))
          (kill-buffer buffer)
          (if (not sdtemacs-process)
              (sdtemacs-remove-buffer buffer)))))))

;;;; TRANSLATE DATA FROM/TO SDTEMACS

;;; Status codes

(defconst sdtemacs-status-codes
          '((OK . 0) (Busy . 1) (ErrorString . 2) (ErrorCode . 3)))

(defconst sdtemacs-textdocument 33)

(defun sdtemacs-status-value (code)
  (cdr (assq code sdtemacs-status-codes)))

(defun sdtemacs-status-code (value)
  (car (rassq value sdtemacs-status-codes)))

;;;; Boolean values

(defun sdtemacs-emacs-boolean (sdt-boolean)
  (eq sdt-boolean 1))

(defun sdtemacs-sdt-boolean (emacs-boolean)
  (if emacs-boolean 1 0))

;;; Strings

(defun sdtemacs-make-list (no-of-params data)
;;; Makes a list of 'no-of-params' symbols (and the remaining string)
;; from the string 'data'
  (let (read-result)
    (cond ((<= no-of-params 0) (list data))
          (t
           (setq read-result
             (condition-case nil
               (read-from-string data)
               (error (cons nil 0))))
           (cons (car read-result)
                 (if (> (length data) (cdr read-result))
                     (sdtemacs-make-list (1- no-of-params)
                                         (substring data (cdr read-result)))
                     nil))))))

(defun sdtemacs-make-string (data)
  (cond ((symbolp data) (symbol-name data))
        ((numberp data) (number-to-string data))
        (t data)))

(defun sdtemacs-make-string-from-list (params)
;;; Makes a string of the symbols in the list 'params'.
;; The symbols are blank-separated.
  (if (null params)
      ""
      (concat
        (sdtemacs-make-string (car params))
        (if (cdr params) " " "")
        (sdtemacs-make-string-from-list (cdr params)))))

(defun sdtemacs-quote-string (string)
  (let (start)
    (setq start 0)
    (while (setq start (string-match "\\\\" string start))
      (setq string (replace-match "\\\\\\\\" nil nil string))
      (setq start (+ start 2)))
    (setq start 0)
    (while (setq start (string-match "\"" string start))
      (setq string (replace-match "\\\"" nil t string))
      (setq start (+ start 2)))
    (concat "\"" string "\"")))


;;;; TOOL HANDLING

;;; Command line switch '-post'
(setq command-switch-alist
      (cons '("-post" . sdtemacs-connect) command-switch-alist))

(defun sdtemacs-connect (&optional switch)
  "Connects Emacs to the SDT-environment.
The SDT PostMaster must be up and running.
Requires that the executable file `sdtextte' is accessible
from `load-path'.
SWITCH indicates that emacs was started from SDT."
  (interactive)
  (let ((process-file (substitute-in-file-name sdtemacs-sdtextte-command)))
    (cond (sdtemacs-process
           (error "Already connected to SDT"))
          ((not (file-exists-p process-file))
           (error "Cannot connect to SDT. File 'sdtextte' not found."))
          (t
           (setq sdtemacs-external-start switch)
           (setq sdtemacs-process (start-process "sdtemacs" nil process-file))
           (process-kill-without-query sdtemacs-process)
           (set-process-filter sdtemacs-process 'sdtemacs-message-dispatcher)
           (set-process-sentinel sdtemacs-process 'sdtemacs-process-sentinel)
           (add-hook 'kill-emacs-hook 'sdtemacs-disconnect)
           (add-hook 'kill-buffer-hook 'sdtemacs-unload-notify t)
           (add-hook 'find-file-hooks 'sdtemacs-load-notify)
           (add-hook 'first-change-hook 'sdtemacs-dirty-notify)
           (add-hook 'after-save-hook 'sdtemacs-save-notify)
           (add-hook 'before-revert-hook 'sdtemacs-unload-notify t)
           (sleep-for 1)))))

(defun sdtemacs-disconnect ()
  "Disconnects Emacs from the SDT-environment."
  (interactive)

  (cond ((null sdtemacs-process)
         (error "Not connected to SDT"))
        (t
         (sdtemacs-kill-all-sdt-buffers (interactive-p))
         (set-process-sentinel sdtemacs-process nil)
         (sdtemacs-send-exit)
         (sdtemacs-cleanup))))

(defun sdtemacs-cleanup ()
  (remove-hook 'kill-emacs-hook 'sdtemacs-disconnect)
  (remove-hook 'kill-buffer-hook 'sdtemacs-unload-notify)
  (remove-hook 'find-file-hooks 'sdtemacs-load-notify)
  (remove-hook 'first-change-hook 'sdtemacs-dirty-notify)
  (remove-hook 'after-save-hook 'sdtemacs-save-notify)
  (remove-hook 'before-revert-hook 'sdtemacs-unload-notify)
  (setq sdtemacs-process nil)
  (setq sdtemacs-buffer-id-counter 0)
  (setq sdtemacs-process-output ""))

(defun sdtemacs-handle-sestop (pid data)
;;; data = <force-exit>(bool)
  (let* ((params (sdtemacs-make-list 1 data))
         (force-exit (sdtemacs-emacs-boolean (nth 0 params)))
         cancel-exit)

    (setq cancel-exit (and (sdtemacs-dirty-buffers-p)
                           (not force-exit)))
    (sdtemacs-send-reply pid
                         'SESTOPREPLY
                         (list (sdtemacs-status-value 'OK)
                               (sdtemacs-sdt-boolean cancel-exit)))
    (if (not cancel-exit)
      (progn
        (sdtemacs-kill-all-sdt-buffers t)
        (sdtemacs-disconnect)
        (if sdtemacs-external-start
          (kill-emacs))))))

(defun sdtemacs-process-sentinel (process event)
  (if (not (eq (process-status sdtemacs-process) 'run))
    (progn
       (beep)
       (message "The SDT-connection has been broken.")
       (sdtemacs-cleanup)
       (sdtemacs-kill-all-sdt-buffers t))))

(defun sdtemacs-message-dispatcher (process output)
  (let (start
        end
        (continue-search t)
        pm-message
        params
        message
        pid
        data)

    (setq sdtemacs-process-output (concat sdtemacs-process-output output))
    (while continue-search
      (setq start (string-match "PmMessage " sdtemacs-process-output))
      (setq end (string-match "\0" sdtemacs-process-output start))
      (cond ((null start)
  	     (sdtemacs-handle-internal-message sdtemacs-process-output)
             (setq sdtemacs-process-output "")
             (setq continue-search nil))
            ((> start 0)
	     (sdtemacs-handle-internal-message (substring sdtemacs-process-output 0 start))
             (setq sdtemacs-process-output (substring sdtemacs-process-output start))
             (setq continue-search t))
            ((null end)
             (setq continue-search nil)
             (sdtemacs-wait-for-process-output))
            (t
             (setq pm-message (substring sdtemacs-process-output start end))
             (if sdtemacs-debug (message (concat "SDTEMACS >>> " pm-message)))
             (setq sdtemacs-process-output (substring sdtemacs-process-output (1+ end)))
             (setq continue-search (not (zerop (length sdtemacs-process-output))))

             ; Extract message, pid and data from pm-message
             (setq params (sdtemacs-make-list 3 pm-message))
             (setq message (nth 1 params))
             (setq pid (nth 2 params))
             (setq data (nth 3 params))

             (cond ((eq message 'SESTOP) (sdtemacs-handle-sestop pid data))
                   ((eq message 'SEOPFAILED) (sdtemacs-handle-seopfailed pid data))
                   ((eq message 'SETECREATEDIAGRAM) (sdtemacs-handle-setecreatediagram pid data))
                   ((eq message 'SELOAD) (sdtemacs-handle-seload pid data))
                   ((eq message 'SETELOADCOPY) (sdtemacs-handle-seteloadcopy pid data))
                   ((eq message 'SESHOW) (sdtemacs-handle-seshow pid data))
                   ((eq message 'SESAVE) (sdtemacs-handle-sesave pid data))
                   ((eq message 'SEUNLOAD) (sdtemacs-handle-seunload pid data))
                   ((eq message 'SEPOPUPREPLY) (sdtemacs-handle-sepopupreply pid data))
                   ((eq message 'SETESHOWPOSITION) (sdtemacs-handle-seteshowposition pid data))
                   ((eq message 'SETESELECTTEXT) (sdtemacs-handle-seteselecttext pid data))
                   ((eq message 'SESHOWREFREPLY) (sdtemacs-handle-seshowrefreply pid data)))

             (sdtemacs-run-message-hooks sdtemacs-message-hooks message pid data)

             (if (sdtemacs-reply-message-p message)
               (setq sdtemacs-waiting-for-reply nil)))))

    (if sdtemacs-waiting-for-reply
      (sdtemacs-wait-for-process-output))))

(defun sdtemacs-run-message-hooks (hooks message pid data)
  (if hooks
    (progn
      (funcall (car hooks) message pid data)
      (sdtemacs-run-message-hooks (cdr hooks) message pid data))))

(defun sdtemacs-send-to-process (input)
  (if sdtemacs-debug (message (concat input " >>> SDTEMACS")))
  (process-send-string sdtemacs-process (concat input "\0"))
  (process-send-eof sdtemacs-process))

(defun sdtemacs-send-to-tool (tool message data)
  (sdtemacs-send-to-process
    (sdtemacs-make-string-from-list (append (list 'SendMessageToTool tool message) data)))
  (setq sdtemacs-waiting-for-reply t)
  (sdtemacs-wait-for-process-output))

(defun sdtemacs-send-reply (pid message data)
  (sdtemacs-send-to-process
    (sdtemacs-make-string-from-list (append (list 'SendReply pid message) data))))

(defun sdtemacs-broadcast (message data)
  (sdtemacs-send-to-process
    (sdtemacs-make-string-from-list (append (list 'BroadcastMessage message) data))))

(defun sdtemacs-send-exit ()
  (sdtemacs-send-to-process
    (sdtemacs-make-string 'ExitTool))
  (sdtemacs-wait-for-process-output))

(defun sdtemacs-wait-for-process-output ()
  (while (and sdtemacs-process
              (null (accept-process-output sdtemacs-process 1)))))

(defun sdtemacs-reply-message-p (message)
  (string-match "REPLY" (symbol-name message)))

(defun sdtemacs-handle-seopfailed (pid data)
;;; data = <message-id> <error-class> <pid> <parameters> <error-message>
  (sdtemacs-handle-internal-message (concat "OperationFailed " data)))

(defun sdtemacs-handle-internal-message (data)
  (let* ((params (sdtemacs-make-list 1 data))
         (message (nth 0 params)))

    (if (not (eq message 'ExitToolReply))
      (progn
        (beep)
        (cond ((eq message 'NoSuchMessage) (message "SDT error: Non-existent message."))
              ((eq message 'NoSuchTool) (message "SDT error: Non-existent tool."))
              ((eq message 'CouldNotSend) (message "SDT error: Could not send message."))
              ((eq message 'ToolNotExecuting) (message "SDT error: Tool not executing."))
              ((eq message 'OperationFailed) (message (concat "SDT error: " data)))
              (t (message (concat "SDT-internal message: " data))))))))

(defun sdtemacs-show-organizer ()
  "Makes the SDT Organizer pop up.
The Organizer must be up and running."
  (interactive)
  (if (null sdtemacs-process)
    (error "Not connected to SDT")
    (sdtemacs-send-to-tool 'SET_ORGANIZER
                           'SEPOPUP
                           nil)))

(defun sdtemacs-handle-sepopupreply (pid data)
;;; data = <status-code>(integer) [<error-string>(QuotedString)|<error-code>(integer)]
  (let* ((params (sdtemacs-make-list 2 data))
         (status-code (sdtemacs-status-code (nth 0 params)))
         (error (sdtemacs-make-string (nth 1 params))))

    (if (not (eq status-code 'OK))
        (sdtemacs-print-reply-error "Could not pop up tool." status-code error))))

(defun sdtemacs-print-reply-error (error-message status-code error)
  (beep)
  (cond ((eq status-code 'Busy)
         (message (concat error-message " Server is busy. " error)))
        ((eq status-code 'ErrorString)
         (message (concat error-message " Reason: " error)))
        ((eq status-code 'ErrorCode)
         (message (concat error-message " Error-code: " error)))))

;;;; DOCUMENT HANDLING
  
(defun sdtemacs-get-file (filename)
; Returns buffer containing file 'filename'
; Load file if necessary
  (let ((buffer (get-file-buffer filename)))
    (cond ((and buffer
                (null (sdtemacs-get-buffer-id buffer))
                sdtemacs-process)
           (save-excursion
              (set-buffer buffer)
              (sdtemacs-load-notify)))
          ((null buffer)
           (setq buffer (find-file-noselect filename))))
    buffer))

(defun sdtemacs-handle-setecreatediagram (pid data)
;;; data = <document-type>(integer) <document-name>(QuotedString)
  (let* ((params (sdtemacs-make-list 2 data))
         (type (nth 0 params))
         (doc-name (sdtemacs-make-string (nth 1 params)))
         buffer
         buffer-id)

    (setq buffer (generate-new-buffer doc-name))
    (save-excursion
      (set-buffer buffer)
      (sdtemacs-load-notify))
    (setq buffer-id (sdtemacs-get-buffer-id buffer))
    (sdtemacs-send-reply pid
                         'SETECREATEDIAGRAMREPLY
                         (list (sdtemacs-status-value 'OK)
                               buffer-id))))

(defun sdtemacs-handle-seload (pid data)
;;; data = <filename>(QuotedString)
  (let* ((params (sdtemacs-make-list 1 data))
         (filename (sdtemacs-make-string (nth 0 params)))
         (doc-name (file-name-sans-extension (file-name-nondirectory filename)))
         buffer
         (status-code 'OK)
         error-message)

    (cond ((not (file-exists-p filename))
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot read file "
                                       filename
                                       ".\r\n"
                                       "File not found.")))
          ((not (file-readable-p filename))
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot read file "
                                       filename
                                       ".\r\n"
                                       "File access restrictions.")))
          (t
           (setq buffer (sdtemacs-get-file filename))))

    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SELOADREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-get-buffer-id buffer)
                                   sdtemacs-textdocument
                                   (sdtemacs-quote-string doc-name)))
        (sdtemacs-send-reply pid
                             'SELOADREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-handle-seteloadcopy (pid data)
;;; data = <filename>(QuotedString) <document-type>(integer) <document-name>(QuotedString)
  (let* ((params (sdtemacs-make-list 3 data))
         (filename (sdtemacs-make-string (nth 0 params)))
         (doc-type (nth 1 params))
         (doc-name (sdtemacs-make-string (nth 2 params)))
         buffer
         buffer-id
         (status-code 'OK)
         error-message)

    (cond ((not (file-exists-p filename))
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot read file "
                                       filename
                                       ".\r\n"
                                       "File not found.")))
          ((not (file-readable-p filename))
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot read file "
                                       filename
                                       ".\r\n"
                                       "File access restrictions.")))
          (t
           (setq buffer (generate-new-buffer doc-name))
           (save-excursion
             (set-buffer buffer)
             (setq sdtemacs-inhibit-dirty-flag t)
             (insert-file-contents filename)
             (setq sdtemacs-inhibit-dirty-flag nil)
             (set-buffer-modified-p nil)
             (sdtemacs-load-notify))
           (setq buffer-id (sdtemacs-get-buffer-id buffer))))

    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SETELOADCOPYREPLY
                             (list (sdtemacs-status-value status-code)
                                   buffer-id))
        (sdtemacs-send-reply pid
                             'SETELOADCOPYREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-handle-seshow (pid data)
;;; data = <bufId>(integer) [<pagename>(?)]
  (let* ((buffer-id (string-to-number data))
         (buffer (sdtemacs-get-buffer buffer-id))
         (status-code 'OK)
         error-message)

    ; Pop up Emacs and show the buffer
    (cond ((null buffer)
           (setq status-code 'ErrorString)
           (setq error-message "Invalid document buffer id."))
	  (t
           (switch-to-buffer buffer)
           (raise-frame (window-frame (get-buffer-window buffer)))))

    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SESHOWREPLY
                             (list (sdtemacs-status-value status-code)))
        (sdtemacs-send-reply pid
                             'SESHOWREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-handle-sesave (pid data)
;;; data = <bufId>(integer) [<filename>(QuotedString)]
  (let* ((params (sdtemacs-make-list 2 data))
         (buffer-id (nth 0 params))
         (filename (nth 1 params))
         (buffer (sdtemacs-get-buffer buffer-id))
         (buffer-filename (buffer-file-name buffer))
         file-to-write
         (status-code 'OK)
         error-message)

    (setq file-to-write
          (if (null filename)
              buffer-filename
              (sdtemacs-make-string filename)))

    (cond ((null buffer)
           (setq status-code 'ErrorString)
           (setq error-message "Invalid document buffer id."))
          ((null file-to-write)
           (setq status-code 'ErrorString)
           (setq error-message "Document is new. Filename is missing."))
          ((> (length file-to-write) 255)
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot save file "
                                       file-to-write
                                       ".\r\n"
                                       "Filename too long.")))
          ((not (file-writable-p file-to-write))
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot save file "
                                       file-to-write
                                       ".\r\n"
                                       "File access restrictions.")))
          ((file-directory-p file-to-write)
           (setq status-code 'ErrorString)
           (setq error-message (concat "Cannot save file."
                                       "\r\n"
                                       file-to-write
                                       " is a directory.")))
          ((or (not (equal file-to-write buffer-filename))
               (buffer-modified-p buffer))
           (save-excursion
             (set-buffer buffer)
             (write-file file-to-write))))
           
    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SESAVEREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-sdt-boolean t)))
        (sdtemacs-send-reply pid
                             'SESAVEREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-handle-seunload (pid data)
;;; data = <bufId>(integer) <forceUnload>(bool)
  (let* ((params (sdtemacs-make-list 2 data))
         (buffer-id (nth 0 params))
         (force-unload (sdtemacs-emacs-boolean (nth 1 params)))
         (buffer (sdtemacs-get-buffer buffer-id))
         (status-code 'OK)
         error-message)

    (cond ((null buffer)
           (setq status-code 'ErrorString)
           (setq error-message "Invalid document buffer id."))
          ((and (buffer-modified-p buffer)
                (not force-unload))
           (setq status-code 'ErrorString)
           (setq error-message "Document is changed."))
          (t
           (save-excursion
             (set-buffer buffer)
             (set-buffer-modified-p nil)
             (kill-buffer buffer))))
           
    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SEUNLOADREPLY
                             (list (sdtemacs-status-value status-code)))
        (sdtemacs-send-reply pid
                             'SEUNLOADREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-load-notify ()
  (let (buffer-id
        doc-name)
    (if (sdtemacs-add-buffer (current-buffer))
      (progn
        (setq buffer-id (sdtemacs-get-buffer-id (current-buffer)))
        (setq doc-name
              (if buffer-file-name
                 (file-name-sans-extension (file-name-nondirectory buffer-file-name))
                 (buffer-name)))
        (if (and buffer-file-name
                 (file-exists-p buffer-file-name))
            (sdtemacs-broadcast 'SELOADNOTIFY
                                (list buffer-id
                                      (sdtemacs-quote-string buffer-file-name)
                                      sdtemacs-textdocument
                                      (sdtemacs-quote-string doc-name)))
            (sdtemacs-broadcast 'SETENEWNOTIFY
                                (list buffer-id
                                      sdtemacs-textdocument
                                      (sdtemacs-quote-string doc-name))))
        (run-hooks 'sdtemacs-new-buffer-hooks)))))

(defun sdtemacs-dirty-notify ()
  (let ((buffer-id (sdtemacs-get-buffer-id (current-buffer))))
    (if (and buffer-id
             (not sdtemacs-inhibit-dirty-flag))
        (sdtemacs-broadcast 'SEDIRTYNOTIFY
                            (list buffer-id)))))

(defun sdtemacs-unload-notify ()
  (let ((buffer-id (sdtemacs-get-buffer-id (current-buffer))))
    (if buffer-id
      (progn
        (sdtemacs-remove-buffer (current-buffer))
        (sdtemacs-broadcast 'SEUNLOADNOTIFY
                            (list buffer-id))))))

(defun sdtemacs-save-notify ()
  (let ((buffer-id (sdtemacs-get-buffer-id (current-buffer))))
    (if buffer-id
        (sdtemacs-broadcast 'SESAVENOTIFY
                            (list buffer-id
                                  (sdtemacs-quote-string buffer-file-name))))))
;Otherwise: if "save-as" on a previously unbound file: new(load)-notify? How to determine?

;;;; DOCUMENT HANDLING

(defun sdtemacs-get-sdtref-at-point ()
  (let ((ref-start "#SDTREF")
        (start 0)
        (end 0))
    (save-excursion
      (if (not (looking-at ref-start))
        (search-backward "#" nil t))
      (if (looking-at ref-start)
        (progn
          (setq start (point))
          (forward-char (length ref-start))
          (read (current-buffer))
          (setq end (point)))))
    (if (and (>= (point) start)
             (<= (point) end))
	(buffer-substring start end))))

(defun sdtemacs-make-reference-alist (sdt-reference)
;;; In: an SDT reference (string):
;; "#SDTREF(<refType>(String), <filename>(QuotedString) | -b <bufId>(integer)
;; and if refType="TEXT":
;; [, <line>(integer) ][, <column>(integer)])
;; Returns an association list:
;; If refType="TEXT":
;; (ref-type filename|buffer-id [line] [column])
;; otherwise:
;; (ref-type)
  (let (reference
        ref-type
        filename-exist)

    (while (string-match "," sdt-reference)
      (setq sdt-reference (replace-match " " nil nil sdt-reference)))
    (setq reference (nth 0 (sdtemacs-make-list 1 (substring sdt-reference 7))))
    (setq ref-type (nth 0 reference))
    (cond ((eq ref-type 'TEXT)
           (setq filename-exist (not (eq (nth 1 reference) '-b)))
           (delete nil (list (cons 'ref-type ref-type)
                             (if filename-exist
                                 (cons 'filename (sdtemacs-make-string (nth 1 reference)))
                                 (cons 'buffer-id (nth 2 reference)))
                             (if filename-exist
                                 (if (nth 2 reference)
                                     (cons 'line (nth 2 reference)))
                                 (if (nth 3 reference)
                                     (cons 'line (nth 3 reference))))
                             (if filename-exist
                                 (if (nth 3 reference)
                                     (cons 'column (nth 3 reference)))
                                 (if (nth 4 reference)
                                     (cons 'column (nth 4 reference)))))))
          (t (list (cons 'ref-type ref-type))))))

(defun sdtemacs-show-text-reference (reference)
  (let ((filename (cdr (assq 'filename reference)))
        (bufId (cdr (assq 'buffer-id reference)))
        (line (cdr (assq 'line reference)))
        (column (cdr (assq 'column reference)))
        buffer)

    (cond ((and filename (not (file-exists-p filename)))
           (error (concat "Cannot show reference. "
                          "File "
                          filename
                          " not found.")))
          ((and filename (not (file-readable-p filename)))
           (error (concat "Cannot show reference. "
                          "File "
                          filename
                          " not readable.")))
          (filename
           (setq buffer (sdtemacs-get-file filename)))
          ((null (setq buffer (sdtemacs-get-buffer bufId)))
           (error "Cannot show reference. Invalid buffer id.")))
     (switch-to-buffer-other-window buffer)
     (if line
         (if (sdtemacs-move-to-position line (or column 1))
             (recenter)
             (error "Cannot show reference. Invalid position.")))))

(defun sdtemacs-show-reference ()
  "Shows an SDT reference."
  (interactive)
  (let* ((sdtref (sdtemacs-get-sdtref-at-point))
         (reference (if sdtref (sdtemacs-make-reference-alist sdtref))))
    (cond ((null sdtref)
           (error "No SDT reference found"))
          ((eq (cdr (assq 'ref-type reference)) 'TEXT)
           (sdtemacs-show-text-reference reference))
          ((null sdtemacs-process)
           (error "Not connected to SDT"))
          (t (sdtemacs-send-to-tool 'SET_ORGANIZER
                                    'SESHOWREF
                                    (list (sdtemacs-quote-string sdtref)
                                          (sdtemacs-sdt-boolean nil)))))))

(defun sdtemacs-handle-seshowrefreply (pid data)
;;; data = <status-code>(integer) [<error-string>(QuotedString)|<error-code>(integer)]
  (let* ((params (sdtemacs-make-list 2 data))
         (status-code (sdtemacs-status-code (nth 0 params)))
         (error (sdtemacs-make-string (nth 1 params))))

    (if (not (eq status-code 'OK))
        (sdtemacs-print-reply-error "Could not show SDT reference." status-code error))))

(defun sdtemacs-move-to-position (line column)
  (let (start-of-line-pos
        noOfCharsOnLine)
    (cond ((or (< line 1) (< column 1))
           nil)
          ((zerop (goto-line line))
           (save-excursion
             (setq start-of-line-pos (point))
             (end-of-line)
             (setq noOfCharsOnLine (1+ (- (point) start-of-line-pos))))
           (if (<= column noOfCharsOnLine)
             (progn
               (forward-char (1- column))
               t)
             (end-of-line)
             nil))
          (t nil))))

(defun sdtemacs-handle-seteshowposition (pid data)
;;; data = <bufId>(integer) <line>(integer) <column>(integer)
  (let* ((params (sdtemacs-make-list 3 data))
         (buffer-id (nth 0 params))
         (line (nth 1 params))
         (column (nth 2 params))
         (buffer (sdtemacs-get-buffer buffer-id))
         (status-code 'OK)
         error-message)

    (cond ((null buffer)
           (setq status-code 'ErrorString)
           (setq error-message "Invalid document buffer id."))
	  (t
           (switch-to-buffer buffer)
           (if (sdtemacs-move-to-position line column)
             (progn
               ; Pop up Emacs
               (recenter)
               (raise-frame (window-frame (get-buffer-window buffer))))
             (setq status-code 'ErrorString)
             (setq error-message (concat "Invalid position: (" line "," column ")")))))

    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SETESHOWPOSITIONREPLY
                             (list (sdtemacs-status-value status-code)))
        (sdtemacs-send-reply pid
                             'SETESHOWPOSITIONREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(defun sdtemacs-handle-seteselecttext (pid data)
;;; data = <bufId>(integer) <line1>(integer) <column1>(integer) <line2>(integer) <column2>(integer)
  (let* ((params (sdtemacs-make-list 5 data))
         (buffer-id (nth 0 params))
         (line1 (nth 1 params))
         (column1 (nth 2 params))
         (line2 (nth 3 params))
         (column2 (nth 4 params))
         (buffer (sdtemacs-get-buffer buffer-id))
         (status-code 'OK)
         error-message)

    (cond ((null buffer)
           (setq status-code 'ErrorString)
           (setq error-message "Invalid document buffer id."))
	  (t
           (switch-to-buffer buffer)
           ; First position - mark
           (if (sdtemacs-move-to-position line1 column1)
             (progn
               (set-mark (point))
               ; Second position - point
               (if (sdtemacs-move-to-position line2 column2)
                 (progn
                   (recenter)
                   (raise-frame (window-frame (get-buffer-window buffer))))
                 (setq status-code 'ErrorString)))
             (setq status-code 'ErrorString))))

    (if (eq status-code 'ErrorString)
        (setq error-message (concat "Invalid range: [("
                                    line1 "," column1
                                    "),("
                                    line2 "," column2
                                    ")]")))

    (if (eq status-code 'OK)
        (sdtemacs-send-reply pid
                             'SETESELECTTEXTREPLY
                             (list (sdtemacs-status-value status-code)))
        (sdtemacs-send-reply pid
                             'SETESELECTTEXTREPLY
                             (list (sdtemacs-status-value status-code)
                                   (sdtemacs-quote-string error-message))))))

(provide 'sdtemacs)
;;; sdtemacs ends here