[2] | 1 | ;;
|
---|
| 2 | ;; TOPPERS Software
|
---|
| 3 | ;; Toyohashi Open Platform for Embedded Real-Time Systems
|
---|
| 4 | ;;
|
---|
| 5 | ;; Copyright (C) 2010 by TAKUYA
|
---|
| 6 | ;; Embedded and Real-Time Systems Laboratory
|
---|
| 7 | ;; Graduate School of Information Science, Nagoya Univ., JAPAN
|
---|
| 8 | ;;
|
---|
| 9 | ;; ãLì ÒÍCȺÌ(1)`(4)Ìðð½·êÉÀèC{\tgEF
|
---|
| 10 | ;; Ai{\tgEFAðüϵ½àÌðÜÞDȺ¯¶jðgpE¡»Eü
|
---|
| 11 | ;; ÏEÄzziȺCpÆÄÔj·é±Æð³Åø·éD
|
---|
| 12 | ;; (1) {\tgEFAð\[XR[hÌ`Åp·éêÉÍCãLÌì
|
---|
| 13 | ;; \¦C±Ìpð¨æѺL̳ÛØKèªC»ÌÜÜÌ`Å\[
|
---|
| 14 | ;; XR[hÉÜÜêÄ¢é±ÆD
|
---|
| 15 | ;; (2) {\tgEFAðCCu`®ÈÇC¼Ì\tgEFAJÉg
|
---|
| 16 | ;; pÅ«é`ÅÄzz·éêÉÍCÄzzɺ¤hL
|
---|
| 17 | gip
|
---|
| 18 | ;; Ò}j
|
---|
| 19 | AÈÇjÉCãLÌì \¦C±Ìpð¨æѺL
|
---|
| 20 | ;; ̳ÛØKèðfÚ·é±ÆD
|
---|
| 21 | ;; (3) {\tgEFAðC@íÉgÝÞÈÇC¼Ì\tgEFAJÉg
|
---|
| 22 | ;; pÅ«È¢`ÅÄzz·éêÉÍCÌ¢¸ê©Ìðð½·±
|
---|
| 23 | ;; ÆD
|
---|
| 24 | ;; (a) Äzzɺ¤hL
|
---|
| 25 | gipÒ}j
|
---|
| 26 | AÈÇjÉCãLÌ
|
---|
| 27 | ;; ì \¦C±Ìpð¨æѺL̳ÛØKèðfÚ·é±ÆD
|
---|
| 28 | ;; (b) ÄzzÌ`ÔðCÊÉèßéû@ÉæÁÄCTOPPERSvWFNgÉ
|
---|
| 29 | ;; ñ·é±ÆD
|
---|
| 30 | ;; (4) {\tgEFAÌpÉæè¼ÚIܽÍÔÚIɶ¶é¢©Èé¹
|
---|
| 31 | ;; Q©çàCãLì Ò¨æÑTOPPERSvWFNgðÆÓ·é±ÆD
|
---|
| 32 | ;; ܽC{\tgEFAÌ[UܽÍGh[U©çÌ¢©Èé
|
---|
| 33 | ;; RÉîÿ©çàCãLì Ò¨æÑTOPPERSvWFNgð
|
---|
| 34 | ;; ÆÓ·é±ÆD
|
---|
| 35 | ;;
|
---|
| 36 | ;; {\tgEFAÍC³ÛØÅñ³êÄ¢éàÌÅ éDãLì Ò¨
|
---|
| 37 | ;; æÑTOPPERSvWFNgÍC{\tgEFAÉÖµÄCÁèÌgpÚI
|
---|
| 38 | ;; ÉηéK«àÜßÄC¢©ÈéÛØàsíÈ¢DܽC{\tgEF
|
---|
| 39 | ;; AÌpÉæè¼ÚIܽÍÔÚIɶ¶½¢©Èé¹QÉÖµÄàC»
|
---|
| 40 | ;; ÌÓCðíÈ¢D
|
---|
| 41 | ;;
|
---|
| 42 | ;;
|
---|
| 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
| 44 | ;;
|
---|
| 45 | ;; tf-mode for xyzzy
|
---|
| 46 | ;;
|
---|
| 47 | ;;
|
---|
| 48 | ;; [hû@D
|
---|
| 49 | ;; 1. tf-mode.l ð site-lisp/ ̺ÉC
|
---|
| 50 | ;; tf ð etc/ ̺ɻê¼ê¨D
|
---|
| 51 | ;; 2. ºLð .xyzzy ÉÇÁ·éD
|
---|
| 52 | ;;
|
---|
| 53 | ;; (require "tf-mode")
|
---|
| 54 | ;; (push '("\\.tf$" . tf-mode) *auto-mode-alist*)
|
---|
| 55 | ;;
|
---|
| 56 |
|
---|
| 57 | (provide "tf-mode")
|
---|
| 58 |
|
---|
| 59 | (in-package "editor")
|
---|
| 60 |
|
---|
| 61 | (export '(tf-mode
|
---|
| 62 | *tf-mode-hook* *tf-indent-column*
|
---|
| 63 | *tf-tab-always-indent*))
|
---|
| 64 |
|
---|
| 65 | (defvar *tf-mode-hook* nil)
|
---|
| 66 |
|
---|
| 67 | ;; (add-hook '*tf-mode-hook* #'(lambda()
|
---|
| 68 | ;; (set-syntax-match (syntax-table) #\( #\))
|
---|
| 69 | ;; (set-syntax-match (syntax-table) #\{ #\})
|
---|
| 70 | ;; (set-syntax-match (syntax-table) #\[ #\])
|
---|
| 71 | ;; ))
|
---|
| 72 |
|
---|
[9] | 73 | (defvar *tf-mode-map* nil)
|
---|
[2] | 74 | (unless *tf-mode-map*
|
---|
| 75 | (setq *tf-mode-map* (make-sparse-keymap))
|
---|
| 76 | (define-key *tf-mode-map* #\TAB 'tf-indent-line)
|
---|
| 77 | (define-key *tf-mode-map* '(#\C-c #\I) 'tf-indent-region)
|
---|
[9] | 78 | )
|
---|
| 79 |
|
---|
| 80 | (defvar *tf-mode-syntax-table* nil)
|
---|
| 81 | (unless *tf-mode-syntax-table*
|
---|
| 82 | (setq *tf-mode-syntax-table* (make-syntax-table))
|
---|
| 83 | (do ((x #x21 (1+ x)))((>= x #x7f))
|
---|
| 84 | (let ((c (code-char x)))
|
---|
| 85 | (unless (alphanumericp c)
|
---|
| 86 | (set-syntax-punctuation *tf-mode-syntax-table* c))))
|
---|
| 87 | (set-syntax-option *tf-mode-syntax-table*
|
---|
| 88 | *syntax-option-c-preprocessor*)
|
---|
| 89 | (set-syntax-string *tf-mode-syntax-table* #\")
|
---|
| 90 | (set-syntax-string *tf-mode-syntax-table* #\')
|
---|
| 91 | (set-syntax-escape *tf-mode-syntax-table* #\\)
|
---|
| 92 | (set-syntax-symbol *tf-mode-syntax-table* #\_)
|
---|
[2] | 93 | (set-syntax-symbol *tf-mode-syntax-table* #\#)
|
---|
| 94 | (set-syntax-match *tf-mode-syntax-table* #\( #\))
|
---|
| 95 | (set-syntax-match *tf-mode-syntax-table* #\{ #\})
|
---|
| 96 | (set-syntax-match *tf-mode-syntax-table* #\[ #\]))
|
---|
| 97 |
|
---|
| 98 |
|
---|
| 99 | ;; etc/tfÌL[[hðQÆ
|
---|
| 100 |
|
---|
| 101 | (defvar *tf-keyword-hash-table* nil)
|
---|
| 102 | (defvar *tf-keyword-file* "tf")
|
---|
| 103 |
|
---|
| 104 | ;; Fï·éL[[h
|
---|
| 105 |
|
---|
| 106 | (defvar *tf-regexp-keyword-list* nil)
|
---|
| 107 | (setq *tf-regexp-keyword-list*
|
---|
| 108 | (compile-regexp-keyword-list
|
---|
| 109 | '(
|
---|
| 110 | ("^\$[ \t].*" nil (:keyword :comment :line) nil nil nil)
|
---|
| 111 | ("\\([\$]\\)\\(IF\\|FOREACH\\|JOINEACH\\)\\([ \t]\\)" nil (:keyword 0 :bold) nil 2 nil)
|
---|
| 112 | ("\\([\$]\\)\\(END\\|ELSE\\)\\([\$]\\)" nil (:keyword 0 :bold) nil 2 2)
|
---|
| 113 | ("\\([\$]\\)\\(FUNCTION\\|FILE\\|INCLUDE\\)\\([ \t]\\)" nil (:keyword 1 :bold) nil 2 nil)
|
---|
| 114 | ("\\([\$]\\)\\(ERROR\\|WORNING\\)\\([ \t\$]\\)" nil (:keyword 1 :bold) nil 2 2)
|
---|
| 115 | ("\\([\$]\\)\\(SPC\\|TAB\\|NL\\|ARGC\\|ARGV\\|RESULT\\)\\([\$]\\)" nil (:keyword :string :bold) nil 2 2)
|
---|
| 116 | ("\\([\"]\\)\\([^\"]\\)*\\([\"]\\)" nil (:keyword :string) nil nil nil)
|
---|
| 117 | ("\\([\']\\)\\([^\']\\)*\\([\']\\)" nil (:keyword :string) nil nil nil)
|
---|
| 118 | )
|
---|
| 119 | ))
|
---|
| 120 | ; ("³K\»" 嶬¶ÌæÊðµÈ¢H color LøÍÍ Ç±©ç DZÜÅ)
|
---|
| 121 |
|
---|
| 122 |
|
---|
| 123 | ;;--------------------------------------------------------------------------
|
---|
| 124 | ;;
|
---|
| 125 | ;; CfgÉÖ·éè`
|
---|
| 126 | ;;
|
---|
| 127 | ;;--------------------------------------------------------------------------
|
---|
[9] | 128 |
|
---|
[2] | 129 | (defvar *tf-tab-always-indent* t)
|
---|
| 130 |
|
---|
| 131 | (defvar *tf-block-beg-re*
|
---|
| 132 | "[\$]\\(\\(IF\\|FOREACH\\|JOINEACH\\|FUNCTION\\|ERROR\\|WORNING\\)[ ]\\|\\(ERROR\\|WORNING\\)[\$]\\)")
|
---|
| 133 | (defvar *tf-block-mid-re*
|
---|
| 134 | "\$ELSE[\$]")
|
---|
| 135 | (defvar *tf-block-end-re* "\$END[\$]")
|
---|
| 136 |
|
---|
| 137 | (defvar *tf-indent-column* 4)
|
---|
| 138 |
|
---|
| 139 | (defun tf-space-line ()
|
---|
| 140 | "ós©Ç¤©"
|
---|
| 141 | (save-excursion
|
---|
| 142 | (goto-bol)
|
---|
| 143 | (looking-at "\\([ \t]*$\\|^\$[ \t]\\)")))
|
---|
| 144 |
|
---|
| 145 | (defun tf-previous-line ()
|
---|
| 146 | "ós¶áÈ¢sÜÅßé"
|
---|
| 147 | (while (forward-line -1)
|
---|
| 148 | ;(message-box (format nil "=> ~D" (current-line-number)))
|
---|
| 149 | (unless (tf-space-line)
|
---|
| 150 | (return-from tf-previous-line t))))
|
---|
| 151 |
|
---|
| 152 | (defun calc-tf-indent ()
|
---|
| 153 | "Cfg·éð¦é"
|
---|
| 154 | (let ((column 0) (curp (point)))
|
---|
| 155 | (save-excursion
|
---|
| 156 | ;OÌsð²×é
|
---|
| 157 | (when (tf-previous-line)
|
---|
| 158 | (goto-bol)
|
---|
| 159 | (skip-chars-forward " \t")
|
---|
| 160 | ; Cfg
|
---|
| 161 | (setq column (current-column))
|
---|
| 162 | ;(message-box (format nil "column1: ~D" column))
|
---|
| 163 | (save-restriction
|
---|
| 164 | (narrow-to-region (progn (goto-eol) (point))
|
---|
| 165 | (progn (goto-bol) (point)))
|
---|
| 166 | (skip-chars-forward " \t")
|
---|
| 167 | ; J«à̪ êÎCfgðâ·
|
---|
| 168 | (cond
|
---|
| 169 | ((looking-at *tf-block-beg-re*)
|
---|
| 170 | (setq column (+ column *tf-indent-column*)))
|
---|
| 171 | ((looking-at *tf-block-mid-re*)
|
---|
| 172 | (setq column (+ column *tf-indent-column*)))
|
---|
| 173 | )
|
---|
| 174 | )))
|
---|
| 175 | ;(message-box (format nil "column2: ~D" column))
|
---|
| 176 | ; »ÝÌsð²×é
|
---|
| 177 | (save-excursion
|
---|
| 178 | (save-restriction
|
---|
| 179 | (narrow-to-region (progn (goto-eol) (point))
|
---|
| 180 | (progn (goto-bol) (point)))
|
---|
| 181 | (goto-bol)
|
---|
| 182 | (skip-chars-forward " \t")
|
---|
| 183 | ; ¶à̪ êÎCfgð¸ç·
|
---|
| 184 | (cond
|
---|
| 185 | ((looking-at *tf-block-end-re*)
|
---|
| 186 | (setq column (- column *tf-indent-column*)))
|
---|
| 187 | ((looking-at *tf-block-mid-re*)
|
---|
| 188 | (setq column (- column *tf-indent-column*)))
|
---|
| 189 | )))
|
---|
| 190 | column
|
---|
| 191 | ))
|
---|
| 192 |
|
---|
| 193 | (defun tf-not-comment-line ()
|
---|
| 194 | (save-excursion
|
---|
| 195 | (progn
|
---|
| 196 | (beginning-of-line)
|
---|
| 197 | (if (looking-at "^\$[ \t]")
|
---|
| 198 | nil
|
---|
| 199 | t
|
---|
| 200 | )
|
---|
| 201 | )
|
---|
| 202 | ))
|
---|
| 203 |
|
---|
| 204 | (defun tf-indent-line ()
|
---|
| 205 | (interactive "*")
|
---|
| 206 | (if (or (not (interactive-p))
|
---|
| 207 | *tf-tab-always-indent*
|
---|
| 208 | (save-excursion
|
---|
| 209 | (skip-chars-backward " \t")
|
---|
| 210 | (bolp)))
|
---|
| 211 | (if (tf-not-comment-line) ;; RgsÅȯêÎÀs·é
|
---|
| 212 | ; ±±ðϦ½¾¯
|
---|
| 213 | (let ((column (calc-tf-indent)))
|
---|
| 214 | (when (integerp column)
|
---|
| 215 | (save-excursion
|
---|
| 216 | (goto-bol)
|
---|
| 217 | (delete-region (point)
|
---|
| 218 | (progn
|
---|
| 219 | (skip-chars-forward " \t")
|
---|
| 220 | (point)))
|
---|
| 221 | (indent-to column)))
|
---|
| 222 | (if (and (bolp) column)
|
---|
| 223 | (skip-chars-forward " \t")))
|
---|
[9] | 224 | )
|
---|
| 225 | (insert "\t"))
|
---|
| 226 | t)
|
---|
| 227 |
|
---|
| 228 | (defun tf-indent-region (from to)
|
---|
| 229 | (interactive "*r")
|
---|
| 230 | (if (> from to)
|
---|
| 231 | (rotatef from to))
|
---|
| 232 | (save-excursion
|
---|
| 233 | (save-restriction
|
---|
| 234 | (narrow-to-region (point-min) to)
|
---|
| 235 | (goto-char from)
|
---|
| 236 | (goto-eol)
|
---|
| 237 | ;; (delete-trailing-spaces)
|
---|
| 238 | (while (forward-line 1)
|
---|
| 239 | (goto-eol)
|
---|
| 240 | ;; (delete-trailing-spaces)
|
---|
[2] | 241 | (unless (bolp)
|
---|
| 242 | (funcall mode-specific-indent-command)))))
|
---|
| 243 | t)
|
---|
| 244 |
|
---|
| 245 | ;; -------------------------------------------------------------------------
|
---|
| 246 | ;;
|
---|
| 247 | ;; tf-mode{Ì
|
---|
| 248 | ;;
|
---|
| 249 | ;; -------------------------------------------------------------------------
|
---|
| 250 |
|
---|
| 251 | (defun tf-mode ()
|
---|
| 252 | (interactive)
|
---|
| 253 | (kill-all-local-variables)
|
---|
| 254 | (setq buffer-mode 'tf-mode)
|
---|
| 255 | (setq mode-name "tf")
|
---|
| 256 | (use-keymap *tf-mode-map*)
|
---|
| 257 | (make-local-variable 'mode-specific-indent-command)
|
---|
| 258 | (setq mode-specific-indent-command #'tf-indent-line)
|
---|
| 259 | (use-syntax-table *tf-mode-syntax-table*)
|
---|
| 260 | (and *tf-keyword-file*
|
---|
| 261 | (null *tf-keyword-hash-table*)
|
---|
| 262 | (setq *tf-keyword-hash-table*
|
---|
| 263 | (load-keyword-file *tf-keyword-file*)))
|
---|
| 264 | (when *tf-keyword-hash-table*
|
---|
| 265 | (make-local-variable 'keyword-hash-table)
|
---|
| 266 | (setq keyword-hash-table *tf-keyword-hash-table*))
|
---|
| 267 | (make-local-variable 'regexp-keyword-list)
|
---|
| 268 | (setq regexp-keyword-list *tf-regexp-keyword-list*)
|
---|
| 269 | (run-hooks '*tf-mode-hook*))
|
---|
| 270 |
|
---|
| 271 | ;; -------------------------------------------------------------------------
|
---|
| 272 | ;;
|
---|
| 273 | ;; $END$ÌÎðT·
|
---|
[9] | 274 | ;;
|
---|
[2] | 275 | ;; -------------------------------------------------------------------------
|
---|
| 276 |
|
---|
| 277 | ;; ÎðT·½ß̳K\»
|
---|
| 278 | (defvar *tf-block-keyword* "[\$]\\(IF[ \t]\\|FOREACH[ \t]\\|JOINEACH[ \t]\\|FUNCTION[ \t]\\|END[\$]\\|ERROR[ \$]\\|WORNING[ \$]\\)")
|
---|
| 279 | (defvar *tf-block-tag* 'tf-block)
|
---|
| 280 |
|
---|
| 281 |
|
---|
| 282 | (defvar-local *stored-text-attributes* nil)
|
---|
| 283 |
|
---|
| 284 | (defun save-text-attributes (&optional start end)
|
---|
| 285 | (setq *stored-text-attributes*
|
---|
| 286 | (list-text-attributes start end)))
|
---|
| 287 |
|
---|
| 288 | (defun restore-text-attributes ()
|
---|
| 289 | (mapc (lambda (attr) (apply #'set-text-attribute attr))
|
---|
| 290 | *stored-text-attributes*)
|
---|
| 291 | (setq *stored-text-attributes* nil))
|
---|
| 292 |
|
---|
| 293 |
|
---|
| 294 | (defun tf-block-pre-hook ()
|
---|
| 295 | (delete-text-attributes *tf-block-tag*)
|
---|
| 296 | (restore-text-attributes)
|
---|
| 297 | )
|
---|
| 298 |
|
---|
| 299 |
|
---|
| 300 | (defun tf-block-hook ()
|
---|
| 301 | (progn
|
---|
| 302 | (if (string-match "tf" mode-name) ;; tf-modeÌÆ«¾¯
|
---|
| 303 | (let (now)
|
---|
| 304 | (save-excursion
|
---|
| 305 | (progn
|
---|
| 306 | (setq now (point))
|
---|
| 307 | (if (string-match "\$END\$" (buffer-substring (- now 5) (- now 1))) ;; $END$ÌãëÉJ[\
|
---|
| 308 | (progn
|
---|
| 309 | (goto-char now)
|
---|
| 310 | (save-text-attributes)
|
---|
| 311 | (do-tf-block) ;; {ÌÄÑoµ
|
---|
| 312 | )
|
---|
| 313 | )
|
---|
| 314 | )
|
---|
| 315 | )
|
---|
| 316 | )
|
---|
| 317 | )
|
---|
| 318 | )
|
---|
| 319 | )
|
---|
| 320 |
|
---|
| 321 | (defun do-tf-block ()
|
---|
| 322 | (let (from to end_depth line_no line_string tmp_string now)
|
---|
| 323 | (save-excursion
|
---|
| 324 | (setq from (point))
|
---|
| 325 | (backward-char 1)
|
---|
| 326 | (if (scan-buffer *tf-block-keyword* :reverse t :regexp t)
|
---|
| 327 | (progn
|
---|
| 328 | (setq end_depth 1) ;; $END$Ì[³
|
---|
| 329 | (while (> end_depth 0) ;; $END$ÌΪ©Â©éÜÅ
|
---|
| 330 | (progn
|
---|
| 331 | (if (scan-buffer *tf-block-keyword* :reverse t :regexp t :no-dup t)
|
---|
| 332 | (progn
|
---|
| 333 | (setq tmp_string (match-string 0))
|
---|
| 334 | (setq now (point))
|
---|
| 335 | (beginning-of-line)
|
---|
| 336 | (if (not (string-match "^$[ \t]" (buffer-substring (point) (+ (point) 2)))) ;; RgAEg©`FbN
|
---|
| 337 | (progn
|
---|
| 338 | (goto-char now)
|
---|
| 339 | (if (string-match "[\$]END[\$]" tmp_string) ;; $END$ª©Â©Á½
|
---|
| 340 | (setq end_depth (+ end_depth 1)) ;; [³+1
|
---|
| 341 | (progn ;; $END$ÈOª©Â©Á½
|
---|
| 342 | (setq end_depth (- end_depth 1)) ;; [³-1
|
---|
| 343 | ))
|
---|
| 344 | )
|
---|
| 345 | )
|
---|
| 346 | )
|
---|
| 347 | (setq end_depth -1) ;; $END$ÌΪȢ
|
---|
| 348 | )))
|
---|
| 349 | (if (= end_depth 0) ;; $END$ÌΪ Á½
|
---|
| 350 | (progn
|
---|
| 351 | (setq to (point))
|
---|
| 352 | (setq line_no (current-line-number))
|
---|
| 353 | (end-of-line)
|
---|
| 354 | (setq line_string (buffer-substring to (point)))
|
---|
| 355 | (message "~d : ~s" line_no line_string) ;; sÔ,sàeð\¦
|
---|
| 356 | (set-text-attribute from to *tf-block-tag* :bold t) ;; ÍÜê½ÍÍð²
|
---|
| 357 | )
|
---|
| 358 | (message "È¢©à¾æ") ;; $END$ÌΪȩÁ½
|
---|
| 359 | )
|
---|
| 360 | )
|
---|
| 361 | )
|
---|
| 362 | )
|
---|
| 363 | )
|
---|
| 364 | )
|
---|
| 365 |
|
---|
| 366 |
|
---|
| 367 | (add-hook '*pre-command-hook* 'tf-block-pre-hook) ;; post-command-hookÉÇÁ
|
---|
| 368 | (add-hook '*post-command-hook* 'tf-block-hook) ;; post-command-hookÉÇÁ
|
---|