source:
tf-mode /trunk /tf-mode.l @
9
| Last change on this file since 9 was 9, checked in by ertl-ishikawa, 15 years ago | |
|---|---|
|
WORNINGとERRORのEND対応がとれていないバグを修正. |
|
| File size: 11.3 KB | |
| Line | |
|---|---|
| 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ÈoÌ(1)`(4)Ìðð1⁄2·êÉÀèC{\tgEF |
| 10 | ;; Ai{\tgEFAðüÏμ1⁄2àÌðÜÞDÈo ̄¶jðgpE¡»Eü |
| 11 | ;; ÏEÄzziÈoCpÆÄÔj·é±Æð3Åø·éD |
| 12 | ;; (1) {\tgEFAð\[XR[hÌ`Åp·éêÉÍCãLÌì |
| 13 | ;; \¦C±Ìpð ̈æÑoLÌ3ÛØKèaC»ÌÜÜÌ`Å\[ |
| 14 | ;; XR[hÉÜÜêÄ¢é±ÆD |
| 15 | ;; (2) {\tgEFAðCCu`®ÈÇC1⁄4Ì\tgEFAJÉg |
| 16 | ;; pÅ«é`ÅÄzz·éêÉÍCÄzzÉo¤hL |
| 17 | gip |
| 18 | ;; Ò}j |
| 19 | AÈÇjÉCãLÌì \¦C±Ìpð ̈æÑoL |
| 20 | ;; Ì3ÛØKèðfÚ·é±ÆD |
| 21 | ;; (3) {\tgEFAðC@íÉgÝÞÈÇC1⁄4Ì\tgEFAJÉg |
| 22 | ;; pÅ«È¢`ÅÄzz·éêÉÍCÌ¢ ̧ê©Ìðð1⁄2·± |
| 23 | ;; ÆD |
| 24 | ;; (a) ÄzzÉo¤hL |
| 25 | gipÒ}j |
| 26 | AÈÇjÉCãLÌ |
| 27 | ;; ì \¦C±Ìpð ̈æÑoLÌ3ÛØKèðfÚ·é±ÆD |
| 28 | ;; (b) ÄzzÌ`ÔðCÊÉèßéû@ÉæÁÄCTOPPERSvWFNgÉ |
| 29 | ;; ñ·é±ÆD |
| 30 | ;; (4) {\tgEFAÌpÉæè1⁄4ÚIÜ1⁄2ÍÔÚIɶ¶é¢©Èé1 |
| 31 | ;; Q©çàCãLì Ò ̈æÑTOPPERSvWFNgðÆÓ·é±ÆD |
| 32 | ;; Ü1⁄2C{\tgEFAÌ[UÜ1⁄2ÍGh[U©çÌ¢©Èé |
| 33 | ;; RÉîÿ©çàCãLì Ò ̈æÑTOPPERSvWFNgð |
| 34 | ;; ÆÓ·é±ÆD |
| 35 | ;; |
| 36 | ;; {\tgEFAÍC3ÛØÅñ3êÄ¢éàÌÅ éDãLì Ò ̈ |
| 37 | ;; æÑTOPPERSvWFNgÍC{\tgEFAÉÖμÄCÁèÌgpÚI |
| 38 | ;; ÉηéK«àÜßÄC¢©ÈéÛØàsíÈ¢DÜ1⁄2C{\tgEF |
| 39 | ;; AÌpÉæè1⁄4ÚIÜ1⁄2ÍÔÚIɶ¶1⁄2¢©Èé1QÉÖμÄà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/ ÌoÉC |
| 50 | ;; tf ð etc/ ÌoÉ»ê1⁄4ê ̈D |
| 51 | ;; 2. oLð .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 | |
| 73 | (defvar *tf-mode-map* nil) |
| 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) |
| 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* #\_) |
| 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 | ; ("3K\»" 嶬¶ÌæÊðμÈ¢H color LøÍÍ Ç±©ç DZÜÅ) |
| 121 | |
| 122 | |
| 123 | ;;-------------------------------------------------------------------------- |
| 124 | ;; |
| 125 | ;; CfgÉÖ·éè` |
| 126 | ;; |
| 127 | ;;-------------------------------------------------------------------------- |
| 128 | |
| 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«àÌa êÎ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 | ; ¶àÌa êÎ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 | ; ±±ðϦ1⁄23⁄4 ̄ |
| 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"))) |
| 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) |
| 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· |
| 274 | ;; |
| 275 | ;; ------------------------------------------------------------------------- |
| 276 | |
| 277 | ;; ÎðT·1⁄2ßÌ3K\» |
| 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ÌÆ«3⁄4 ̄ |
| 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$Ì[3 |
| 329 | (while (> end_depth 0) ;; $END$ÌÎa©Â©éÜÅ |
| 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$a©Â©Á1⁄2 |
| 340 | (setq end_depth (+ end_depth 1)) ;; [3+1 |
| 341 | (progn ;; $END$ÈOa©Â©Á1⁄2 |
| 342 | (setq end_depth (- end_depth 1)) ;; [3-1 |
| 343 | )) |
| 344 | ) |
| 345 | ) |
| 346 | ) |
| 347 | (setq end_depth -1) ;; $END$ÌÎaÈ¢ |
| 348 | ))) |
| 349 | (if (= end_depth 0) ;; $END$ÌÎa Á1⁄2 |
| 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) ;; ÍÜê1⁄2ÍÍð2 |
| 357 | ) |
| 358 | (message "È¢©à3⁄4æ") ;; $END$ÌÎaÈ©Á1⁄2 |
| 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ÉÇÁ |
Note:
See TracBrowser
for help on using the repository browser.