;;; preserves.el --- Preserves editing commands for Emacs

;; Add code like the following to your .emacs to install:
;; (autoload 'preserves-mode "~/src/preserves/preserves.el" nil t)
;; (add-to-list 'auto-mode-alist '("\\.pr\\'" . preserves-mode))
;; (add-to-list 'auto-mode-alist '("\\.prs\\'" . preserves-mode))

;; Copyright (C) 1988,94,96,2000  Free Software Foundation, Inc.
;; Copyright (C) 2003, 2005, 2011, 2016, 2019 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

;; This 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 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 software; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(require 'font-lock)
(require 'smie)

;;---------------------------------------------------------------------------
;; Font-lock, Indentation, and Mode

(defvar preserves-mode-syntax-table (make-syntax-table)
  "Syntax table in use in preserves-mode buffers.")

;; (modify-syntax-entry ?' "\"" preserves-mode-syntax-table)
(modify-syntax-entry ?\n ">" preserves-mode-syntax-table)
(modify-syntax-entry ?\r ">" preserves-mode-syntax-table)
(modify-syntax-entry ?\; "<" preserves-mode-syntax-table)
(modify-syntax-entry ?< "(>" preserves-mode-syntax-table)
(modify-syntax-entry ?> ")<" preserves-mode-syntax-table)
(mapcar #'(lambda (x) (modify-syntax-entry x "_" preserves-mode-syntax-table))
        '(?- ?_ ?$ ?? ?! ?* ?+ ?~ ?: ?= ?|))
(mapcar #'(lambda (x) (modify-syntax-entry x "." preserves-mode-syntax-table))
        '(?.))

(defvar preserves-font-lock-keywords
  (list
   '("\\_<\\(~\\|[A-Z]\\)[^][)(}{><[:space:].\n]*\\>" . font-lock-type-face)
   '("\\\\[[:space:]]*?\n" . font-lock-warning-face)
   ))

(defun preserves-mode-variables ()
  (make-local-variable 'comment-use-syntax)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-start-skip)
  (setq comment-use-syntax t)
  (setq comment-start ";")
  (setq comment-end "")
  (setq comment-start-skip "; *")
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(preserves-font-lock-keywords nil nil ()))
  (make-local-variable 'indent-line-function)
  (setq indent-line-function #'preserves-indent-line)
  )

(defvar preserves-indent-basic 2
  "Basic indentation amount for Preserves.")

(defun preserves-continuation-line-p ()
  (save-excursion
    (and (zerop (forward-line -1))
         (progn (end-of-line)
                (skip-syntax-backward " ")
                (eq (char-before) ?\\)))))

(defun preserves-looking-at-syntax-p (ch)
  (let ((ch-here (char-after)))
    (and ch-here (eq (char-syntax ch-here) ch))))

(defun preserves-hanging-paren-p ()
  (save-excursion
    (forward-char)
    (while (and (not (eq (char-after) ?\n))
                (preserves-looking-at-syntax-p ?\s))
      (forward-char))
    (eolp)))

(defun preserves-indent-line ()
  (let ((new-indentation
         (save-excursion
           (beginning-of-line)
           (skip-syntax-forward " ")
           (let* ((at-close-paren (preserves-looking-at-syntax-p ?\)))
                  (ppss (syntax-ppss)))
             (cond
              ((cadddr ppss) nil) ;; when we are in a string, don't reindent
              ((<= (car ppss) 0) 0) ;; not in any parentheses, outdent fully
              (t (goto-char (cadr ppss))
                 (cond
                  ((preserves-hanging-paren-p)
                   (beginning-of-line)
                   (skip-syntax-forward " ")
                   (if at-close-paren ;; close paren, no indent
                       (current-column)
                     (+ preserves-indent-basic (current-column))))
                  (at-close-paren ;; close paren, treat it specially
                   (current-column))
                  (t ;; not a close paren, do the default thing
                   (forward-char)
                   (skip-syntax-forward " ")
                   (current-column)))))))))
    (when new-indentation
      (cl-labels ((reindent! () (indent-line-to (if (preserves-continuation-line-p)
                                                    (+ new-indentation preserves-indent-basic)
                                                  new-indentation))))
        (if (bolp)
            (reindent!)
          (save-excursion (reindent!)))))))

;;;###autoload
(define-derived-mode preserves-mode prog-mode "Preserves"
  "Major mode for editing Preserves structures."
  (preserves-mode-variables))

;;---------------------------------------------------------------------------
;; Provides

(provide 'preserves-mode)

;;; preserves.el ends here