Re: asm-mode patch to allow per-file comment character setting from file locals

[Masatake YAMATO]

> Hi there,
> 
> Here's a short patch to asm-mode.el that I use so that I can easily  
> vary the comment style used for assembly language files on a per-file  
> basis.  This is particularly useful on Mac OS X, where the Intel and  
> PowerPC versions of the system assembler use different comment  
> characters (I believe the PowerPC version actually accepts both ';'  
> and '#', but the Intel one certainly requires '#').
> 
> An example of its use:
> 
>    ###
>    ### Local Variables:
>    ### asm-comment-char: ?\#
>    ### End:
>    ###
> 
> Here's the patch:

Interesting.

I have met with the same situation when I read linux/arch/*/*.S files.
Font lock rules of asm-mode are not enough for the situation.
So I tried to write modes derived from asm-mode for each architecture/asm 
syntax.
I refer the info file of gas to know the asm syntaxes, so I called the derived
modes gas-*-mode, here * is a name of architecture.

You can do like: 

    M-x gas-i386-mode
,
    M-x gas-ppc-mode
or
    M-x gas-arm-mode if you want to hack iPod:-P

If your asm file is at /foo/bar/i386/baz.s or /foo/bar/ppc/baz.s,
gas-i386-mode or gas-ppc-mode is automatically selected.

Masatake YAMATO

(require 'asm-mode)
(require 'assoc)

(defgroup gas nil
  "Architecture specific mode for editing assembler code."
  :group 'asm)

(defcustom gas-mode-hook nil
  "*Hook that gets run after the gas mode ."
  :type  'hook
  :group 'asm)

(defvar gas-mode-architecture-history nil)
(defun gas-mode (&optional architecture)
  "Wrapper for gas-*-mode."
  (interactive (list 
                (let ((md (gas-choose-mode-automatically)))
                  (if current-prefix-arg
                      (completing-read "Architecture: "
                                       gas-machine-dependents
                                       nil
                                       t
                                       md
                                       'gas-mode-architecture-history
                                       md)
                    (gas-choose-mode-automatically)))))
  (unless (interactive-p)
    (setq architecture (gas-choose-mode-automatically)))
  (if architecture
      (let* ((machine-dependent (aget gas-machine-dependents architecture))
             (mode-func         (nth 0 machine-dependent))
             (asm-comment-chars (car (nth 1 machine-dependent))))
        (call-interactively mode-func))
    (asm-mode))
  (run-mode-hooks 'gas-mode-hook))

(defvar gas-machine-dependents nil)
(defun gas-register-machine-dependent (name
                                       comment-chars
                                       register-prefix-chars
                                       immediate-prefix-chars
                                       extra-symbol-chars
                                       statement-separator-char
                                       auto-mode)
  (let ((mode-func (intern (format "gas-%s-mode" name))))
    (aput 'gas-machine-dependents name 
          (list mode-func comment-chars auto-mode))
    (eval
     `(define-derived-mode ,mode-func asm-mode ,(format "Gas/%s" name)
        ,(format "%s specific asm mode" name)
        :syntax-table (gas-make-syntax-table 
                       ',comment-chars
                       ',register-prefix-chars
                       ',immediate-prefix-chars
                       ',extra-symbol-chars 
                       ',statement-separator-char)
        (make-local-variable 'font-lock-defaults)
        (setq font-lock-defaults (list 
                                  (gas-make-font-lock-keywords ',comment-chars
                                                               
',register-prefix-chars
                                                               
',immediate-prefix-chars
                                                               
',extra-symbol-chars 
                                                               
',statement-separator-char)))))))

(defun gas-choose-mode-automatically ()
  (catch 'found
    (dolist (md gas-machine-dependents)
      (let ((auto-mode (nth 3 md)))
        (when (eq auto-mode t)
          (setq auto-mode (car md)))
        (cond 
         ((and (stringp auto-mode)
               (buffer-file-name))
          (when (string-match auto-mode (buffer-file-name))
            (throw 'found (car md))))
         ((functionp auto-mode)
          (when (funcall 'auto-mode)
            (throw 'found (car md)))))))))

(defun gas-make-syntax-table (comment-chars
                              register-prefix-chars
                              immediate-prefix-chars
                              extra-symbol-chars
                              statement-separator-char)
  (let ((st (copy-syntax-table asm-mode-syntax-table)))
    (mapc (lambda (c) (modify-syntax-entry c "< b" st))
          comment-chars)
    (mapc (lambda (c) (modify-syntax-entry c "'" st))
          register-prefix-chars)
    (mapc (lambda (c) (modify-syntax-entry c "'" st))
          immediate-prefix-chars)
    (mapc (lambda (c) (modify-syntax-entry c "w" st)) ; "_"?
          extra-symbol-chars)
    (mapc (lambda (c) (modify-syntax-entry c " " st))
          statement-separator-char)
    st))

(defun gas-make-font-lock-keywords (comment-chars
                                    register-prefix-chars
                                    immediate-prefix-chars
                                    extra-symbol-chars
                                    statement-separator-chars)
  (let ((rp (when register-prefix-chars
              (cons (concat 
                     "[" (mapconcat 'char-to-string  register-prefix-chars "") 
                     "]" 
                     "\\sw+") font-lock-variable-name-face)))
        (ip (when immediate-prefix-chars
              (cons (concat
                     "[" (mapconcat 'char-to-string immediate-prefix-chars "") 
                     "]" 
                     "\\(?:\\s_\\|\\sw\\)+") font-lock-constant-face)))
        (pattern))
    (when rp (push rp pattern))
    (when ip (push ip pattern))
    (append
     pattern
     asm-font-lock-keywords)))

;; c:comment-char 
;; r:register-prefix-chars 
;; i:immediate-prefix-chars 
;; sym:extra-symbol-chars 
;; sep:statement-separator-char
;; am: regexp for auto mode selection.
;;                              name       c           r      i        sym      
  sep   am
(gas-register-machine-dependent "alpha"   '(?#)       '(?$)   nil      nil      
 '(?\;) t)
(gas-register-machine-dependent "arm"     '(?@)        nil   '(?# ?$) '(?_ ?\\) 
 '(?\;) t)
(gas-register-machine-dependent "cris"    '(?\; ?#)   '(?$)   nil      nil      
 '(?\@) t)

;; frv???
(gas-register-machine-dependent "frv"     '(?\; ?#)    nil    nil      nil      
  nil   t)

(gas-register-machine-dependent "h8300"   '(?\;)      '(?@)   '(?#)   '(?_)     
 '(?\$) t)
;; #include doesn't work well.
(gas-register-machine-dependent "i386"    '(?#)       '(?%)   '(?$)    nil      
 '(?\;) "i386\\|x86_64")
;; comment is broken
(gas-register-machine-dependent "ia64"     nil         nil     nil     nil      
 '(?\;) t)
(gas-register-machine-dependent "m32r"    '(?\;)      '(?@)   '(?#)   '(?+)     
  nil   t)
(gas-register-machine-dependent "m68k"    '(?\|)      '(?%)   '(?#)   '(?@)     
  nil   "68k")
(gas-register-machine-dependent "mips"    '(?#)       '(?$)    nil    '(?@)     
  nil   t)
(gas-register-machine-dependent "parisc"  '(?\;)      '(?%)    nil    '(?$)     
 '(?!)  t)
(gas-register-machine-dependent "ppc"      nil         nil     nil     nil      
 '(?\;) "powerpc\\|ppc")
(gas-register-machine-dependent "s390"    '(?#)       '(?%)    nil     nil      
  nil   t)
(gas-register-machine-dependent "sh"      '(?!)       '(?@)   '(?#)   '(?$ ?-)  
 '(?\;) t)
(gas-register-machine-dependent "sparc"   '(?!)       '(?%)    nil     nil      
 '(?\;) t)
(gas-register-machine-dependent "v850"    '(?#)        nil     nil     nil      
 '(?\;) t)
(gas-register-machine-dependent "xtensa"  '(?#)       '(?$)    nil     nil      
 '(?\;) t)

(add-to-list 'auto-mode-alist '("\\.[sS]\\'" . gas-mode))
(provide 'gas-mode)
;; gas-mode.el ends here