1 ;;; pir-mode.el --- pir-mode.el --- editing IMCC source files under Emacs
5 ;; This package provides Emacs support for PIR.
6 ;; It defines PIR mode, a major mode for editing PIR code.
8 ;; To begin using this mode for all `.pir' files that you edit,
9 ;; put this file in your `load-path' and add the following lines
10 ;; to your `.emacs' file:
12 ;; (autoload 'pir-mode "pir-mode" nil t)
13 ;; (add-to-list 'auto-mode-alist '("\\.pir\\'" . pir-mode))
15 ;; If you have any problems with this, you're on your own,
16 ;; You could always try asking on parrot-dev@lists.parrot.org.
22 (unless (fboundp 'line-beginning-position
)
23 (defalias 'line-beginning-position
'point-at-bol
))
24 (unless (fboundp 'line-end-position
)
25 (defalias 'line-end-position
'point-at-eol
))
28 "Mode for editing PIR code."
31 (defcustom pir-mode-hook nil
32 "*Hook run when entering PIR mode."
36 (defcustom pir-comment-char ?
#
37 "*The `comment-start' character assumed by PIR mode."
41 (defcustom pir-comment-column comment-column
42 "*The default comment column for PIR code."
46 (defcustom pir-block-comment-start
47 (concat (make-string 2 pir-comment-char
) " ")
48 "String to insert to start a new PIR comment on an empty line."
52 (defcustom pir-auto-indent-flag nil
53 "*Non-nil means indent line after a semicolon or space in PIR mode."
57 (defcustom pir-auto-newline nil
58 "*Non-nil means automatically newline after a semicolon in PIR mode."
62 (defcustom pir-blink-matching-block t
63 "*Control the blinkin of matching PIR block keywords.
64 Non-nil means show matching begin of block when inserting a space,
65 newline or semicolon after an end keyword."
69 (defcustom pir-basic-indent
4
70 "*Extra indentation applied to statements in PIR block structures."
76 (let ((map (make-sparse-keymap)))
77 (define-key map
"\C-c;" 'pir-comment-region
)
78 (define-key map
"\C-c:" 'pir-uncomment-region
)
79 (define-key map
(kbd "C-j") 'newline-and-indent
)
80 (define-key map
" " 'pir-electric-space
)
81 (define-key map
(kbd ":") 'pir-electric-colon
)
82 (define-key map
(kbd "RET") 'pir-reindent-then-newline-and-indent
)
83 (define-key map
(kbd "TAB") 'indent-according-to-mode
)
84 (define-key map
"\e\t" 'pir-complete-symbol
)
85 (define-key map
"\M-\C-a" 'pir-beginning-of-defun
)
86 (define-key map
"\M-\C-e" 'pir-end-of-defun
)
87 (define-key map
"\M-\C-h" 'pir-end-of-defun
)
88 (define-key map
"\M-\C-q" 'pir-indent-defun
)
89 (define-key map
"\C-c\C-p" 'pir-previous-code-line
)
90 (define-key map
"\C-c\C-n" 'pir-next-code-line
)
91 (define-key map
"\C-c\C-a" 'pir-beginning-of-line
)
92 (define-key map
"\C-c\C-e" 'pir-end-of-line
)
93 (define-key map
"\C-c\M-\C-n" 'pir-forward-block
)
94 (define-key map
"\C-c\M-\C-p" 'pir-backward-block
)
95 (define-key map
"\C-c\M-\C-u" 'pir-backward-up-block
)
96 (define-key map
"\C-c\M-\C-d" 'pir-down-block
)
97 (define-key map
"\C-c\M-\C-h" 'pir-mark-block
)
98 (define-key map
"\C-c]" 'pir-close-block
)
99 (define-key map
"\C-c\C-f" 'pir-insert-defun
)
101 "Keymap for PIR major mode.")
103 (defvar pir-mode-menu
106 ["Previous Code Line" pir-previous-code-line t
]
107 ["Next Code Line" pir-next-code-line t
]
108 ["Begin of Continuation" pir-beginning-of-line t
]
109 ["End of Continuation" pir-end-of-line t
]
110 ["Split Line at Point" pir-indent-new-comment-line t
])
112 ["Next Block" pir-forward-block t
]
113 ["Previous Block" pir-backward-block t
]
114 ["Down Block" pir-down-block t
]
115 ["Up Block" pir-backward-up-block t
]
116 ["Mark Block" pir-mark-block t
]
117 ["Close Block" pir-close-block t
])
119 ["Begin of Function" pir-beginning-of-defun
t]
120 ["End of Function" pir-end-of-defun
t]
121 ["Mark Function" pir-mark-defun
t]
122 ["Indent Function" pir-indent-defun
t]
123 ["Insert Function" pir-insert-defun
t])
125 ["Indent Line" indent-according-to-mode t
]
126 ["Complete Symbol" pir-complete-symbol t
]
128 ["Toggle Abbrev Mode" abbrev-mode t
]
130 ["Describe PIR Mode" pir-describe-major-mode t
])
131 "Menu for PIR mode.")
134 (defvar pir-mode-syntax-table
135 (let ((st (make-syntax-table)))
136 (modify-syntax-entry ?_
"w" st
)
137 (modify-syntax-entry ?
\\ "\\" st
)
138 (modify-syntax-entry ?
# "<" st
)
139 (modify-syntax-entry ?
\n ">" st
)
140 (modify-syntax-entry ?$
"'" st
)
141 (modify-syntax-entry ?
, "." st
)
142 (modify-syntax-entry ?.
". p" st
)
144 "Syntax table for PIR major mode.")
146 (defvar pir-PMC-keyword-symbols
147 '("AddrRegistry" "Array" "BigInt" "Boolean" "Bound_NCI" "Capture"
148 "Class" "Closure" "Compiler" "Complex" "Continuation" "Coroutine"
149 "Env" "Eval" "Exception" "ExceptionHandler"
150 "Exporter" "File" "FixedBooleanArray" "FixedFloatArray"
151 "FixedIntegerArray" "FixedPMCArray" "FixedStringArray" "Float"
152 "Hash" "Integer" "Iterator" "Key" "LexInfo" "LexPad"
153 "ManagedStruct" "MultiSub" "NCI" "NameSpace" "Null"
154 "OS" "Object" "OrderedHash" "PMCProxy" "ParrotClass"
155 "ParrotIO" "ParrotInterpreter" "ParrotLibrary" "ParrotObject"
156 "ParrotThread" "Pointer"
157 "ResizableBooleanArray" "ResizableFloatArray" "ResizableIntegerArray"
158 "ResizablePMCArray" "ResizableStringArray"
159 "Role" "Scalar" "String" "Sub" "Super"
160 "Timer" "UnManagedStruct" "Undef" "VtableCache"))
163 '("abs" "accept" "acos" "add" "addattribute" "addmethod" "addparent"
164 "addrole" "and" "asec" "asin" "assign" "atan"
165 "band" "bands" "bind" "bnot" "bnots" "bor" "bounds" "branch" "bsr"
166 "bxor" "bxors" "bytelength"
167 "callmethod" "callmethodcc" "can" "ceil" "charset" "charsetname" "chopn"
168 "chr" "class" "classname" "clear_eh" "cleari" "clearn"
169 "clearp" "clears" "clone" "close" "cmod" "cmp" "collect" "collectoff"
170 "collecton" "compile" "compose" "compreg" "concat" "connect" "cos" "cosh"
171 "debug" "dec" "decodelocaltime" "decodetime" "defined" "delete"
172 "delprop" "depth" "deref" "die" "div" "dlfunc" "dlvar" "does" "downcase"
173 "elements" "encoding" "encodingname" "enternative" "entrytype" "eq"
174 "err" "errorsoff" "errorson" "escape" "exchange" "exists" "exit" "exp"
175 "fact" "fdiv" "fdopen" "find_cclass" "find_charset" "find_encoding"
176 "find_lex" "find_method" "find_not_cclass" "find_type" "floor" "freeze"
177 "gc_debug" "gcd" "ge" "get_addr" "get_class" "get_global" "get_hll_global"
178 "get_hll_namespace" "get_mro" "get_namespace" "get_params" "get_repr"
179 "get_results" "get_root_global" "get_root_namespace" "getattribute"
180 "get_class" "getinterp" "getprop" "getstderr" "getstdin"
181 "getstdout" "gmtime" "goto" "gt"
183 "if" "if_null" "inc" "index" "infix" "inspect" "interpinfo" "invoke"
184 "invokecc" "is_cclass" "isa" "iseq" "isfalse" "isge" "isgt" "isle"
185 "islt" "isne" "isntsame" "isnull" "issame" "istrue"
187 "lcm" "le" "length" "listen" "ln" "load_bytecode" "loadlib" "localtime"
188 "log10" "log2" "lookback" "lsr" "lt"
189 "find_multi" "add_multi" "mod" "mul"
190 "n_infix" "ne" "needs_destroy" "neg" "new" "new_callback" "newclass"
191 "newclosure" "nors" "not" "null"
193 "peek" "pin" "poll" "pop" "popmark" "pow" "print" "printerr"
194 "profile" "prophash" "push" "push_eh" "pushaction" "pushmark"
195 "read" "readline" "recv" "register" "removeattribute" "removeparent"
196 "repeat" "restore" "result_info" "ret" "rethrow" "returncc"
197 "rot" "rotate_up" "runtinterp"
198 "save" "savec" "sec" "sech" "seek" "send" "set" "set_addr"
199 "set_args" "set_global" "set_hll_global" "set_returns" "set_root_global"
200 "setattribute" "seti_ind" "setn_ind" "setp_ind" "setprop" "setref"
201 "sets_ind" "setstderr" "shift" "shl" "shr" "sin" "sinh" "sizeof" "sleep"
202 "sockaddr" "socket" "spawnw" "split" "sprintf" "sqrt" "stat" "store_lex"
203 "stringinfo" "sub" "subclass" "substr" "sweep" "sweepoff" "sweepon" "sysinfo"
204 "tailcall" "tailcallmethod" "tan" "tanh" "tell" "thaw" "throw" "time"
205 "titlecase" "trace" "trans_charset" "trans_encoding" "typeof"
206 "unless" "unless_null" "unpin" "unregister" "unshift" "upcase"
207 "warningsoff" "warningson"
211 (defvar pir-mode-abbrev-table nil
212 "Abbrev table used when in PIR mode.")
214 (defvar pir-completion-alist nil
215 "Completion table used for PIR mode.")
217 (defvar pir-type-keywords
218 '("int" "num" "pmc" "string"))
220 (defvar pir-register-regexp
"[INPS]\\([12][0-9]\\|3[01]\\|[0-9]\\)")
221 (defvar pir-dollar-register-regexp
"\\$[INPS][0-9]+")
223 (defvar pir-directives
224 '(":anon" ":flat" ":init" ":lex" ":subid" ":load" ":main" ":method" ":multi"
225 ":named" ":opt_count" ":opt_flag" ":optional" ":outer" ":postcomp"
226 ":slurpy" ":unique_reg" ":vtable" ":wrap"))
228 (defvar pir-dotted-directives
229 '(".HLL" ".arg" ".const" ".constant" ".emit" ".end" ".endm"
230 ".endnamespace" ".eom" ".get_results" ".global" ".globalconst"
231 ".include" ".invocant" ".lex" ".line" ".loadlib" ".macro" ".meth_call"
232 ".namespace" ".nci_call" ".pcc_begin" ".pcc_begin_return"
233 ".pcc_begin_yield" ".pcc_call" ".pcc_end" ".pcc_end_return"
234 ".pcc_end_yield" ".pcc_sub" ".result" ".return" ".sub"
237 (defvar pir-variable-declarations
238 '(".local" ".sym" ".param"))
240 (defvar pir-begin-keywords
241 '(".sub" ".emit" ".macro" ".begin_yield" ".begin_return"
242 ".begin_call" ".namespace"))
244 (defvar pir-end-keywords
245 '(".end" ".eom" ".endm" ".end_yield" ".end_return"
246 ".end_call" ".endnamespace"))
248 (defvar pir-block-match-alist
252 (".begin_yield" ".end_yield" 0)
253 (".begin_return" ".end_return" 0)
254 (".begin_call" ".end_call" 0)
255 (".namespace" ".endnamespace" 0))
256 "Alist of IMCC's matching block keywords.
257 Has IMCC's begin keywords as keys and a list of the matching end keywords as
260 (defvar pir-block-offset-alist
261 (mapcan (lambda (blockspec)
262 (let ((offset (caddr blockspec
)))
263 `((,(car blockspec
) .
,offset
)
264 (,(cadr blockspec
) .
,offset
))))
265 pir-block-match-alist
))
267 (defvar pir-open-directives
268 (mapcar #'car pir-block-match-alist
))
270 (defvar pir-close-directives
271 (mapcar #'cadr pir-block-match-alist
))
273 (defvar pir-block-begin-regexp
274 (regexp-opt pir-begin-keywords
'paren
))
276 (defvar pir-block-end-regexp
277 (regexp-opt pir-end-keywords
'paren
))
279 (defvar pir-block-begin-or-end-regexp
280 (concat "\\(?:" pir-block-begin-regexp
"\\|"
281 pir-block-end-regexp
"\\)"))
283 (defvar pir-function-header-regexp
"\\.\\(.sub\\)\\s-+\\(\\sw+\\)"
284 "Regexp to match a PIR function header.")
286 (defvar pir-font-lock-keywords
287 `((,(concat "^\\s *\\(.sub\\)\\s +\\(\\sw+\\)"
288 "\\(\\s +" (regexp-opt pir-directives
'paren
) "\\)?")
289 (1 font-lock-keyword-face
)
290 (2 font-lock-function-name-face t t
)
291 (4 font-lock-keyword-face t t
))
292 (,(concat "\\s-*" (regexp-opt pir-variable-declarations
'paren
)
293 "\\(?:\\s +" (regexp-opt pir-type-keywords
'paren
)
294 "\\(?:\\s +\\(\\sw+\\)\\)?\\)?")
295 (1 font-lock-keyword-face
)
296 (2 font-lock-type-face nil t
)
297 (3 font-lock-variable-name-face nil t
))
298 (,(concat "^\\s *\\(.const\\)\\s +"
299 (regexp-opt pir-type-keywords
'paren
)
300 "\\(\\s +\\(\\sw+\\)\\)?")
301 (1 font-lock-keyword-face
)
302 (2 font-lock-type-face nil t
)
303 (4 font-lock-constant-face nil t
))
304 (,pir-block-begin-or-end-regexp . font-lock-keyword-face
)
306 (,pir-dollar-register-regexp . font-lock-variable-name-face
)
307 (,pir-register-regexp . font-lock-variable-name-face
)
308 (,(regexp-opt pir-dotted-directives
'paren
) . font-lock-keyword-face
)
309 (,(regexp-opt pir-ops
'words
) . font-lock-keyword-face
)
310 ("\\s-*\\(\\sw+\\)\\s-*"
311 (1 font-lock-variable-name-face
)))
312 "Expressions to highlight in PIR mode.")
314 (defvar pir-imenu-generic-expression
316 (list nil pir-function-header-regexp
2))
317 "Imenu expression for PIR mode. See `imenu-generic-expression'.")
319 (defun pir-comment ()
320 "Convert an empty comment to a `larger' kind, or start a new one.
321 These are the known comment classes:
323 1 -- comment to the right of the code (at the `comment-column')
324 2 -- comment on its own line, indented like code
325 3 -- comment on its own line, beginning at the left-most column.
327 Suggested usage: while writing your code, trigger asm-comment
328 repeatedly until you are satisfied with the kind of comment."
330 (comment-normalize-vars)
331 (let (comempty comment
)
334 (setq comment
(comment-search-forward (line-end-position) t
))
335 (setq comempty
(looking-at "[ \t]*$")))
339 ;; Blank line, start comment at code indent level.
340 ((save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))
341 (indent-according-to-mode)
342 (insert pir-comment-char pir-comment-char ?\
))
344 ;; Nonblank line w/o comment => start a comment at comment-column
345 ;; Also: point before the comment => jump inside.
346 ((or (null comment
) (< (point) comment
))
347 (indent-for-comment))
349 ;; Empty code-level comment => upgrade to next comment level.
350 ((save-excursion (goto-char comment
) (skip-chars-backward " \t") (bolp))
352 (insert pir-comment-char
)
353 (indent-for-comment))
355 ;; Empty comment ends non-empty code line => new comment above.
358 (skip-chars-backward " \t")
359 (delete-region (point) (line-end-position))
360 (beginning-of-line) (insert "\n") (backward-char)
363 (defun pir-electric-colon ()
364 "Automatically indent labels as soon as the colon is added."
368 (skip-syntax-backward "w_")
369 (skip-syntax-backward " ")
370 (if (setq labelp
(bolp)) (delete-horizontal-space)))
371 (call-interactively 'self-insert-command
)
373 (delete-horizontal-space)
376 (defmacro setlocalq
(sym val
)
377 "Localize SYM and set it to the value of VAL."
378 `(set (make-local-variable (quote ,sym
)) ,val
))
381 "Major mode for editing PIR files.
383 This mode makes it easier to write PIR code by helping with
384 indentation, doing some of the typing for you (with Abbrev mode) and by
385 showing keywords, comments, strings etc. in different faces (with Font
386 Lock mode on terminals that support it).
388 PIR (Parrot Intermediate Representation) is a friendlier way of
389 programming parrot than raw PASM (Parrot Assembly). In general,
390 compilers (and certainly humans) should code in PIR and let Parrot
391 handle register allocation and all that good stuff.
393 To find out more, hie thee to `http://www.parrot.org/'.
395 Type \\[list-abbrevs] to display the built in abbrevs for PIR
396 keywords. (When I've set them up.)
402 Variables you can use to customize PIR mode
403 ===========================================
406 Non-nil means indent current line after a space.
409 pir-blink-matching-block
410 Non-nil means show matching begin of block when inserting a space or
411 newline after the end of a block. Default is t.
414 PIR mode's basic level of indentation. Default is 8.
416 Turning on PIR mode runs the hook `pir-mode-hook'.
418 To begin using this mode for all `.pir' files that you edit, add the
419 following lines to your `.emacs' file:
421 (autoload 'pir-mode \"pir-mode\" nil t)
422 (add-to-list 'auto-mode-alist '(\"\\\\.pir\\\\'\" . pir-mode))
424 If you have any problems with this, you're on your own. You could always
425 try asking on parrot-dev@lists.parrot.org."
427 (kill-all-local-variables)
428 (use-local-map pir-mode-map
)
429 (setq major-mode
'pir-mode
)
430 (setq mode-name
"PIR")
432 (set-syntax-table pir-mode-syntax-table
)
434 (setlocalq font-lock-defaults
'(pir-font-lock-keywords))
435 (setlocalq indent-line-function
'pir-indent-line
)
436 (setlocalq pir-basic-indent pir-basic-indent
)
437 (setlocalq require-final-newline t
)
439 (setlocalq comment-start
"# ")
440 (setlocalq comment-end
"")
441 (setlocalq comment-column pir-comment-column
)
442 (setlocalq comment-start-skip
"#+ *")
443 (setlocalq comment-indent-function
'pir-comment-indent
)
445 (setlocalq parse-sexp-ignore-comments t
)
446 (setlocalq paragraph-start
(concat "\\s-*$\\|" page-delimiter
))
447 (setlocalq paragraph-separate paragraph-start
)
448 (setlocalq paragraph-ignore-fill-prefix t
)
449 (setlocalq fill-paragraph-function
'pir-fill-paragraph
)
450 (setlocalq adaptive-fill-regexp nil
)
451 (setlocalq fill-column
72)
453 (setlocalq imenu-generic-expression pir-imenu-generic-expression
)
454 (setq imenu-case-fold-search nil
)
456 (setlocalq defun-prompt-regexp
"^\\s_*\\.\\(sub\\|emit\\)\\s_+")
458 (pir-initialize-completions)
461 (run-hooks 'pir-mode-hook
))
463 (defun pir-describe-major-mode ()
464 "Describe the current major mode."
466 (describe-function major-mode
))
468 (defsubst pir-in-comment-p
()
469 "Return t if point is inside a PIR comment, nil otherwise."
472 (nth 4 (parse-partial-sexp (line-beginning-position) (point)))))
474 (defsubst pir-in-string-p
()
475 "Return t if point is inside a PIR string, nil otherwise."
478 (nth 3 (parse-partial-sexp (line-beginning-position) (point)))))
480 (defsubst pir-not-in-string-or-comment-p
()
481 "Return t iff point is not inside a PIR string or comment."
482 (let ((pps (parse-partial-sexp (line-beginning-position) (point))))
483 (not (or (nth 3 pps
) (nth 4 pps
)))))
485 (defun pir-in-block-p ()
486 "Return t if point is inside a PIR block, nil otherwise.
487 The block is taken to start at the first letter of the begin keyword and
488 to end after the end keyword."
493 (skip-syntax-forward "w")
500 (defun pir-in-defun-p ()
501 "Return t iff point is inside a PIR function declaration.
502 The function is taken to start at the `.' of `.sub' and to end after
506 (or (and (looking-at "\\<.sub\\>")
507 (pir-not-in-string-or-comment-p))
508 (and (pir-beginning-of-defun)
518 (defun pir-comment-region (beg end
&optional arg
)
519 "Comment or uncomment each line in the region as PIR code.
520 See `comment-region'."
522 (let ((comment-start (char-to-string pir-comment-char
)))
523 (comment-region beg end arg
)))
525 (defun pir-uncomment-region (beg end
&optional arg
)
526 "Uncomment each line in the region as PIR code."
528 (or arg
(setq arg
1))
529 (pir-comment-region beg end
(- arg
)))
533 (defun calculate-pir-indent (&optional ignore-labelp
)
534 "Calculate the correct indentation for a line of PIR code.
535 Optional argument IGNORE-LABELP if set, labels are ignored for the purposes of calculating the indent."
539 (cond ((condition-case nil
543 (setq icol
(1+ (current-column))))
544 ((and (not ignore-labelp
)
545 (looking-at "\\s-*\\sw+:"))
547 ((zerop (pir-previous-code-line))
548 (let ((labelp (looking-at "\\s-*\\sw+:")))
549 (pir-beginning-of-line)
550 (back-to-indentation)
551 (setq icol
(current-column))
553 (eol (line-end-position)))
554 (while (< (point) eol
)
555 (if (pir-not-in-string-or-comment-p)
557 ((looking-at pir-block-begin-regexp
)
559 (pir-block-offset (match-string 1)))))
560 ((looking-at pir-block-end-regexp
)
561 (if (not (= bot
(point)))
564 (match-string 1))))))))
568 (setq icol
(calculate-pir-indent 'ignore-label
)))
571 (back-to-indentation)
573 ((and (looking-at pir-block-end-regexp
)
574 (pir-not-in-string-or-comment-p))
575 (looking-at pir-block-end-regexp
)
576 (setq icol
(- icol
(pir-block-offset (match-string 1)))))
577 ((or (looking-at "\\s<\\s<\\s<\\S<")
578 (pir-before-magic-comment-p))
579 (setq icol
(list 0 icol
)))
580 ((looking-at "\\s<\\S<")
581 (setq icol
(list comment-column icol
)))))
584 (defun pir-block-offset (string)
586 (cdr (assoc string pir-block-offset-alist
))))
588 (defun pir-before-magic-comment-p ()
589 "Return t if point is before the shebang."
592 (and (bobp) (looking-at "\\s-*#!"))))
594 (defun pir-comment-indent ()
595 "Calculate the correct comment indent."
596 (if (or (looking-at "\\s<\\s<\\s<")
597 (pir-before-magic-comment-p))
599 (if (looking-at "\\<\\<")
600 (calculate-pir-indent)
601 (skip-syntax-backward " ")
602 (max (if (bolp) 0 (1+ (current-column)))
605 (defun pir-indent-for-comment ()
606 "Maybe insert and indent a PIR comment.
607 If there is no comment already on this line, create a code-level comment
608 \(started by two comment characters) if the line is empty, or an in-line
609 comment (started by one comment character) otherwise.
610 Point is left after the start of the comment which is properly aligned."
613 (indent-according-to-mode))
615 (defun pir-indent-line (&optional arg
)
616 "Indent current line as PIR code.
617 With optional ARG, use this as offset unless this line is a comment with
620 (or arg
(setq arg
0))
621 (let ((icol (calculate-pir-indent))
622 (relpos (- (current-column) (current-indentation))))
624 (setq icol
(car icol
))
625 (setq icol
(+ icol arg
)))
627 (error "Unmatched end keyword")
628 (indent-line-to icol
)
630 (move-to-column (+ icol relpos
))))))
632 (defun pir-indent-new-comment-line ()
633 "Break PIR line at point, continuing comment if within one.
634 If within code, insert `pir-continuation-string' before breaking the
635 line. If within a string, signal an error.
636 The new line is properly indented."
638 (delete-horizontal-space)
641 (indent-new-comment-line))
643 (error "Don't know how to split this code line"))))
645 (defun pir-indent-defun ()
646 "Properly indent the PIR function which contains point."
650 (message "Indenting function...")
651 (indent-region (point) (mark) nil
))
652 (message "Indenting function...done."))
656 (defun pir-next-code-line (&optional arg
)
657 "Move ARG lines of PIR code forward (backward if ARG is negative).
658 Skips past all empty and comment lines. Default for ARG is 1.
660 On success, return 0. Otherwise, go as far as possible and return -1."
662 (or arg
(setq arg
1))
665 (inc (if (> arg
0) 1 -
1)))
666 (while (and (/= arg
0) (= n
0))
667 (setq n
(forward-line inc
))
669 (looking-at "\\s-*\\($\\|\\s<\\)"))
670 (setq n
(forward-line inc
)))
671 (setq arg
(- arg inc
)))
674 (defun pir-previous-code-line (&optional arg
)
675 "Move ARG lines of PIR code backward (forward if ARG is negative).
676 Skips past all empty and comment lines. Default for ARG is 1.
678 On success, return 0. Otherwise, go as far as possible and return -1."
680 (or arg
(setq arg
1))
681 (pir-next-code-line (- arg
)))
683 (defun pir-beginning-of-line ()
684 "Move point to beginning of current PIR line.
685 If on an empty or comment line, go to the beginning of that line."
688 (if (not (looking-at "\\s-*\\($\\|\\s<\\)"))
689 (while (or (condition-case nil
695 (and (looking-at "\\s-*\\($\\|\\s<\\)")
696 (zerop (forward-line -
1)))))))
698 (defun pir-end-of-line ()
699 "Move point to end of current PIR line.
700 If on an empty or comment line, go to the end of that line.
701 Otherwise, move forward to the end of the first PIR code line which
702 does not end in `...' or `\\' or is inside an open parenthesis list."
707 (looking-at "\\s-*\\($\\|\\s<\\)"))
709 (while (or (condition-case nil
717 (looking-at "\\s-*\\($\\|\\s<\\)"))
718 (zerop (forward-line 1)))))
721 (defun pir-scan-blocks (from count depth
)
722 "Scan from character number FROM by COUNT PIR begin-end blocks.
723 Returns the character number of the position thus found.
725 If DEPTH is nonzero, block depth begins counting from that value.
726 Only places where the depth in blocks becomes zero are candidates for
727 stopping; COUNT such places are counted.
729 If the beginning or end of the buffer is reached and the depth is wrong,
730 an error is signaled."
731 (let ((min-depth (if (> depth
0) 0 depth
))
732 (inc (if (> count
0) 1 -
1)))
736 (while (or (re-search-forward
737 pir-block-begin-or-end-regexp nil
'move inc
)
739 (error "Unbalanced block")))
740 (if (pir-not-in-string-or-comment-p)
744 (setq depth
(+ depth inc
)))
746 (setq depth
(- depth inc
))))
747 (if (< depth min-depth
)
748 (error "Containing expression ends prematurely"))
750 (throw 'foo nil
))))))
751 (setq count
(- count inc
)))
754 (defun pir-forward-block (&optional arg
)
755 "Move forward across one balanced PIR begin-end block.
756 With argument, do it that many times.
757 Negative arg -ARG means move backward across ARG blocks."
759 (or arg
(setq arg
1))
760 (goto-char (or (pir-scan-blocks (point) arg
0) (buffer-end arg
))))
762 (defun pir-backward-block (&optional arg
)
763 "Move backward across one balanced PIR begin-end block.
764 With argument, do it that many times.
765 Negative arg -ARG means move forward across ARG blocks."
767 (or arg
(setq arg
1))
768 (pir-forward-block (- arg
)))
770 (defun pir-down-block (arg)
771 "Move forward down one begin-end block level of PIR code.
772 With ARG, do this that many times.
773 A negative ARG means move backward but still go down a level.
774 In Lisp programs, an argument is required."
776 (let ((inc (if (> arg
0) 1 -
1)))
778 (goto-char (or (pir-scan-blocks (point) inc -
1)
780 (setq arg
(- arg inc
)))))
782 (defun pir-backward-up-block (arg)
783 "Move backward out of one begin-end block level of PIR code.
784 With ARG, do this that many times.
785 A negative ARG means move forward but still to a less deep spot.
786 In Lisp programs, an argument is required."
788 (pir-up-block (- arg
)))
790 (defun pir-up-block (arg)
791 "Move forward out of one begin-end block level of PIR code.
792 With ARG, do this that many times.
793 A negative ARG means move backward but still to a less deep spot.
794 In Lisp programs, an argument is required."
796 (let ((inc (if (> arg
0) 1 -
1)))
798 (goto-char (or (pir-scan-blocks (point) inc
1)
800 (setq arg
(- arg inc
)))))
802 (defun pir-mark-block ()
803 "Put point at the beginning of this PIR block, mark at the end.
804 The block marked is the one that contains point or follows point."
807 (if (or (and (pir-in-block-p)
808 (skip-syntax-forward "w"))
818 (exchange-point-and-mark))
820 (message "No block to mark found"))))
822 (defun pir-close-block ()
823 "Close the current PIR block on a separate line.
824 An error is signaled if no block to close is found."
830 (pir-backward-up-block 1)
831 (setq bb-keyword
(buffer-substring-no-properties
832 (match-beginning 1) (match-end 1))))
835 (looking-at "^\\s-*$"))
836 (indent-according-to-mode)
837 (pir-reindent-then-newline-and-indent))
838 (insert (cadr (assoc bb-keyword
839 pir-block-match-alist
)))
840 (pir-reindent-then-newline-and-indent)
842 (error (message "No block to close found")))))
844 (defun pir-blink-matching-block-open ()
845 "Blink the matching PIR begin block keyword.
846 If point is right after a PIR else or end type block keyword, move
847 cursor momentarily to the corresponding begin keyword.
848 Signal an error if the keywords are incompatible."
850 (let (bb-keyword bb-arg eb-keyword pos eol
)
851 (if (and (pir-not-in-string-or-comment-p)
854 (skip-syntax-backward "w_.")
855 (looking-at pir-block-end-regexp
)))
858 (buffer-substring-no-properties
859 (match-beginning 1) (match-end 1)))
861 (setq pos
(match-end 1)
863 (buffer-substring-no-properties
864 (match-beginning 1) pos
)
866 eol
(line-end-position))
867 (if (member eb-keyword
868 (cdr (assoc bb-keyword pir-block-match-alist
)))
870 (message "Matches `.%s'" bb-keyword
)
871 (if (pos-visible-in-window-p)
872 (sit-for blink-matching-delay
)))
873 (error "Block keywords `%s' and `%s' do not match"
874 bb-keyword eb-keyword
))))))
876 (defun pir-beginning-of-defun (&optional arg
)
877 "Move backward to the beginning of a PIR function.
878 With positive ARG, do it that many times. Negative argument -N means
879 move forward to Nth following beginning of a function.
880 Returns t unless search stops at the beginning or end of the buffer."
882 (let* ((arg (or arg
1))
883 (inc (if (> arg
0) 1 -
1))
886 (not (and (> arg
0) (looking-at "\\<function\\>")))
887 (skip-syntax-forward "w"))
888 (while (and (/= arg
0)
890 (re-search-backward "\\<function\\>" nil
'move inc
)))
891 (if (pir-not-in-string-or-comment-p)
892 (setq arg
(- arg inc
))))
895 (and (< inc
0) (goto-char (match-beginning 0)))
898 (defun pir-end-of-defun (&optional arg
)
899 "Move forward to the end of a PIR function.
900 With positive ARG, do it that many times. Negative argument -N means
901 move back to Nth preceding end of a function.
903 An end of a function occurs right after the end keyword matching the
904 `function' keyword that starts the function."
906 (or arg
(setq arg
1))
907 (and (< arg
0) (skip-syntax-backward "w"))
908 (and (> arg
0) (skip-syntax-forward "w"))
910 (setq arg
(- arg
1)))
911 (if (= arg
0) (setq arg -
1))
912 (if (pir-beginning-of-defun (- arg
))
913 (pir-forward-block)))
915 (defun pir-mark-defun ()
916 "Put point at the beginning of this PIR function, mark at its end.
917 The function marked is the one containing point or following point."
920 (if (or (pir-in-defun-p)
921 (and (pir-beginning-of-defun -1)
924 (skip-syntax-forward "w")
925 (pir-beginning-of-defun)
928 (exchange-point-and-mark))
930 (message "No function to mark found"))))
935 (defun pir-fill-paragraph (&optional arg
)
936 "Fill paragraph of PIR code, handling PIR comments.
937 Optional argument ARG appears to be ignored. Um..."
940 (let ((end (progn (forward-paragraph) (point)))
942 (forward-paragraph -
1)
943 (skip-chars-forward " \t\n")
946 (cfc (current-fill-column))
947 (ind (calculate-pir-indent))
951 (narrow-to-region beg end
)
952 (if (listp ind
) (setq ind
(nth 1 ind
)))
955 (pir-indent-line ind
)
961 (looking-at "^\\s-*\\($\\|\\s<+\\)"))))
964 ;; First check whether we need to combine non-empty comment lines
965 (if (and (< (current-column) cfc
)
969 (looking-at "^\\s-*\\s<+\\s-*$"))))
970 ;; This is a nonempty comment line which does not extend
971 ;; past the fill column. If it is followed by a nonempty
972 ;; comment line with the same comment prefix, try to
973 ;; combine them, and repeat this until either we reach the
974 ;; fill-column or there is nothing more to combine.
976 ;; Get the comment prefix
979 (while (and (re-search-forward "\\s<+")
980 (not (pir-in-comment-p))))
981 (setq comment-prefix
(match-string 0)))
982 ;; And keep combining ...
983 (while (and (< (current-column) cfc
)
995 (re-search-forward comment-prefix
)
996 (delete-region (match-beginning 0) (match-end 0))
998 (move-to-column cfc
))))
999 ;; We might also try to combine continued code lines> Perhaps
1000 ;; some other time ...
1001 (skip-chars-forward "^ \t\n")
1002 (delete-horizontal-space)
1003 (if (or (< (current-column) cfc
)
1004 (and (= (current-column) cfc
) (eolp)))
1006 (if (not (eolp)) (insert " "))
1011 ;;; Electric characters && friends
1012 (defun pir-reindent-then-newline-and-indent ()
1013 "Reindent current PIR line, insert newline, and indent the new line.
1014 If Abbrev mode is on, expand abbrevs first."
1016 (if abbrev-mode
(expand-abbrev))
1017 (if pir-blink-matching-block
1018 (pir-blink-matching-block-open))
1020 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
1021 (indent-according-to-mode))
1023 (indent-according-to-mode))
1025 (defun pir-electric-semi ()
1026 "Insert a semicolon in PIR mode.
1027 Maybe expand abbrevs and blink matching block open keywords.
1028 Reindent the line of `pir-auto-indent-flag' is non-nil.
1029 Insert a newline if `pir-auto-newline' is non-nil."
1031 (if (not (pir-not-in-string-or-comment-p))
1033 (if abbrev-mode
(expand-abbrev))
1034 (if pir-blink-matching-block
1035 (pir-blink-matching-block-open))
1036 (if pir-auto-indent-flag
1037 (indent-according-to-mode))
1039 (if pir-auto-newline
1040 (newline-and-indent))))
1042 (defun pir-electric-space ()
1043 "Insert a space in PIR mode.
1044 Maybe expand abbrevs and blink matching block open keywords.
1045 Reindent the line of `pir-auto-indent-flag' is non-nil."
1047 (setq last-command-char ?
)
1048 (if (not (pir-not-in-string-or-comment-p))
1050 (indent-according-to-mode)
1051 (self-insert-command 1))
1052 (if abbrev-mode
(expand-abbrev))
1053 (if pir-blink-matching-block
1054 (pir-blink-matching-block-open))
1055 (if (and pir-auto-indent-flag
1057 (skip-syntax-backward " ")
1059 (indent-according-to-mode))
1060 (self-insert-command 1)))
1062 (defun pir-abbrev-start ()
1063 "Start entering a PIR abbreviation.
1064 If Abbrev mode is turned on, typing ` (grave accent) followed by ? or
1065 \\[help-command] lists all PIR abbrevs. Any other key combination is
1067 Note that all PIR mode abbrevs start with a grave accent."
1069 (if (not abbrev-mode
)
1070 (self-insert-command 1)
1072 (insert last-command-char
)
1073 (if ;(if pir-xemacs-p
1074 ; (or (eq (event-to-character (setq c (next-event))) ??)
1075 ; (eq (event-to-character c) help-char))
1076 (or (eq (setq c
(read-event)) ??
)
1078 (let ((abbrev-table-name-list '(pir-abbrev-table)))
1080 (setq unread-command-events
(list c
))))))
1082 (defun pir-insert-defun (name args vals
)
1083 "Insert a PIR function skeleton.
1084 Prompt for the function's NAME, ARGS and return VALS (to be
1085 entered without parens)."
1088 (read-from-minibuffer "Function name: "
1089 (substring (buffer-name) 0 -
2))
1090 (read-from-minibuffer "Arguments: ")
1091 (read-from-minibuffer "Return values: ")))
1092 (let ((string (format "%s %s (%s)"
1094 ((string-equal vals
"")
1096 ((string-match "[ ,]" vals
)
1097 (concat " [" vals
"] ="))
1099 (concat " " vals
" =")))
1102 (prefix pir-block-comment-start
))
1103 (if (not (bobp)) (newline))
1104 (insert "function" string
)
1105 (indent-according-to-mode)
1107 (insert prefix
"usage: " string
)
1108 (reindent-then-newline-and-indent)
1110 (reindent-then-newline-and-indent)
1112 (indent-according-to-mode)
1115 (insert "endfunction")
1116 (indent-according-to-mode))))
1120 (defun pir-initialize-completions ()
1121 "Initialize the completion table for PIR symbols."
1122 (if pir-completion-alist
1124 (setq pir-completion-alist
1125 (mapcar '(lambda (var) (cons var var
))
1126 (append pir-PMC-keyword-symbols
1127 pir-ops pir-dotted-directives
1128 pir-variable-declarations
)))))
1130 (defun pir-complete-symbol ()
1131 "Perform completion on PIR symbol preceding point.
1132 Compare that symbol against PIR's reserved words and builtin
1134 ;; This code taken from lisp-complete-symbol
1136 (let* ((end (point))
1137 (beg (save-excursion (backward-sexp 1) (point)))
1138 (string (buffer-substring-no-properties beg end
))
1139 (completion (try-completion string pir-completion-alist
)))
1140 (cond ((eq completion t
)) ; ???
1142 (message "Can't find completion for \"%s\"" string
)
1144 ((not (string= string completion
))
1145 (delete-region beg end
)
1146 (insert completion
))
1148 (let ((list (all-completions string pir-completion-alist
))
1149 (conf (current-window-configuration)))
1150 ;; Taken from comint.el
1151 (message "Making completion list...")
1152 (with-output-to-temp-buffer "*Completions*"
1153 (display-completion-list list
))
1154 (message "Hit space to flush")
1157 (set-buffer (get-buffer "*Completions*"))
1158 (setq key
(read-key-sequence nil
)
1160 (and (consp first
) (consp (event-start first
))
1161 (eq (window-buffer (posn-window (event-start
1163 (get-buffer "*Completions*"))
1164 (eq (key-binding key
) 'mouse-choose-completion
)))
1166 (mouse-choose-completion first
)
1167 (set-window-configuration conf
))
1169 (set-window-configuration conf
)
1170 (setq unread-command-events
1171 (listify-key-sequence key
))))))))))
1175 (defun pir-add-pir-menu ()
1176 "Add the `PIR' menu to the menu bar in PIR mode."
1178 (easy-menu-define pir-mode-menu-map pir-mode-map
1179 "Menu keymap for PIR mode." pir-mode-menu
)
1180 (easy-menu-add pir-mode-menu-map pir-mode-map
))
1185 ;;; pir-mode.el ends here