source:
tf-mode /trunk /tf-mode.l @
2
| Last change on this file since 2 was 2, checked in by ertl-ishikawa, 15 years ago | |
|---|---|
|
tf-modeとCDL-modeを追加. |
|
| File size: 10.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 | ) |
| 78 | |
| 79 | (defvar *tf-mode-syntax-table* nil) |
| 80 | (unless *tf-mode-syntax-table* |
| 81 | (setq *tf-mode-syntax-table* (make-syntax-table))) |
| 82 | ;; (set-syntax-start-comment *tf-mode-syntax-table* #\$\t t) |
| 83 | ;; (set-syntax-end-comment *tf-mode-syntax-table* #\LFD nil t)) |
| 84 | |
| 85 | |
| 86 | ;; etc/tfÌL[[hðQÆ |
| 87 | |
| 88 | (defvar *tf-keyword-hash-table* nil) |
| 89 | (defvar *tf-keyword-file* "tf") |
| 90 | |
| 91 | ;; FÃ ̄·éL[[h |
| 92 | |
| 93 | (defvar *tf-regexp-keyword-list* nil) |
| 94 | (setq *tf-regexp-keyword-list* |
| 95 | (compile-regexp-keyword-list |
| 96 | '( |
| 97 | ("^\$[ \t].*" nil (:keyword :comment :line) nil nil nil) |
| 98 | ("\\([\$]\\)\\(IF\\|FOREACH\\|JOINEACH\\)\\([ \t]\\)" nil (:keyword 0 :bold) nil 2 nil) |
| 99 | ("\\([\$]\\)\\(END\\|ELSE\\)\\([\$]\\)" nil (:keyword 0 :bold) nil 2 2) |
| 100 | ("\\([\$]\\)\\(FUNCTION\\|FILE\\|INCLUDE\\)\\([ \t]\\)" nil (:keyword 1 :bold) nil 2 nil) |
| 101 | ("\\([\$]\\)\\(ERROR\\|WORNING\\)\\([ \t\$]\\)" nil (:keyword 1 :bold) nil 2 2) |
| 102 | ("\\([\$]\\)\\(SPC\\|TAB\\|NL\\|ARGC\\|ARGV\\|RESULT\\)\\([\$]\\)" nil (:keyword :string :bold) nil 2 2) |
| 103 | ("\\([\"]\\)\\([^\"]\\)*\\([\"]\\)" nil (:keyword :string) nil nil nil) |
| 104 | ("\\([\']\\)\\([^\']\\)*\\([\']\\)" nil (:keyword :string) nil nil nil) |
| 105 | ) |
| 106 | )) |
| 107 | ; ("3K\»" 嶬¶ÌæÊðμÈ¢H color LøÍÍ Ç±©ç DZÜÅ) |
| 108 | |
| 109 | |
| 110 | ;;-------------------------------------------------------------------------- |
| 111 | ;; |
| 112 | ;; CfgÉÖ·éè` |
| 113 | ;; |
| 114 | ;;-------------------------------------------------------------------------- |
| 115 | |
| 116 | (defvar *tf-tab-always-indent* t) |
| 117 | |
| 118 | (defvar *tf-block-beg-re* |
| 119 | "[\$]\\(IF\\|FOREACH\\|JOINEACH\\|FUNCTION\\)[ ]") |
| 120 | (defvar *tf-block-mid-re* |
| 121 | "\$ELSE[\$]") |
| 122 | (defvar *tf-block-end-re* "\$END[\$]") |
| 123 | |
| 124 | (defvar *tf-indent-column* 4) |
| 125 | |
| 126 | (defun tf-space-line () |
| 127 | "ós©Ç¤©" |
| 128 | (save-excursion |
| 129 | (goto-bol) |
| 130 | (looking-at "\\([ \t]*$\\|^\$[ \t]\\)"))) |
| 131 | |
| 132 | (defun tf-previous-line () |
| 133 | "ós¶áÈ¢sÜÅßé" |
| 134 | (while (forward-line -1) |
| 135 | ;(message-box (format nil "=> ~D" (current-line-number))) |
| 136 | (unless (tf-space-line) |
| 137 | (return-from tf-previous-line t)))) |
| 138 | |
| 139 | (defun calc-tf-indent () |
| 140 | "Cfg·éð¦é" |
| 141 | (let ((column 0) (curp (point))) |
| 142 | (save-excursion |
| 143 | ;OÌs×ばつé |
| 144 | (when (tf-previous-line) |
| 145 | (goto-bol) |
| 146 | (skip-chars-forward " \t") |
| 147 | ; Cfg |
| 148 | (setq column (current-column)) |
| 149 | ;(message-box (format nil "column1: ~D" column)) |
| 150 | (save-restriction |
| 151 | (narrow-to-region (progn (goto-eol) (point)) |
| 152 | (progn (goto-bol) (point))) |
| 153 | (skip-chars-forward " \t") |
| 154 | ; J«àÌa êÎCfgðâ· |
| 155 | (cond |
| 156 | ((looking-at *tf-block-beg-re*) |
| 157 | (setq column (+ column *tf-indent-column*))) |
| 158 | ((looking-at *tf-block-mid-re*) |
| 159 | (setq column (+ column *tf-indent-column*))) |
| 160 | ) |
| 161 | ))) |
| 162 | ;(message-box (format nil "column2: ~D" column)) |
| 163 | ; »ÝÌs×ばつé |
| 164 | (save-excursion |
| 165 | (save-restriction |
| 166 | (narrow-to-region (progn (goto-eol) (point)) |
| 167 | (progn (goto-bol) (point))) |
| 168 | (goto-bol) |
| 169 | (skip-chars-forward " \t") |
| 170 | ; ¶àÌa êÎCfgð ̧ç· |
| 171 | (cond |
| 172 | ((looking-at *tf-block-end-re*) |
| 173 | (setq column (- column *tf-indent-column*))) |
| 174 | ((looking-at *tf-block-mid-re*) |
| 175 | (setq column (- column *tf-indent-column*))) |
| 176 | ))) |
| 177 | column |
| 178 | )) |
| 179 | |
| 180 | (defun tf-not-comment-line () |
| 181 | (save-excursion |
| 182 | (progn |
| 183 | (beginning-of-line) |
| 184 | (if (looking-at "^\$[ \t]") |
| 185 | nil |
| 186 | t |
| 187 | ) |
| 188 | ) |
| 189 | )) |
| 190 | |
| 191 | (defun tf-indent-line () |
| 192 | (interactive "*") |
| 193 | (if (or (not (interactive-p)) |
| 194 | *tf-tab-always-indent* |
| 195 | (save-excursion |
| 196 | (skip-chars-backward " \t") |
| 197 | (bolp))) |
| 198 | (if (tf-not-comment-line) ;; RgsÅÈ ̄êÎÀs·é |
| 199 | ; ±±ðϦ1⁄23⁄4 ̄ |
| 200 | (let ((column (calc-tf-indent))) |
| 201 | (when (integerp column) |
| 202 | (save-excursion |
| 203 | (goto-bol) |
| 204 | (delete-region (point) |
| 205 | (progn |
| 206 | (skip-chars-forward " \t") |
| 207 | (point))) |
| 208 | (indent-to column))) |
| 209 | (if (and (bolp) column) |
| 210 | (skip-chars-forward " \t"))) |
| 211 | ) |
| 212 | (insert "\t")) |
| 213 | t) |
| 214 | |
| 215 | ;; ------------------------------------------------------------------------- |
| 216 | ;; |
| 217 | ;; tf-mode{Ì |
| 218 | ;; |
| 219 | ;; ------------------------------------------------------------------------- |
| 220 | |
| 221 | (defun tf-mode () |
| 222 | (interactive) |
| 223 | (kill-all-local-variables) |
| 224 | (setq buffer-mode 'tf-mode) |
| 225 | (setq mode-name "tf") |
| 226 | (use-keymap *tf-mode-map*) |
| 227 | (make-local-variable 'mode-specific-indent-command) |
| 228 | (setq mode-specific-indent-command #'tf-indent-line) |
| 229 | (use-syntax-table *tf-mode-syntax-table*) |
| 230 | (and *tf-keyword-file* |
| 231 | (null *tf-keyword-hash-table*) |
| 232 | (setq *tf-keyword-hash-table* |
| 233 | (load-keyword-file *tf-keyword-file*))) |
| 234 | (when *tf-keyword-hash-table* |
| 235 | (make-local-variable 'keyword-hash-table) |
| 236 | (setq keyword-hash-table *tf-keyword-hash-table*)) |
| 237 | (make-local-variable 'regexp-keyword-list) |
| 238 | (setq regexp-keyword-list *tf-regexp-keyword-list*) |
| 239 | (run-hooks '*tf-mode-hook*)) |
| 240 | |
| 241 | ;; ------------------------------------------------------------------------- |
| 242 | ;; |
| 243 | ;; $END$ÌÎðT· |
| 244 | ;; |
| 245 | ;; ------------------------------------------------------------------------- |
| 246 | |
| 247 | ;; ÎðT·1⁄2ßÌ3K\» |
| 248 | (defvar *tf-block-keyword* "[\$]\\(IF[ \t]\\|FOREACH[ \t]\\|JOINEACH[ \t]\\|FUNCTION[ \t]\\|END[\$]\\)") |
| 249 | (defvar *tf-block-tag* 'tf-block) |
| 250 | |
| 251 | |
| 252 | (defvar-local *stored-text-attributes* nil) |
| 253 | |
| 254 | (defun save-text-attributes (&optional start end) |
| 255 | (setq *stored-text-attributes* |
| 256 | (list-text-attributes start end))) |
| 257 | |
| 258 | (defun restore-text-attributes () |
| 259 | (mapc (lambda (attr) (apply #'set-text-attribute attr)) |
| 260 | *stored-text-attributes*) |
| 261 | (setq *stored-text-attributes* nil)) |
| 262 | |
| 263 | |
| 264 | (defun tf-block-pre-hook () |
| 265 | (delete-text-attributes *tf-block-tag*) |
| 266 | (restore-text-attributes) |
| 267 | ) |
| 268 | |
| 269 | |
| 270 | (defun tf-block-hook () |
| 271 | (progn |
| 272 | (if (string-match "tf" mode-name) ;; tf-modeÌÆ«3⁄4 ̄ |
| 273 | (let (now) |
| 274 | (save-excursion |
| 275 | (progn |
| 276 | (setq now (point)) |
| 277 | (if (string-match "\$END\$" (buffer-substring (- now 5) (- now 1))) ;; $END$ÌãëÉJ[\ |
| 278 | (progn |
| 279 | (goto-char now) |
| 280 | (save-text-attributes) |
| 281 | (do-tf-block) ;; {ÌÄÑoμ |
| 282 | ) |
| 283 | ) |
| 284 | ) |
| 285 | ) |
| 286 | ) |
| 287 | ) |
| 288 | ) |
| 289 | ) |
| 290 | |
| 291 | (defun do-tf-block () |
| 292 | (let (from to end_depth line_no line_string tmp_string now) |
| 293 | (save-excursion |
| 294 | (setq from (point)) |
| 295 | (backward-char 1) |
| 296 | (if (scan-buffer *tf-block-keyword* :reverse t :regexp t) |
| 297 | (progn |
| 298 | (setq end_depth 1) ;; $END$Ì[3 |
| 299 | (while (> end_depth 0) ;; $END$ÌÎa©Â©éÜÅ |
| 300 | (progn |
| 301 | (if (scan-buffer *tf-block-keyword* :reverse t :regexp t :no-dup t) |
| 302 | (progn |
| 303 | (setq tmp_string (match-string 0)) |
| 304 | (setq now (point)) |
| 305 | (beginning-of-line) |
| 306 | (if (not (string-match "^$[ \t]" (buffer-substring (point) (+ (point) 2)))) ;; RgAEg©`FbN |
| 307 | (progn |
| 308 | (goto-char now) |
| 309 | (if (string-match "[\$]END[\$]" tmp_string) ;; $END$a©Â©Á1⁄2 |
| 310 | (setq end_depth (+ end_depth 1)) ;; [3+1 |
| 311 | (progn ;; $END$ÈOa©Â©Á1⁄2 |
| 312 | (setq end_depth (- end_depth 1)) ;; [3-1 |
| 313 | )) |
| 314 | ) |
| 315 | ) |
| 316 | ) |
| 317 | (setq end_depth -1) ;; $END$ÌÎaÈ¢ |
| 318 | ))) |
| 319 | (if (= end_depth 0) ;; $END$ÌÎa Á1⁄2 |
| 320 | (progn |
| 321 | (setq to (point)) |
| 322 | (setq line_no (current-line-number)) |
| 323 | (end-of-line) |
| 324 | (setq line_string (buffer-substring to (point))) |
| 325 | (message "~d : ~s" line_no line_string) ;; sÔ,sàeð\¦ |
| 326 | (set-text-attribute from to *tf-block-tag* :bold t) ;; ÍÜê1⁄2ÍÍð2 |
| 327 | ) |
| 328 | (message "È¢©à3⁄4æ") ;; $END$ÌÎaÈ©Á1⁄2 |
| 329 | ) |
| 330 | ) |
| 331 | ) |
| 332 | ) |
| 333 | ) |
| 334 | ) |
| 335 | |
| 336 | |
| 337 | (add-hook '*pre-command-hook* 'tf-block-pre-hook) ;; post-command-hookÉÇÁ |
| 338 | (add-hook '*post-command-hook* 'tf-block-hook) ;; post-command-hookÉÇÁ |
Note:
See TracBrowser
for help on using the repository browser.