1 ;;; dap16-mode.el --- mode for editing DAP-16 assembler code
5 ;; This mode was written by Philipp Hachtmann <hachti@hachti.de>.
6 ;; It is based on the asm mode by Eric S. Raymond <esr@snark.thyrsus.com>
8 ;; This minor mode is based on text mode. It defines a private abbrev table
9 ;; that can be used to save abbrevs for assembler mnemonics. It binds just
12 ;; TAB tab to next tab stop
13 ;; : outdent preceding label, tab to tab stop
14 ;; comment char place or move comment
15 ;; dap16-comment-char specifies which character this is;
16 ;; you can use a different character in different
18 ;; C-j, C-m newline and tab to tab stop
20 ;; Code is indented to the first tab stop level.
22 ;; This mode runs two hooks:
23 ;; 1) An dap16-mode-set-comment-hook before the part of the initialization
24 ;; depending on dap16-comment-char, and
25 ;; 2) an dap16-mode-hook at the end of initialization.
30 "DAP-16 Assembler programming"
33 (defcustom dap16-comment-char ?*
34 "*The comment-start character assumed by Asm mode."
38 ;; XEmacs change (This is the primary difference, why was this
39 ;; feature removed? -sb)
40 (defcustom dap16-support-c-comments-p nil
41 "*Support C style comments. If t C style comments will be
42 supported. This is mainly for the benefit of font-lock."
46 (defcustom dap16-mode-syntax-table nil
47 "Syntax table used while in Asm mode.")
49 (defvar dap16-mode-abbrev-table nil
50 "Abbrev table used while in Asm mode.")
51 (define-abbrev-table 'dap16-mode-abbrev-table ())
53 (defvar dap16-mode-map nil
54 "Keymap for Asm mode.")
59 (setq dap16-mode-map (make-sparse-keymap 'dap16-mode-map))
60 ;; Note that the comment character isn't set up until dap16-mode is called.
61 (define-key dap16-mode-map ":" 'dap16-colon)
62 (define-key dap16-mode-map "\C-h" 'dap16-backspace)
63 (define-key dap16-mode-map "\C-l" 'dap16-halfdelim)
64 (define-key dap16-mode-map "\M-l" 'dap16-fulldelim)
65 (define-key dap16-mode-map "\C-i" 'dap16-tabulator)
66 (define-key dap16-mode-map "\C-cc" 'dap16-comment-region)
67 (define-key dap16-mode-map "\C-c\C-c" 'dap16-comment-region)
68 (define-key dap16-mode-map "\C-a" 'beginning-of-line)
69 (define-key dap16-mode-map "\C-j" 'dap16-newline)
70 (define-key dap16-mode-map "\C-m" 'dap16-newline)
73 ;;(defconst dap16-font-lock-keywords
74 ;; '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?"
75 ;; (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
76 ;; ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))
78 ;; "Additional expressions to highlight in Assembler mode.")
81 ;;(put 'dap16-mode 'font-lock-defaults '(dap16-font-lock-keywords))
83 ;;(defvar dap16-code-level-empty-comment-pattern nil)
84 ;;(defvar dap16-flush-left-empty-comment-pattern nil)
85 ;;(defvar dap16-inline-empty-comment-pattern nil)
89 "Major mode for editing Honeywell DAP-16 assembler code.
90 Features a private abbrev table and the following bindings:
92 \\[dap16-colon]\toutdent a preceding label, tab to next tab stop.
93 \\[tab-to-tab-stop]\ttab to next tab stop.
94 \\[dap16-newline]\tnewline, then tab to next tab stop.
95 \\[dap16-comment]\tsmart placement of assembler comments.
97 Turning on Asm mode runs the hook `dap16-mode-hook' at the end of initialization.
104 (kill-all-local-variables)
106 ;; The space after a comment char at the beginning of a line
107 (make-local-variable 'dap16-comment-space)
108 (setq dap16-comment-space " ")
110 (setq mode-name "DAP-16")
111 (setq major-mode 'dap16-mode)
112 (setq local-abbrev-table dap16-mode-abbrev-table)
114 ;; (make-local-variable 'tab-stop-list)
115 ;; (setq tab-stop-list '(6 12 30))
117 ;;(defconst dap16-font-lock-keywords
118 ;; '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?"
119 ;; (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
120 ;; ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))
122 ;; "Additional expressions to highlight in Assembler mode.")
125 (setq dap16-font-lock-keywords
127 (dap16-comment-matcher . font-lock-comment-face)
128 ;; ("\\<[0-9]+H[^ \t\n]*\\>" . font-lock-keyword-face)
130 ("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?"
131 (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
132 ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" (1 font-lock-keyword-face))
139 (make-local-variable 'dap16-mode-syntax-table)
140 (setq dap16-mode-syntax-table (make-syntax-table))
142 (set-syntax-table dap16-mode-syntax-table)
144 (make-local-variable 'font-lock-defaults)
146 (setq font-lock-defaults '(
147 dap16-font-lock-keywords
155 (run-hooks 'dap16-mode-set-comment-hook)
156 ;; Make our own local child of dap16-mode-map
157 ;; so we can define our own comment character.
160 (let ((ourmap (make-sparse-keymap)))
161 (set-keymap-parents ourmap (list dap16-mode-map))
162 (use-local-map ourmap))
163 (local-set-key (vector dap16-comment-char) 'dap16-comment)
166 ;; (modify-syntax-entry dap16-comment-char "<" dap16-mode-syntax-table)
167 ;; (modify-syntax-entry ?\n ">" dap16-mode-syntax-table)
169 ;; (modify-syntax-entry ?a "w" dap16-mode-syntax-table)
172 ;; (let ((cs (regexp-quote (char-to-string dap16-comment-char))))
173 ;; (make-local-variable 'comment-start)
174 ;; (setq comment-start (concat cs dap16-comment-space))
175 ;; (make-local-variable 'comment-start-skip)
176 ;; (setq comment-start-skip (concat cs "+[ \t]*"))
177 ;; (setq dap16-inline-empty-comment-pattern (concat "^.+" cs "+ *$"))
178 ;; (setq dap16-code-level-empty-comment-pattern (concat "^[\t ]+" cs cs " *$"))
179 ;; (setq dap16-flush-left-empty-comment-pattern (concat "^" cs cs cs " *$"))
181 ;; (make-local-variable 'comment-end)
182 ;; (setq comment-end "")
183 (make-local-variable 'comment-column)
184 (setq comment-column 32)
185 ;; (setq fill-prefix "\t")
186 (run-hooks 'dap16-mode-hook))
188 (defun dap16-colon ()
189 "Insert a colon; if it follows a label, delete the label's indentation."
192 ( (and (is-comment-line) (= (current-column) (length '(dap16-comment-char dap16-comment-space))))
197 ( (and (not (is-comment-line)) (save-excursion (beginning-of-line) (looking-at "[ \t]+\\(\\sw\\|\\s_\\)+$")))
198 (save-excursion (beginning-of-line) (delete-horizontal-space))
209 ;_____________________________________________________________________________________________
212 (+ 1 (current-column))
220 (if (or (= (following-char) ? ) (= (following-char) ?\t) (= (following-char) ?\n))
227 (defun dap16-comment-matcher (limit)
229 ;;(setq p2 (+ 2 (point)))
232 (setq end-of-buffer-exit nil)
234 ;; Consume Newline characters if present.
235 (while (and (< (point) limit) (= (following-char) ?\n) ) (forward-char))
237 ;; Save first location to highlight
239 (while (and (< (point) limit) (not (and (= (following-char) ?\n) success)) (not end-of-buffer-exit))
240 (if (or (> (col) (fc-pos)) (is-comment-line))
241 (progn (setq p2 (+ 1 (point)))
242 (if success nil (progn (setq success t) (setq p1 (- (point) 0))))))
246 (if success (set-match-data (list (- p1 0) (- p2 0))))
251 ;_____________________________________________________________________________________________
253 (defun dap16-line-matches (pattern &optional withcomment)
256 (looking-at pattern)))
258 (defun dap16-pop-comment-level ()
259 ;; Delete an empty comment ending current line. Then set up for a new one,
260 ;; on the current line if it was all comment, otherwise above it
262 (delete-horizontal-space)
263 (while (= (preceding-char) dap16-comment-char)
264 (delete-backward-char 1))
265 (delete-horizontal-space)
273 (defun dap16-comment ()
274 "Convert an empty comment to a `larger' kind, or start a new one.
275 These are the known comment classes:
277 1 -- comment to the right of the code (at the comment-column)
278 2 -- comment on its own line, indented like code
279 3 -- comment on its own line, beginning at the left-most column.
281 Suggested usage: while writing your code, trigger dap16-comment
282 repeatedly until you are satisfied with the kind of comment."
285 (setq comment-start "")
289 ;; Blank line? Then start comment.
290 ((dap16-line-matches "^[ \t]*$")
291 (delete-horizontal-space)
292 (insert dap16-comment-char dap16-comment-space)
295 ;; Nonblank line with no comment chars in it?
296 ;; Then start a comment at the current comment column
297 ((and (= (col) 1) (is-comment-line))
301 ;; Flush-left comment present? Just insert character.
302 ;; ((dap16-line-matches dap16-flush-left-empty-comment-pattern)
303 ;; (insert dap16-comment-char))
305 ;; Fresh comment line??
306 ((dap16-line-matches (format "^%c%s$" dap16-comment-char dap16-comment-space))
308 (delete-backward-char (length dap16-comment-space))
309 (insert dap16-comment-char dap16-comment-char)
314 ;; Empty code-level comment already present?
315 ;; Then start flush-left comment, on line above if this one is nonempty.
316 ;; ((dap16-line-matches dap16-code-level-empty-comment-pattern)
317 ;; (dap16-pop-comment-level)
318 ;; (insert dap16-comment-char dap16-comment-char comment-start))
320 ;; Empty comment ends line?
321 ;; Then make code-level comment, on line above if this one is nonempty.
322 ;; ((dap16-line-matches dap16-inline-empty-comment-pattern)
323 ;; (dap16-pop-comment-level)
325 ;; (insert dap16-comment-char comment-start))
327 ;; If all else fails, insert character
329 (insert dap16-comment-char))
335 ;; ****************************************************************************
338 (defun pos-in-line ()
339 (- (point) (save-excursion (beginning-of-line) (point))))
342 ;; Muss verbessert werden!
343 (defun at-begin-of-line ()
345 ;; (setq pos (point) )
347 ;; (beginning-of-line)
348 ;; (if (= pos (point)) t nil)
352 (if (= 0 (current-column)) t nil))
355 (defun is-comment-line ()
356 (if (dap16-line-matches (format "^%c" dap16-comment-char))
361 (defun in-comment-spacing ()
362 (if (> (current-column) (length (format "%c%s" dap16-comment-char dap16-comment-space))) nil t)
365 (defun dap16-comment-line()
367 (if (is-comment-line)
371 (if (looking-at "^ ")
375 (save-excursion (beginning-of-line) (insert dap16-comment-char dap16-comment-space))
394 (defun dap16-comment-region()
397 (if (not (region-active-p)) (dap16-comment-line)
399 (goto-char (region-end))
400 (setq lastline (line-number))
401 (goto-char (region-beginning))
402 (while (< (line-number) lastline)
408 (defun dap16-backspace ()
410 (if (and (is-comment-line) (in-comment-spacing))
411 (delete-region (max (- (line-start) 1) 1) (point))
412 (delete-backward-char 1)
414 ;;delete-backward-char (length (format "%c%s" dap16-comment-char dap16-comment-space))) (tab-to-tab-stop))
415 ;; (delete-backward-char 1)
418 (defun dap16-fulldelim ()
420 (make-local-variable 'count)
422 (if (dap16-line-matches (format "^%c%s$" dap16-comment-char dap16-comment-space))
423 (progn (setq count 1)
425 (delete-backward-char (length dap16-comment-space)))
429 (insert dap16-comment-char)
430 (setq count ( 1+ count)))
434 (defun dap16-halfdelim ()
436 (make-local-variable 'count)
438 (if (dap16-line-matches (format "^%c%s$" dap16-comment-char dap16-comment-space))
439 (progn (setq count 1)
441 (delete-backward-char (length dap16-comment-space)))
445 (insert dap16-comment-char)
446 (setq count ( 1+ count)))
451 (defun dap16-tabulator ()
453 (if (is-comment-line)
455 (setq target (prog2 (insert "\t") (current-column) (delete-backward-char 1) ))
456 (while (< (current-column) target) (insert " "))
464 (defun dap16-newline ()
465 "Insert LFD + fill-prefix, to bring us back to code-indent level."
468 (if (is-comment-line)
470 (if (at-begin-of-line) (goto-char (+ (point) 1)))
471 (insert "\n" dap16-comment-char dap16-comment-space))
474 (progn (delete-horizontal-space)
486 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.[sS]\\'" . dap16-mode))
487 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.asm\\'" . dap16-mode))
489 ;;; dap16-mode.el ends here