;;; mac-mode.el --- mode for editing pdp-11 assembler code

;; Author: Paul Koning <pkoning@xedia.com>
;; Maintainer: Paul Koning <pkoning@xedia.com>
;; Keywords: tools, languages

;; Copyright (c) 1996, 1997 by Paul Koning.

;;; Commentary:

;; This mode was based on asm-mode by Eric S. Raymond <esr@snark.thyrsus.com>
;; Its features are based on the assembly language editing mode of
;; PDP-11 TECO by Mark Bramhall and others.

;; This major mode is based on text mode.  It defines a private abbrev table
;; that can be used to save abbrevs for assembler mnemonics.  It binds 
;; quite a lot of keys:
;;
;;	TAB		tab to next tab stop
;;	:		outdent preceding label, tab to tab stop
;;	;		place or move comment
;;	C-j, C-m	newline and tab to tab stop.  If mac-revision-number
;;			is non-negative, insert a revision tag at the end
;;			of the current line first.
;;	C-c C-l		resequence the current local symbol block.
;;	letters		lowercase letters are upcased unless they are part
;;			of the comment or a text string.
;;
;; Code is indented to the first tab stop level.

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

;;; Code:

(defvar mac-revision-column 72
  "*The column number where revision numbers begin.")

(defvar mac-revision-number -1
  "*The current revision number.  -1 means no revision number is
currently in effect.")

(defvar mac-upcase-code t
  "*Non-nil if code (text other than strings or comments) should be
forced to uppercase.")

(defvar mac-lsb-start 10
  "*The first local symbol number to assign when resequencing local symbols.")

(defvar mac-lsb-inc 10
  "*The local symbol number increment when resequencing local symbols.")

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

;; set up the default syntax table.
(if mac-mode-syntax-table
    ()
  (setq mac-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry	?<  "(>" mac-mode-syntax-table)
  (modify-syntax-entry	?>  ")<" mac-mode-syntax-table)
  (modify-syntax-entry	?\' "/"  mac-mode-syntax-table)
  (modify-syntax-entry	?,  "."  mac-mode-syntax-table)
  (modify-syntax-entry	?^  "\'" mac-mode-syntax-table)
  (modify-syntax-entry	?_  "_"  mac-mode-syntax-table)
  (modify-syntax-entry	?.  "_"  mac-mode-syntax-table)
  (modify-syntax-entry	?$  "_"  mac-mode-syntax-table)
  (modify-syntax-entry	?\; "<"  mac-mode-syntax-table)
  (modify-syntax-entry	?\n ">"  mac-mode-syntax-table)
  )

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

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

(if mac-mode-map
    ()
  (setq mac-mode-map (make-keymap))
  (define-key mac-mode-map "\;"		'mac-comment)
  (define-key mac-mode-map ":"		'mac-colon)
  (define-key mac-mode-map "\C-c;"      'comment-region)
  (define-key mac-mode-map "\C-i"	'tab-to-tab-stop)
  (define-key mac-mode-map "\C-j"	'mac-newline)
  (define-key mac-mode-map "\C-m"	'mac-newline)
  (define-key mac-mode-map "\C-c\C-l"	'mac-reseq-lsb)
  (let ((letter ?a))
    (while (<= letter ?z)
      (define-key mac-mode-map (char-to-string letter) 'mac-case-insert)
      (setq letter (1+ letter))))
  )

(defconst mac-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 Assembler mode.")

(defconst mac-in-comment-pattern "^[^;]*;")
(defconst mac-inline-empty-comment-pattern "^.+;+ *$")
(defconst mac-flush-left-empty-comment-pattern "^; *$")
(defconst mac-optlabel-pattern "^\\(\\(\\sw\\|\\s_\\)+:\\)?[ \t]*")
(defconst mac-string-stmt-pattern 
  (concat mac-optlabel-pattern "\\.asci[izcd]"))
(defconst mac-enlsb-pattern 
  (concat mac-optlabel-pattern "\\.enable?[ \t]+lsb"))
(defconst mac-dslsb-pattern 
  (concat mac-optlabel-pattern "\\.dsable?[ \t]+lsb"))
(defconst mac-nonloclabel-pattern "^[a-z$._]\\(\\sw\\|\\s_\\)+:")

;;;###autoload
(defun mac-mode ()
  "Major mode for editing PDP-11 assembler code.
Features a private abbrev table and the following bindings:

\\<mac-mode-map>\\[mac-colon]\toutdent a preceding label, tab to next tab stop.
\\[tab-to-tab-stop]\ttab to next tab stop.
\\[mac-newline]\tnewline, then tab to next tab stop.
\\[mac-comment]\tsmart placement of assembler comments.
\\[mac-reseq-lsb]\tresequence local symbol block.
a .. z\tupcased (by default, see `mac-upcase-code') when appropriate.

Turning on Mac mode runs the hook `mac-mode-hook' at the end of 
initialization.

Special commands:
\\{mac-mode-map}
"
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "Macro-11")
  (setq major-mode 'mac-mode)
  (setq local-abbrev-table mac-mode-abbrev-table)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(mac-font-lock-keywords))
  (make-local-variable 'mac-mode-syntax-table)
  (set-syntax-table mac-mode-syntax-table)

  (make-local-variable 'comment-column)
  (setq comment-column 32)
  (make-local-variable 'mac-revision-column)
  (make-local-variable 'mac-revision-number)
  (mac-guess-revnum)
  (use-local-map mac-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 "")
  (setq fill-prefix "\t")
  (run-hooks 'mac-mode-hook))

(defun mac-colon ()
  "Insert a colon; if it follows a label, delete the label's indentation."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at "[ \t]+\\(\\sw\\|\\s_\\)+$")
	(delete-horizontal-space)))
  (insert ":")
  (tab-to-tab-stop)
  )

(defun mac-insert-revnum ()
  "Insert the revision number."
  (indent-to-column mac-revision-column)
  (insert comment-start (format "%03d" mac-revision-number))
  )

;; This function looks at the current file to see if it seems to contain
;; a revision history.  If so, it sets mac-revision-number to that value.
(defun mac-guess-revnum ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "\014\n?\\.sbttl[ \t]+edit history" nil t)
	(save-restriction
	  (narrow-to-region (point) (point-max))
	  (search-forward "\014" nil t)
	  (if (re-search-backward "\\(;[ \t]+\\)\\([0-9][0-9][0-9]\\)" nil t)
	      (setq mac-revision-number 
		    (string-to-number (match-string 2))))))))

(defun mac-newline ()
  "Insert LFD + fill-prefix, to bring us back to code-indent level."
  (interactive)
  (if (eolp) (delete-horizontal-space))
  (if (>= mac-revision-number 0) (mac-insert-revnum))
  (insert "\n")
  (tab-to-tab-stop)
  )

(defun mac-line-matches (pattern)
  (save-excursion
    (beginning-of-line)
    (looking-at pattern)))

(defun mac-line-matches-before-point (pattern)
  (let ((pt (point)))
    (save-excursion
      (beginning-of-line)
      (if (looking-at pattern) (<= (match-end 0) pt)))))

; function to tell if the next char should be inserted literally
; (apart from upcasing sourcecode, that is)
(defun mac-insert-literal-p ()
  (cond
   ((mac-line-matches mac-string-stmt-pattern) t)
   ((mac-line-matches-before-point mac-in-comment-pattern) t)
   ((= (preceding-char) ?\') t)
   ((= (preceding-char) ?\") t)
   ((let ((ppchar (char-after (- (point) 2))))
      (if ppchar (= ppchar ?\"))))))

(defun mac-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) ?\;)
    (delete-backward-char 1))
  (delete-horizontal-space)
  (if (bolp)
      ()
    (beginning-of-line)
    (open-line 1))
  )


(defun mac-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 mac-comment
repeatedly until you are satisfied with the kind of comment."
  (interactive)
  (cond

   ;; Blank line?  Then start comment at left margin.
   ((mac-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 (mac-insert-literal-p))
    (indent-to-column comment-column)
    (insert ";")
    (end-of-line))

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

   ))

(defun mac-case-insert ()
  "Insert a lowercase letter, possibly upcased."
  (interactive)
  (if (or (not mac-upcase-code) (mac-insert-literal-p))
      (self-insert-command 1)
    (insert (upcase last-input-char)))
  )

;; Find the start and end of the local symbol block around point,
;; and return that as a list.
(defun mac-lsb-extent ()
  (let ((pt (point)) (start) (end) (enlsb) (dslsb) (label))
    (re-search-backward mac-enlsb-pattern nil 1)
    (setq enlsb (point))
    (goto-char pt)
    (re-search-backward mac-dslsb-pattern nil 1)
    (setq dslsb (point))
    (goto-char pt)
    ;; if .enabl lsb occurred before .dsabl lsb (or if both were absent,
    ;; or .enabl lsb was absent) then we're not in the range of a
    ;; explicitly defined local symbol block.
    ;; if so, then the start is the most recent nonlocal label or
    ;; the most recent .enabl lsb, whichever was last, and the end
    ;; is the next nonlocal label or the next .enable lsb, whichever
    ;; is first.
    (if (<= enlsb dslsb)
	(progn
	  (re-search-backward mac-nonloclabel-pattern nil 1)
	  (setq label (point))
	  (goto-char pt)
	  (setq start (max enlsb label))
	  (re-search-forward mac-enlsb-pattern nil 1)
	  (beginning-of-line)
	  (setq enlsb (point))
	  (goto-char pt)
	  (re-search-forward mac-nonloclabel-pattern nil 1)
	  (beginning-of-line)
	  (setq label (point))
	  (goto-char pt)
	  (setq end (min enlsb label)))
      ;; if .enabl lsb occurred after .dsabl lsb (or if .dsabl lsb was
      ;; absent) then we are in the range of an explicitly defined local 
      ;; symbol block.
      ;; if so, then the start is the most recent .enabl lsb, and the end
      ;; is the next .enable lsb or the next nonlocal label after the
      ;; .dsable lsb, whichever is first.
      (setq start enlsb)		;in .enabl lsb range
      (re-search-forward mac-enlsb-pattern nil 1)
      (beginning-of-line)
      (setq enlsb (point))
      (goto-char pt)
      (re-search-forward mac-dslsb-pattern nil 1)
      (re-search-forward mac-nonloclabel-pattern nil 1)
      (beginning-of-line)
      (setq label (point))
      (goto-char pt)
      (setq end (min enlsb label)))
    (list start end)))

;; This function resequences local symbols in the current buffer.
;; Normally it is called with the buffer narrowed to the local
;; symbol block to be resequenced; if it isn't, then the results
;; are probably not what you wanted.
;; This function should normally be called in the context of a
;; save-excursion.
(defun mac-reseq-buf ()
  (let ((sym mac-lsb-start) (cursym) (cursymto))
    (goto-char (point-min))
    (perform-replace 
     "\\(\\`\\|[^a-z0-9$._]\\)\\([0-9]+\\)\\(\\$\\)" "\\1~\\2~" 
     nil t nil)
    (while (progn
	     (goto-char (point-min))
	     (re-search-forward "\\(~[0-9]+~\\)\\(:\\)" nil t))
      (setq cursym (match-string 1))
      (setq cursymto (format "%d$" sym))
      (goto-char (point-min))
      (perform-replace cursym cursymto nil nil nil)
      (setq sym (+ sym mac-lsb-inc)))))

;; Command to resequence local symbols in the local symbol block
;; around point, unless mark is active (i.e., the region is highlighted)
;; in which case the region is resequenced.
(defun mac-reseq-lsb ()
  "Resequence local symbols in the current local symbol block.  If
the region is currently active (highlighted) then the region is
resequenced.
The new starting local symbol number is given by variable mac-lsb-start; 
the increment is given by variable mac-lsb-increment.  Both default to 10."
  (interactive)
  (save-excursion
    (save-restriction
      (if (and mark-ring mark-active)
	  (narrow-to-region (mark) (point))
	(apply 'narrow-to-region (mac-lsb-extent)))
      (mac-reseq-buf))))

;;; mac-mode.el ends here