;;; apl-mode.el --- mode for editing A+ code -*- coding: utf-8 -*-

;; This edition is for XEmacs

;; Author: Paul Koning <ni1d@arrl.net>
;; Maintainer: Paul Koning <ni1d@arrl.net>
;; Keywords: tools, languages
;; Version: 1.0

;; Copyright (c) 2000 by Paul Koning.

;;; Commentary:

;; This mode was based on asm-mode by Eric S. Raymond <esr@snark.thyrsus.com>

;; This major mode is based on text mode.

;; This mode runs the usual hook: apl-mode-hook at the end of initialization.

;; Setup:
;; (setq auto-mode-alist
;;      (append
;;       '(("\\.\\+\\'" . aplus-mode))
;;       auto-mode-alist))
;;(autoload 'aplus-mode "aplus-mode" "edit A+ script." t nil)

;;; Code:

;; UnicAPL is required
;; http://stud4.tuwien.ac.at/~e0225855/unicapl/unicapl.html
(require 'apl)

(defvar aplus-mode-syntax-table nil
  "Syntax table used while in Mac mode.")

;; set up the default syntax table.
(if aplus-mode-syntax-table
    ()
  (setq aplus-mode-syntax-table (make-syntax-table))
;  (modify-syntax-entry	?<  "(>" aplus-mode-syntax-table)
;  (modify-syntax-entry	?>  ")<" aplus-mode-syntax-table)
;  (modify-syntax-entry	?\n ">"  aplus-mode-syntax-table)
  )

(defvar aplus-mode-abbrev-table nil
  "Abbrev table used while in Mac mode.")
(define-abbrev-table 'aplus-mode-abbrev-table ())

(defvar aplus-mode-map nil
  "Keymap for Mac mode.")


(if aplus-mode-map
    ()
  ;; XEmacs change
  (setq aplus-mode-map (make-sparse-keymap 'aplus-mode-map))
;;  (setq aplus-mode-map (make-keymap))
  )

(defconst aplus-font-lock-keywords
  ()
; '(("^\\(\\(\\sw\\|\\s_\\)+\\):[ \t]*\\(\\sw+\\)?"
;    (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
;   ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))
 "Additional expressions to highlight in A+ mode.")

(defconst aplus-in-comment-pattern "^[^⍝]*⍝")
(defconst aplus-inline-empty-comment-pattern "^.+⍝+ *$")
(defconst aplus-flush-left-empty-comment-pattern "^⍝ *$")

(defvar aplus-mode-version-string "")

;;;###autoload
(defun aplus-mode ()
  "Major mode for editing A+ source code.
Features a private abbrev table and the following bindings:

Turning on A+ mode runs the hook `aplus-mode-hook' at the end of 
initialization.

Special commands:
\\{aplus-mode-map}
"
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "A+")
  (setq major-mode 'aplus-mode)
  (setq local-abbrev-table aplus-mode-abbrev-table)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(aplus-font-lock-keywords))
  (make-local-variable 'aplus-mode-syntax-table)
  (set-syntax-table aplus-mode-syntax-table)
  (setq ctl-arrow 32)
  (use-local-map aplus-mode-map)

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

  (add-hook 'find-file-hook (lambda ()
			      (if (eq major-mode 'aplus-mode)
				  (aplus-aplus-to-unicode))))
  (add-hook 'before-save-hook (lambda ()
				(if (eq major-mode 'aplus-mode)
				    (aplus-unicode-to-aplus))))
  (add-hook 'after-save-hook (lambda ()
			     (if (eq major-mode 'aplus-mode)
				 (progn
				   (aplus-aplus-to-unicode)
				   (set-buffer-modified-p nil)))))

  (run-hooks 'aplus-mode-hook))

(defun aplus-pop-comment-level ()
  ;; Delete an empty comment ending current line.  Then set up for a new one,
  ;; on the current line if it was all comment, otherwise above it
  (end-of-line)
  (delete-horizontal-space)
  (while (= (preceding-char) ?\x235d)
    (delete-backward-char 1))
  (delete-horizontal-space)
  (if (bolp)
      ()
    (beginning-of-line)
    (open-line 1))
  )


(defun aplus-comment ()
  "Convert an empty comment to a `larger' kind, or start a new one.
These are the known comment classes:

   1 -- comment to the right of the code (at the comment-column)
   2 -- comment on its own line, beginning at the left-most column.

Suggested usage:  while writing your code, trigger aplus-comment
repeatedly until you are satisfied with the kind of comment."
  (interactive)
  (cond

   ;; Blank line?  Then start comment at left margin.
   ((aplus-line-matches "^[ \t]*$")
    (delete-horizontal-space)
    (insert comment-start " "))

   ;; Nonblank line with no comment chars in it?
   ;; Then start a comment at the current comment column
   ((not (aplus-insert-literal-p))
    (indent-to-column comment-column)
    (insert "⍝")
    (end-of-line))

   ;; If all else fails, insert character
   (t
    (insert "⍝"))

   ))

(defun aplus-aplus-to-unicode ()
  "Translate Unicode APL codepoints to ASCII transliterations in the buffer."
  (interactive)
  (set-buffer-file-coding-system 'utf-8)
  (let ((begin (set-marker (make-marker) (point-min)))
	(end (set-marker (make-marker) (point-max))))
    (translate-region begin end
		      (make-translation-table apl-aplus-table))))

(defun aplus-unicode-to-aplus ()
  "Translate Unicode APL codepoints to ASCII transliterations in the buffer."
  (interactive)
  (set-buffer-file-coding-system 'iso-8859-1)
  (let ((begin (set-marker (make-marker) (point-min)))
	(end (set-marker (make-marker) (point-max))))
    (translate-region begin end
		      (make-translation-table (mapcar #'apl-flip
						      apl-aplus-table)))))


;;; aplus-mode.el ends here