;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  This paw.el defines paw-mode v. 1.2.3   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                           ;;;
;;;  Put this paw.el file into your ~/bin directory (or somewhere),           ;;;
;;;  and include a line like:                                                 ;;;
;;;      (load-file "~/bin/paw.el")                                           ;;;
;;;  in your `.emacs' (or `.xemacs/init.el') file.                            ;;;
;;;                                                                           ;;;
;;;  If you want to make it run (slightly) faster, byte compile it:           ;;;
;;;      M-x byte-compile-file RET ~/bin/paw.el                               ;;;
;;;  And include:                                                             ;;;
;;;      (load-file "~/bin/paw.elc")                                          ;;;
;;;  instead.                                                                 ;;;
;;;                                                                           ;;;
;;;  `paw-mode' will be automatically invoked on all .kumac files,            ;;;
;;;  but you can start it explicitly on an existing buffer with:              ;;;
;;;      M-x paw-start   (a.k.a. control-c p)                                 ;;;
;;;  or on a new (temporary) buffer with:                                     ;;;
;;;      M-x paw                                                              ;;;
;;;  (The temporary buffer may be later saved.)                               ;;;
;;;                                                                           ;;;
;;;  The keystroke control-j (or meta-RET) evaluates a line; the output       ;;;
;;;  goes into the buffer "*[buffer-name] PAW output*" and                    ;;;
;;;  "*[buffer-name] PAW log*" (more permanantly).  If you don't want to      ;;;
;;;  overwrite the contents of the output buffer, type a control-u            ;;;
;;;  just before the control-j.                                               ;;;
;;;                                                                           ;;;
;;;  The keystroke control-c a (two keys) sends the ever-popular SIGINT.      ;;;
;;;                                                                           ;;;
;;;  You can use the PAW help system with this if you set                     ;;;
;;;      kuip/set/host_pager 'cat'                                            ;;;
;;;  in your pawlogon.kumac.                                                  ;;;
;;;                                                                           ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;  USER VARIABLES   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar paw-command-line "/nfs/cern/pro/bin/pawX11"
  "The UNIX path to the PAW command.")

(defvar paw-initial-keysequence "\n"
  "That which is typed by default, at the beginning of every PAW session.")

(defvar paw-start-process 'ask
  "If nil, you will have to `paw-start' (C-c r) on your own.  If 'ask,
you will be prompted. If 'always, a PAW session will always start up
in paw-mode.")

(defvar paw-popup-output t
  "If t, paw-start will pop-up a window displaying the output of commands.")

(defvar paw-help-takes-over t
  "If t, entering the PAW help system makes the output buffer your
only window (so you can read and scroll it with `scroll-other-window'
from the minibuffer).")

;;;  INTERNAL VARIABLES   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq auto-mode-alist (append '(("\\.kumac\\'" . paw-mode)) auto-mode-alist))

(defvar paw-mode-map () "Keymap used in paw-mode buffers.")
(if (not paw-mode-map)
    (progn
      (setq paw-mode-map (make-sparse-keymap))
      (define-key paw-mode-map "\C-j" 'paw-execute-line)
      (define-key paw-mode-map "\C-cw" 'paw-execute-region)
      (define-key paw-mode-map "\C-c:" 'paw-execute)
      (define-key paw-mode-map "\C-ca" 'paw-abort-command)

      (define-key paw-mode-map "\C-cp" 'paw-start)
      (define-key paw-mode-map "\C-ck" 'paw-split-work)
      (define-key paw-mode-map "\C-co" 'paw-split-output)
      (define-key paw-mode-map "\C-cl" 'paw-split-log)
      ) ; end progn
  ) ; end if

(defvar paw-log-mode-map () "Keymap used in paw-mode buffers.")
(if (not paw-log-mode-map)
    (progn
      (setq paw-log-mode-map (make-sparse-keymap))
      (define-key paw-log-mode-map "\C-c:" 'paw-execute)
      (define-key paw-log-mode-map "\C-ca" 'paw-abort-command)

      (define-key paw-log-mode-map "\C-cp" 'paw-start)
      (define-key paw-log-mode-map "\C-ck" 'paw-split-work)
      (define-key paw-log-mode-map "\C-co" 'paw-split-output)
      (define-key paw-log-mode-map "\C-cl" 'paw-split-log)
      ) ; end progn
  ) ; end if

(defvar paw-mode-abbrev-table nil "Abbrev table used in paw-mode buffers.")

(defvar paw-mode-syntax-table nil "Syntax table used in paw-mode buffers.")
(if (not paw-mode-syntax-table)
    (progn
      (setq paw-mode-syntax-table (make-syntax-table))
      (modify-syntax-entry ?\' "\"" paw-mode-syntax-table)
      (modify-syntax-entry ?/ "_")
      (define-abbrev-table 'paw-mode-abbrev-table ())
      ) ; end progn
  ) ; end if

(defvar paw-font-lock-keywords
  '(
    ("^[ \t]*\\(\\*.*\\)$" 1 font-lock-comment-face)
    ("\"[^\"]*\"" . font-lock-string-face)
    ("'[^']*'" . font-lock-string-face)
    ("^[ \t]*\\([^ \t\\*][^ \t]*\\)" 1 font-lock-keyword-face)
    ("\\(\\$[^(]+\\)(" 1 font-lock-function-name-face)
    )
  )

(defvar paw-log-font-lock-keywords
  '(
    ("^[ \t]*\\(\\*.*\\)$" 1 font-lock-comment-face)
    ("\"[^\"]*\"" . font-lock-string-face)
    ("'[^']*'" . font-lock-string-face)
    ("^\\(PAW >\\)[ \t]*\\([^ \t]*\\)" (1 font-lock-warning-face) (2 font-lock-keyword-face))
    ("^PAW >" . font-lock-warning-face)
    ("^----> .*$" . font-lock-warning-face)
    )
  )

(defvar paw-history nil "History of PAW commands entered in the minibuffer.")
(defvar paw-query-history nil "History of responses to PAW queries.")

(defvar paw-status nil "This is just to avoid compilation warnings---
it's really a local variable, local to the buffer running paw-mode.")

;;;  USER FUNCTIONS   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun paw-mode ()
  "Major mode for editing paw commands and `.kumac' files in Emacs.
Commands:
\\{paw-mode-map}"
  (interactive)

  (kill-all-local-variables)
  (use-local-map paw-mode-map)

  (setq major-mode 'paw-mode)
  (setq mode-name "PAW")

  (make-local-variable 'paw-status)
  (setq paw-status "no process")
  (setq mode-line-process '(":" paw-status))

  (setq local-abbrev-table paw-mode-abbrev-table)
  (set-syntax-table paw-mode-syntax-table)
  
  (make-local-variable 'comment-start)
  (setq comment-start "*")
  (make-local-variable 'comment-end)
  (setq comment-end "")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "^[ \t]*\\*")

  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(paw-font-lock-keywords t))

  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'paw-indent-line)

  (if (not (paw-find-node 'workbuffer (current-buffer)))
      (progn
	(if (eq paw-start-process 'always) (paw-start))
	(if (and (eq paw-start-process 'ask)
		 (y-or-n-p "Start a PAW process? ")) (paw-start))
	) ; end progn
    ) ; end if

  )

(defun paw-log-mode ()
  "Major mode for displaying PAW output.
Commands:
\\{paw-log-mode-map}"
  (interactive)

  (kill-all-local-variables)
  (use-local-map paw-log-mode-map)

  (setq major-mode 'paw-log-mode)
  (setq mode-name "PAW output")

  (setq local-abbrev-table paw-mode-abbrev-table)
  (set-syntax-table paw-mode-syntax-table)

  (make-local-variable 'comment-start)
  (setq comment-start "*")
  (make-local-variable 'comment-end)
  (setq comment-end "")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "^[ \t]*\\*")

  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(paw-log-font-lock-keywords t))
  )

(defvar paw-process-list () "List of PAW processes, each associated with a buffer.")

(defun paw ()
  "Start a new PAW process with a tmp.kumac buffer."
  (interactive)
  (let ((tmp paw-start-process))
    (setq paw-start-process nil)
    (switch-to-buffer (generate-new-buffer "tmp.kumac"))
    (paw-mode)
    (paw-start)
    (setq paw-start-process tmp)
    ) ; end let
  )

(defun paw-split (buffer-label)
  "Put some buffer in the other window."
  
  (let (buffer)
    (setq buffer (plist-get (paw-find-node 'workbuffer (current-buffer)) buffer-label))
    (if (null buffer)
	(setq buffer (plist-get (paw-find-node 'outputbuffer (current-buffer)) buffer-label)))
    (if (null buffer)
	(setq buffer (plist-get (paw-find-node 'logbuffer (current-buffer)) buffer-label)))
    (if (bufferp buffer)
	(save-excursion
	  (if (one-window-p) (split-window))
	  (other-window 1)
	  (if (not (eq buffer (current-buffer))) (switch-to-buffer buffer))
	  (other-window -1)
	  ) ; end save-excursion
      ) ; end if
    ) ; end let
  )
(defun paw-split-work ()
  "Put the work buffer in the other window."
  (interactive)
  (paw-split 'workbuffer)
  )

(defun paw-split-output ()
  "Put the output buffer in the other window."
  (interactive)
  (paw-split 'outputbuffer)
  )

(defun paw-split-log ()
  "Put the log buffer in the other window."
  (interactive)
  (paw-split 'logbuffer)
  )

(defun paw-start ()
  "Start a new PAW process, and associate it with this buffer."
  (interactive)

  (if (paw-find-node 'workbuffer (current-buffer))
      (error "This buffer already has a PAW process associated with it."))

  ; get into paw-mode
  (if (not (eq major-mode 'paw-mode)) (paw-mode))

  (let (workbuffer logbuffer outputbuffer process node)
    (setq paw-status "init")

    (setq workbuffer (current-buffer))
    (setq logbuffer (generate-new-buffer (format "*%s PAW log*" (buffer-name workbuffer))))
    (setq outputbuffer (get-buffer-create (format "*%s PAW output*" (buffer-name workbuffer))))

    (save-excursion
      (set-buffer outputbuffer)
      (paw-log-mode)
      (setq truncate-lines t)
      (erase-buffer)
      ) ; end save-excursion

    (save-excursion
      (set-buffer logbuffer)
      (paw-log-mode)
      (setq buffer-read-only t)
      ) ; end save-excursion

    (setq process (start-process (format "PAW for %s" (buffer-name workbuffer)) nil paw-command-line))
    (set-process-filter process 'paw-filter)
    (set-process-sentinel process 'paw-sentinel)
    (process-send-string process paw-initial-keysequence)

    (setq node (list 'commands (list (list 'input ""))
		     'workbuffer workbuffer
		     'logbuffer logbuffer
		     'outputbuffer outputbuffer
		     'process process
		     'query-prompt nil
		     )) ; end setq

    (setq paw-process-list (cons node paw-process-list))
    (if paw-popup-output (paw-split-output))

    ) ; end let
  )

(defun paw-execute-line (keep-output)
  "Send the current line to PAW for execution."
  (interactive "P")

  (let ((node) (comment t) (start) (end) (input))
    (setq node (paw-find-node 'workbuffer (current-buffer)))
    (if (not node) (error "This is not a work buffer for an active PAW process"))
    (if (plist-get node 'query-prompt)
	(error "PAW is asking you a question; either answer it or C-g to cancel"))

    (while comment
      (save-excursion
	(beginning-of-line)
	(setq comment (or (looking-at "[ \t]*\\*")
			  (looking-at "[ \t]*$")))
	) ; end save-excursion
      (if comment (next-line 1))
      )

    (save-excursion
      (beginning-of-line)
      (setq start (point))
      (end-of-line)
      (setq end (point))
      ) ; end save-excursion
    (setq input (string-make-unibyte (buffer-substring start end)))
    (paw-execute (or (plist-get node 'commands) keep-output) input)
    (next-line 1)
    ) ; end let
  )

(defun paw-execute-region (keep-output)
  "Send the current region to PAW for execution."
  (interactive "P")

  (error "Function is not yet written")

;   (let ((node) (comment t) (start) (end) (input))
;     (setq node (paw-find-node 'workbuffer (current-buffer)))
;     (if (not node) (error "This is not a work buffer for an active PAW process"))
;     (if (plist-get node 'query-prompt)
; 	(error "PAW is asking you a question; either answer it or C-g to cancel"))

;     (while comment
;       (save-excursion
; 	(beginning-of-line)
; 	(setq comment (or (looking-at "[ \t]*\\*")
; 			  (looking-at "[ \t]*$")))
; 	) ; end save-excursion
;       (if comment (next-line 1))
;       )

;     (save-excursion
;       (beginning-of-line)
;       (setq start (point))
;       (end-of-line)
;       (setq end (point))
;       ) ; end save-excursion
;     (setq input (string-make-unibyte (buffer-substring start end)))
;     (paw-execute (or (plist-get node 'commands) keep-output) input)
;     (next-line 1)
;     ) ; end let
  )

(defun paw-execute (keep-output &optional input)
  (interactive "P")
  
  (let (node)
    (setq node (paw-find-node 'workbuffer (current-buffer)))
    (if (null node) (setq node (paw-find-node 'outputbuffer (current-buffer))))
    (if (null node) (setq node (paw-find-node 'logbuffer (current-buffer))))
    (if (or (null node)
	    (not (eq (process-status (plist-get node 'process)) 'run)))
	(error "There is no living PAW process associated with this buffer")

      (if (null input)
	  (setq input (read-from-minibuffer "PAW > " nil nil nil 'paw-history))
	) ; end if you need to read a command

      (if (not keep-output)
	  (save-excursion
	    (set-buffer (plist-get node 'outputbuffer))
	    (erase-buffer)
	    ) ; end save-excursion
	) ; end if not keep-output

      (paw-append-command node input)
      (process-send-string (plist-get node 'process) (format "%s\n" input))
      (save-excursion
	(set-buffer (plist-get node 'workbuffer))
	(setq paw-status "run")
	) ; end save-excursion
      ) ; end if node and process are okay
    ) ; end let
  )

(defun paw-abort-command (&optional process)
  "Send a SIGINT to PAW, so that it will abort its current command."
  (interactive)

  (let (node)
    (if (null process)
	(progn
	  (setq node (paw-find-node 'workbuffer (current-buffer)))
	  (if (null node) (setq node (paw-find-node 'outputbuffer (current-buffer))))
	  (if (null node) (setq node (paw-find-node 'logbuffer (current-buffer))))
	  (if (or (null node)
		  (not (eq (process-status (plist-get node 'process)) 'run)))
	      (error "There is no living PAW process associated with this buffer")
	    (setq process (plist-get node 'process))
	    ) ; end if node and process is okay
	  ) ; end progn
      ) ; end if we need to get the process
    (if process (interrupt-process process))
    ) ; end let
  )

;;;  INTERNAL FUNCTIONS   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun paw-find-node (type value)
  "Return a node from `paw-process-list' that corresponds to a value
of the given type."

  (let ((i 0) (node nil))
    (while (< i (length paw-process-list))
      (if (eq (plist-get (nth i paw-process-list) type) value)
	  (setq node (nth i paw-process-list))
	) ; end if
      (setq i (1+ i))
      ) ; end while
    node
    ) ; end let
  )

(defun paw-append-command (node input)
  "Adds a command to a node's `commands' list."
  (let ((commands (plist-get node 'commands)))
    (setq commands (append commands (list (list 'input input))))
    (plist-put node 'commands commands)
    ) ; end let
  )

(defun paw-pop-command (node)
  "Removes a command from a node's `commands' list."
  (let ((commands (plist-get node 'commands)))
    (setq commands (cdr commands))
    (plist-put node 'commands commands)
    ) ; end let
  )

(defun paw-filter (process output)
  "Overwrites the associated output buffer with the PAW output, and
appends it to the log."

  (let ((node (paw-find-node 'process process))
	(start) (end) (commands-to-pop 0) (finished-last-command nil)
	(is-help-prompt) (is-interactive-prompt) (is-abort-prompt) (is-wait) (question)
	(window-top (window-start)))

    (save-excursion
      (set-buffer (plist-get node 'outputbuffer))
      (end-of-buffer)
      (insert output)
      ) ; end save-excursion

    (save-excursion
      (set-buffer (plist-get node 'logbuffer))
      (end-of-buffer)
      (setq start (point))
      (setq buffer-read-only nil)
      (insert output)
      (setq buffer-read-only t)
      (setq end (point))

      (goto-char start)
      (while (search-forward-regexp "^PAW > " end t)
	(setq commands-to-pop (1+ commands-to-pop))
	) ; end while
      (goto-char end)

      (beginning-of-line)
      (setq finished-last-command (looking-at "PAW > $"))
      (setq is-help-prompt (looking-at "Enter a number.*: $"))
      (setq is-interactive-prompt (looking-at ".* (<CR>=.*)[ \t]*$"))
      (setq is-abort-prompt (looking-at "You keep hitting"))
      (setq is-wait (looking-at "Type <CR> to continue or Q to quit"))

      (if (or is-help-prompt is-interactive-prompt is-abort-prompt is-wait)
	  (let (start end)
	    (setq start (point))
	    (end-of-line)
	    (setq end (point))
	    (setq question (buffer-substring start end))
	    ) ; end let
	) ; end if-else in a query

      ) ; end save-excursion

    (paw-insert-prompt-in-output (plist-get node 'outputbuffer))
      
    (if finished-last-command
	(save-excursion
	  (set-buffer (plist-get node 'workbuffer))
	  (plist-put node 'query-prompt nil)
	  (setq paw-status "idle")
	  )
      ) ; end if

    (while (> commands-to-pop 0)
      (paw-pop-command node)
      (setq commands-to-pop (1- commands-to-pop))
      ) ; end while

    (if (or is-help-prompt is-interactive-prompt is-abort-prompt is-wait)
	(progn
	  (set-window-start (selected-window) window-top)
	  (if (and is-help-prompt paw-help-takes-over)
	      (progn
		(switch-to-buffer (plist-get node 'outputbuffer))
		(delete-other-windows)
		) ; end progn
	    (set-buffer (plist-get node 'workbuffer))
	    (paw-split-output)
	    ) ; end if
	  (plist-put node 'query-prompt t)
	  (paw-query-question process question (plist-get node 'outputbuffer)
			      (or is-interactive-prompt is-abort-prompt is-wait))
	  ) ; end progn
      ) ; end if

    (set-window-start (selected-window) window-top)
    ) ; end let
  )

(defun paw-insert-prompt-in-output (outputbuffer)
  "A tacky little function for inserting `PAW >' at the beginning of
the output buffer, when applicable."

  (save-excursion
    (set-buffer outputbuffer)
    (beginning-of-buffer)
    (if (and (not (looking-at "PAW > ")) (not (looking-at "[ \t]*\\*"))) (insert "PAW > "))
    ) ; end save-excursion
  )

(defun paw-query-question (process question outputbuffer keep-old-output)
  "Forces the user to stop and answer a question posed by PAW."
  (let (response)
    (condition-case nil
	(setq response (read-from-minibuffer question nil nil nil 'paw-query-history))
      (quit
       (progn
	 (plist-put (paw-find-node 'process process) 'commands nil)
	 (paw-abort-command process)
	 (keyboard-quit)
	 ) ; end progn
       ) ; end quit handler
      ) ; end condition-case

    (if (not keep-old-output)
	(save-excursion
	  (set-buffer outputbuffer)
	  (erase-buffer)
	  ) ; save-excursion
      ) ; end if

    (process-send-string process (format "%s\n" response))
    (setq paw-status "help")
    ) ; end let
  )

(defun paw-sentinel (process event)
  "Handles the shocking event of a PAW crash."
  (let ((node (paw-find-node 'process process)))
	
    (save-excursion
      (set-buffer (plist-get node 'outputbuffer))
      (end-of-buffer)
      (insert "----> PAW ")
      (insert event)
      ) ; end save-excursion

    (save-excursion
      (set-buffer (plist-get node 'logbuffer))
      (end-of-buffer)
      (setq buffer-read-only nil)
      (insert "----> PAW ")
      (insert event)
      (setq buffer-read-only t)
      ) ; end save-excursion

    (save-excursion
      (set-buffer (plist-get node 'workbuffer))
      (setq paw-status "no process")
      ) ; end save-excursion

    (setq paw-process-list (delete node paw-process-list))
    ) ; end let
  )

(defun paw-indent-line ()
  "Indent the current line in a way which is okay for PAW."
  (interactive)

  (let (indent special cursor line-start words-start move-cursor)
    (save-excursion
      (beginning-of-line)
      (if (= (point) (point-min))
	  (setq indent 0)
	(forward-line -1)
	(while (and (or (looking-at "[ \t]*$")
			(looking-at "[ \t]*\\*")
			) ; end or
		    (not (= (point) (point-min)))
		    ) ; end and
	  (forward-line -1)
	  ) ; end while
	(skip-chars-forward " \t")
	(setq indent (current-column))
	(setq special (or (looking-at "case")
			  (looking-at "if")
			  (looking-at "do")
			  (looking-at "for")
			  (looking-at "repeat")
			  (looking-at "while")
			  (looking-at "else")
			  )) ; end setq
	) ; end if not at beginning
      ) ; end save-excursion

    (save-excursion
      (setq cursor (point))
      (beginning-of-line)
      (setq line-start (point))
      (skip-chars-forward " \t")
      (setq words-start (point))
      (if special (setq indent (+ indent 2)))
      (if (looking-at "[ \t]*end") (setq indent (- indent 2)))
      (if (looking-at "[ \t]*else") (setq indent (- indent 2)))
      (if (< indent 0) (setq indent 0))
      (setq move-cursor (>= words-start cursor))

      (delete-region line-start words-start)
      (indent-to indent)

      (setq words-start (point))
      ) ; end save-excursion
      
    (if move-cursor (goto-char words-start))
    ) ; end let
  )