editor/pir-mode.el

   1 ;;; pir-mode.el --- pir-mode.el --- editing IMCC source files under Emacs
   2
   3 ;;; Commentary:
   4
   5 ;; This package provides Emacs support for PIR.
   6 ;; It defines PIR mode, a major mode for editing PIR code.
   7
   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:
  11
  12 ;;   (autoload 'pir-mode "pir-mode" nil t)
  13 ;;   (add-to-list 'auto-mode-alist '("\\.pir\\'" . pir-mode))
  14
  15 ;; If you have any problems with this, you're on your own,
  16 ;; You could always try asking on parrot-porters@perl.org.
  17
  18 ;;; Code:
  19 (require 'regexp-opt)
  20 (require 'cl)
  21
  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))
  26
  27 (defgroup pir nil
  28   "Mode for editing PIR code."
  29   :group 'languages)
  30
  31 (defcustom pir-mode-hook nil
  32   "*Hook run when entering PIR mode."
  33   :type 'hook
  34   :group 'pir)
  35
  36 (defcustom pir-comment-char ?#
  37   "*The `comment-start' character assumed by PIR mode."
  38   :type 'character
  39   :group 'pir)
  40
  41 (defcustom pir-comment-column comment-column
  42   "*The default comment column for PIR code."
  43   :type 'integer
  44   :group 'pir)
  45
  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."
  49   :type 'string
  50   :group 'pir)
  51
  52 (defcustom pir-auto-indent-flag nil
  53   "*Non-nil means indent line after a semicolon or space in PIR mode."
  54   :type 'boolean
  55   :group 'pir)
  56
  57 (defcustom pir-auto-newline nil
  58   "*Non-nil means automatically newline after a semicolon in PIR mode."
  59   :type 'boolean
  60   :group 'pir)
  61
  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."
  66   :type 'boolean
  67   :group 'pir)
  68
  69 (defcustom pir-basic-indent 8
  70   "*Extra indentation applied to statements in PIR block structures."
  71   :type 'integer
  72   :group 'pir)
  73
  74
  75 (defvar pir-mode-map
  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)
 100     map)
 101   "Keymap for PIR major mode.")
 102
 103 (defvar pir-mode-menu
 104   (list "PIR"
 105     (list "Lines"
 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])
 111     (list "Blocks"
 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])
 118     (list "Functions"
 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])
 124     "-"
 125     ["Indent Line"          indent-according-to-mode t]
 126     ["Complete Symbol"      pir-complete-symbol t]
 127     "-"
 128     ["Toggle Abbrev Mode"       abbrev-mode t]
 129     "-"
 130     ["Describe PIR Mode"        pir-describe-major-mode t])
 131   "Menu for PIR mode.")
 132
 133
 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)
 143     st)
 144   "Syntax table for PIR major mode.")
 145
 146 (defvar pir-PMC-keyword-symbols
 147   '("AddrRegistry" "Array" "BigInt" "Boolean" "Bound_NCI" "Capture"
 148     "Class" "Closure" "Compiler" "Complex" "Continuation" "Coroutine"
 149     "Enumerate" "Env" "Eval" "Exception" "Exception_Handler"
 150     "Exporter" "File" "FixedBooleanArray" "FixedFloatArray"
 151     "FixedIntegerArray" "FixedPMCArray" "FixedStringArray" "Float"
 152     "Hash" "IntList" "Integer" "Iterator" "Key" "LexInfo" "LexPad"
 153     "ManagedStruct" "MultiArray" "MultiSub" "NCI" "NameSpace" "Null"
 154     "OS" "Object" "OrderedHash" "PMCProxy" "Pair" "ParrotClass"
 155     "ParrotIO" "ParrotInterpreter" "ParrotLibrary" "ParrotObject"
 156     "ParrotRunningThread" "ParrotThread" "Pointer" "Random" "Ref"
 157     "ResizableBooleanArray" "ResizableFloatArray" "ResizableIntegerArray"
 158     "ResizablePMCArray" "ResizableStringArray" "RetContinuation"
 159     "Role" "SArray" "Scalar" "SharedRef" "Slice" "String" "Sub"
 160     "Super" "TQueue" "Timer" "UnManagedStruct" "Undef" "VtableCache"))
 161
 162 (defvar pir-ops
 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" "getfd" "getinterp" "getprop" "getstderr" "getstdin"
 181     "getstdout" "gmtime" "goto" "gt"
 182     "hash"
 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"
 186     "join" "jsr" "jump"
 187     "lcm" "le" "length" "listen" "ln" "load_bytecode" "loadlib" "localtime"
 188     "log10" "log2" "lookback" "lsr" "lt"
 189     "mmdvtfind" "mmdvtregister" "mod" "mul"
 190     "n_infix" "ne" "needs_destroy" "neg" "new" "new_callback" "newclass"
 191     "newclosure" "nors" "not" "null"
 192     "open" "or" "ord"
 193     "peek" "pin" "pioctl" "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     "valid_type"
 208     "warningsoff" "warningson"
 209     "xor"
 210     "yield"))
 211
 212 (defvar pir-mode-abbrev-table nil
 213   "Abbrev table used when in PIR mode.")
 214
 215 (defvar pir-completion-alist nil
 216   "Completion table used for PIR mode.")
 217
 218 (defvar pir-type-keywords
 219   '("int" "num" "pmc" "string"))
 220
 221 (defvar pir-register-regexp "[INPS]\\([12][0-9]\\|3[01]\\|[0-9]\\)")
 222 (defvar pir-dollar-register-regexp "\\$[INPS][0-9]+")
 223
 224 (defvar pir-directives
 225   '(":anon" ":flat" ":init" ":lex" ":lexid" ":load" ":main" ":method" ":multi"
 226     ":named" ":opt_count" ":opt_flag" ":optional" ":outer" ":postcomp"
 227     ":slurpy" ":unique_reg" ":vtable" ":wrap"))
 228
 229 (defvar pir-dotted-directives
 230   '(".HLL" ".HLL_map" ".arg" ".const" ".constant" ".emit" ".end" ".endm"
 231     ".endnamespace" ".eom" ".get_results" ".global" ".globalconst"
 232     ".include" ".invocant" ".lex" ".line" ".loadlib" ".macro" ".meth_call"
 233     ".namespace" ".nci_call" ".pcc_begin" ".pcc_begin_return"
 234     ".pcc_begin_yield" ".pcc_call" ".pcc_end" ".pcc_end_return"
 235     ".pcc_end_yield" ".pcc_sub" ".pragma" ".result" ".return" ".sub"
 236     ".yield"))
 237
 238 (defvar pir-variable-declarations
 239   '(".local" ".sym" ".param"))
 240
 241 (defvar pir-begin-keywords
 242   '(".sub" ".emit" ".macro" ".begin_yield" ".begin_return"
 243     ".begin_call" ".namespace"))
 244
 245 (defvar pir-end-keywords
 246   '(".end" ".eom" ".endm" ".end_yield" ".end_return"
 247     ".end_call" ".endnamespace"))
 248
 249 (defvar pir-block-match-alist
 250   '((".sub" ".end" 1)
 251     (".emit" ".eom" 1)
 252     (".macro" ".endm" 1)
 253     (".begin_yield" ".end_yield" 0)
 254     (".begin_return" ".end_return" 0)
 255     (".begin_call" ".end_call" 0)
 256     (".namespace" ".endnamespace" 0))
 257   "Alist of IMCC's matching block keywords.
 258 Has IMCC's begin keywords as keys and a list of the matching end keywords as
 259 associated values.")
 260
 261 (defvar pir-block-offset-alist
 262   (mapcan (lambda (blockspec)
 263         (let ((offset (caddr blockspec)))
 264           `((,(car blockspec) . ,offset)
 265         (,(cadr blockspec) . ,offset))))
 266       pir-block-match-alist))
 267
 268 (defvar pir-open-directives
 269   (mapcar #'car pir-block-match-alist))
 270
 271 (defvar pir-close-directives
 272   (mapcar #'cadr pir-block-match-alist))
 273
 274 (defvar pir-block-begin-regexp
 275   (regexp-opt pir-begin-keywords 'paren))
 276
 277 (defvar pir-block-end-regexp
 278   (regexp-opt pir-end-keywords 'paren))
 279
 280 (defvar pir-block-begin-or-end-regexp
 281   (concat "\\(?:" pir-block-begin-regexp "\\|"
 282       pir-block-end-regexp "\\)"))
 283
 284 (defvar pir-function-header-regexp "\\.\\(.sub\\)\\s-+\\(\\sw+\\)"
 285   "Regexp to match a PIR function header.")
 286
 287 (defvar pir-font-lock-keywords
 288   `((,(concat "^\\s *\\(.sub\\)\\s +\\(\\sw+\\)"
 289           "\\(\\s +" (regexp-opt pir-directives 'paren) "\\)?")
 290      (1 font-lock-keyword-face)
 291      (2 font-lock-function-name-face t t)
 292      (4 font-lock-keyword-face t t))
 293     (,(concat "\\s-*" (regexp-opt pir-variable-declarations 'paren)
 294           "\\(?:\\s +" (regexp-opt pir-type-keywords 'paren)
 295           "\\(?:\\s +\\(\\sw+\\)\\)?\\)?")
 296      (1 font-lock-keyword-face)
 297      (2 font-lock-type-face nil t)
 298      (3 font-lock-variable-name-face nil t))
 299     (,(concat "^\\s *\\(.const\\)\\s +"
 300           (regexp-opt pir-type-keywords 'paren)
 301           "\\(\\s +\\(\\sw+\\)\\)?")
 302      (1 font-lock-keyword-face)
 303      (2 font-lock-type-face nil t)
 304      (4 font-lock-constant-face nil t))
 305     (,pir-block-begin-or-end-regexp . font-lock-keyword-face)
 306
 307     (,pir-dollar-register-regexp . font-lock-variable-name-face)
 308     (,pir-register-regexp . font-lock-variable-name-face)
 309     (,(regexp-opt pir-dotted-directives 'paren) . font-lock-keyword-face)
 310     (,(regexp-opt pir-ops 'words) . font-lock-keyword-face)
 311     ("\\s-*\\(\\sw+\\)\\s-*"
 312      (1 font-lock-variable-name-face)))
 313   "Expressions to highlight in PIR mode.")
 314
 315 (defvar pir-imenu-generic-expression
 316   (list
 317    (list nil pir-function-header-regexp 2))
 318   "Imenu expression for PIR mode.  See `imenu-generic-expression'.")
 319
 320 (defun pir-comment ()
 321   "Convert an empty comment to a `larger' kind, or start a new one.
 322 These are the known comment classes:
 323
 324    1 -- comment to the right of the code (at the `comment-column')
 325    2 -- comment on its own line, indented like code
 326    3 -- comment on its own line, beginning at the left-most column.
 327
 328 Suggested usage: while writing your code, trigger asm-comment
 329 repeatedly until you are satisfied with the kind of comment."
 330   (interactive)
 331   (comment-normalize-vars)
 332   (let (comempty comment)
 333     (save-excursion
 334       (beginning-of-line)
 335       (setq comment (comment-search-forward (line-end-position) t))
 336       (setq comempty (looking-at "[ \t]*$")))
 337
 338     (cond
 339
 340      ;; Blank line, start comment at code indent level.
 341      ((save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))
 342       (indent-according-to-mode)
 343       (insert pir-comment-char pir-comment-char ?\ ))
 344
 345      ;; Nonblank line w/o comment => start a comment at comment-column
 346      ;; Also: point before the comment => jump inside.
 347      ((or (null comment) (< (point) comment))
 348       (indent-for-comment))
 349
 350      ;; Empty code-level comment => upgrade to next comment level.
 351      ((save-excursion (goto-char comment) (skip-chars-backward " \t") (bolp))
 352       (goto-char comment)
 353       (insert pir-comment-char)
 354       (indent-for-comment))
 355
 356      ;; Empty comment ends non-empty code line => new comment above.
 357      (t
 358       (goto-char comment)
 359       (skip-chars-backward " \t")
 360       (delete-region (point) (line-end-position))
 361       (beginning-of-line) (insert "\n") (backward-char)
 362       (pir-comment)))))
 363
 364 (defun pir-electric-colon ()
 365   "Automatically indent labels as soon as the colon is added."
 366   (interactive)
 367   (let ((labelp nil))
 368     (save-excursion
 369       (skip-syntax-backward "w_")
 370       (skip-syntax-backward " ")
 371       (if (setq labelp (bolp)) (delete-horizontal-space)))
 372     (call-interactively 'self-insert-command)
 373     (when labelp
 374       (delete-horizontal-space)
 375       (tab-to-tab-stop))))
 376
 377 (defmacro setlocalq (sym val)
 378   "Localize SYM and set it to the value of VAL."
 379   `(set (make-local-variable (quote ,sym)) ,val))
 380
 381 (defun pir-mode ()
 382   "Major mode for editing PIR files.
 383
 384 This mode makes it easier to write PIR code by helping with
 385 indentation, doing some of the typing for you (with Abbrev mode) and by
 386 showing keywords, comments, strings etc. in different faces (with Font
 387 Lock mode on terminals that support it).
 388
 389 PIR (Parrot Intermediate Representation) is a friendlier way of
 390 programming parrot than raw PASM (Parrot Assembly). In general,
 391 compilers (and certainly humans) should code in PIR and let Parrot
 392 handle register allocation and all that good stuff.
 393
 394 To find out more, hie thee to `http://www.parrotcode.org/'.
 395
 396 Type \\[list-abbrevs] to display the built in abbrevs for PIR
 397 keywords. (When I've set them up.)
 398
 399 Keybindings
 400 ===========
 401 \\{pir-mode-map}
 402
 403 Variables you can use to customize PIR mode
 404 ===========================================
 405
 406 pir-auto-indent
 407   Non-nil means indent current line after a space.
 408   Default is nil.
 409
 410 pir-blink-matching-block
 411   Non-nil means show matching begin of block when inserting a space or
 412   newline after the end of a block.  Default is t.
 413
 414 pir-basic-indent
 415   PIR mode's basic level of indentation. Default is 8.
 416
 417 Turning on PIR mode runs the hook `pir-mode-hook'.
 418
 419 To begin using this mode for all `.pir' files that you edit, add the
 420 following lines to your `.emacs' file:
 421
 422   (autoload 'pir-mode \"pir-mode\" nil t)
 423   (add-to-list 'auto-mode-alist '(\"\\\\.pir\\\\'\" . pir-mode))
 424
 425 If you have any problems with this, you're on your own. You could always
 426 try asking on parrot-porters@perl.org."
 427   (interactive)
 428   (kill-all-local-variables)
 429   (use-local-map pir-mode-map)
 430   (setq major-mode 'pir-mode)
 431   (setq mode-name "PIR")
 432
 433   (set-syntax-table pir-mode-syntax-table)
 434
 435   (setlocalq font-lock-defaults '(pir-font-lock-keywords))
 436   (setlocalq indent-line-function 'pir-indent-line)
 437   (setlocalq pir-basic-indent pir-basic-indent)
 438   (setlocalq require-final-newline t)
 439
 440   (setlocalq comment-start "# ")
 441   (setlocalq comment-end "")
 442   (setlocalq comment-column pir-comment-column)
 443   (setlocalq comment-start-skip "#+ *")
 444   (setlocalq comment-indent-function 'pir-comment-indent)
 445
 446   (setlocalq parse-sexp-ignore-comments t)
 447   (setlocalq paragraph-start (concat "\\s-*$\\|" page-delimiter))
 448   (setlocalq paragraph-separate paragraph-start)
 449   (setlocalq paragraph-ignore-fill-prefix t)
 450   (setlocalq fill-paragraph-function 'pir-fill-paragraph)
 451   (setlocalq adaptive-fill-regexp nil)
 452   (setlocalq fill-column 72)
 453
 454   (setlocalq imenu-generic-expression pir-imenu-generic-expression)
 455   (setq      imenu-case-fold-search nil)
 456
 457   (setlocalq defun-prompt-regexp "^\\s_*\\.\\(sub\\|emit\\)\\s_+")
 458
 459   (pir-initialize-completions)
 460   (pir-add-pir-menu)
 461
 462   (run-hooks 'pir-mode-hook))
 463
 464 (defun pir-describe-major-mode ()
 465   "Describe the current major mode."
 466   (interactive)
 467   (describe-function major-mode))
 468
 469 (defsubst pir-in-comment-p ()
 470   "Return t if point is inside a PIR comment, nil otherwise."
 471   (interactive)
 472   (save-excursion
 473     (nth 4 (parse-partial-sexp (line-beginning-position) (point)))))
 474
 475 (defsubst pir-in-string-p ()
 476   "Return t if point is inside a PIR string, nil otherwise."
 477   (interactive)
 478   (save-excursion
 479     (nth 3 (parse-partial-sexp (line-beginning-position) (point)))))
 480
 481 (defsubst pir-not-in-string-or-comment-p ()
 482   "Return t iff point is not inside a PIR string or comment."
 483   (let ((pps (parse-partial-sexp (line-beginning-position) (point))))
 484     (not (or (nth 3 pps) (nth 4 pps)))))
 485
 486 (defun pir-in-block-p ()
 487   "Return t if point is inside a PIR block, nil otherwise.
 488 The block is taken to start at the first letter of the begin keyword and
 489 to end after the end keyword."
 490   (let ((pos (point)))
 491     (save-excursion
 492       (condition-case nil
 493       (progn
 494         (skip-syntax-forward "w")
 495         (pir-up-block -1)
 496         (pir-forward-block)
 497         t)
 498     (error nil))
 499       (< pos (point)))))
 500
 501 (defun pir-in-defun-p ()
 502   "Return t iff point is inside a PIR function declaration.
 503 The function is taken to start at the `.' of `.sub' and to end after
 504 the `.end' keyword."
 505   (let ((pos (point)))
 506     (save-excursion
 507       (or (and (looking-at "\\<.sub\\>")
 508            (pir-not-in-string-or-comment-p))
 509       (and (pir-beginning-of-defun)
 510            (condition-case nil
 511            (progn
 512              (pir-forward-block)
 513              t)
 514          (error nil))
 515            (< pos (point)))))))
 516
 517 \f
 518 ;;; Comments
 519 (defun pir-comment-region (beg end &optional arg)
 520   "Comment or uncomment each line in the region as PIR code.
 521 See `comment-region'."
 522   (interactive "r\nP")
 523   (let ((comment-start (char-to-string pir-comment-char)))
 524     (comment-region beg end arg)))
 525
 526 (defun pir-uncomment-region (beg end &optional arg)
 527   "Uncomment each line in the region as PIR code."
 528   (interactive "r\nP")
 529   (or arg (setq arg 1))
 530   (pir-comment-region beg end (- arg)))
 531
 532 \f
 533 ;;; Indentation
 534 (defun calculate-pir-indent (&optional ignore-labelp)
 535   "Calculate the correct indentation for a line of PIR code.
 536 Optional argument IGNORE-LABELP if set, labels are ignored for the purposes of calculating the indent."
 537   (let ((icol 0))
 538     (save-excursion
 539       (beginning-of-line)
 540       (cond ((condition-case nil
 541          (progn (up-list -1)
 542             t)
 543            (error nil))
 544          (setq icol (1+ (current-column))))
 545         ((and (not ignore-labelp)
 546           (looking-at "\\s-*\\sw+:"))
 547          (setq icol 0))
 548         ((zerop (pir-previous-code-line))
 549          (let ((labelp (looking-at "\\s-*\\sw+:")))
 550            (pir-beginning-of-line)
 551            (back-to-indentation)
 552            (setq icol (current-column))
 553            (let ((bot (point))
 554              (eol (line-end-position)))
 555          (while (< (point) eol)
 556            (if (pir-not-in-string-or-comment-p)
 557                (cond
 558             ((looking-at pir-block-begin-regexp)
 559              (setq icol (+ icol
 560                        (pir-block-offset (match-string 1)))))
 561             ((looking-at pir-block-end-regexp)
 562              (if (not (= bot (point)))
 563                  (setq icol (- icol
 564                        (pir-block-offset
 565                         (match-string 1))))))))
 566            (forward-char))
 567          (if (and labelp
 568               (= 0 icol))
 569              (setq icol (calculate-pir-indent 'ignore-label)))
 570          )))))
 571     (save-excursion
 572     (back-to-indentation)
 573     (cond
 574      ((and (looking-at pir-block-end-regexp)
 575            (pir-not-in-string-or-comment-p))
 576       (looking-at pir-block-end-regexp)
 577       (setq icol (- icol (pir-block-offset (match-string 1)))))
 578      ((or (looking-at "\\s<\\s<\\s<\\S<")
 579           (pir-before-magic-comment-p))
 580       (setq icol (list 0 icol)))
 581      ((looking-at "\\s<\\S<")
 582       (setq icol (list comment-column icol)))))
 583       icol))
 584
 585 (defun pir-block-offset (string)
 586   (* pir-basic-indent
 587      (cdr (assoc string pir-block-offset-alist))))
 588
 589 (defun pir-before-magic-comment-p ()
 590   "Return t if point is before the shebang."
 591   (save-excursion
 592     (beginning-of-line)
 593     (and (bobp) (looking-at "\\s-*#!"))))
 594
 595 (defun pir-comment-indent ()
 596   "Calculate the correct comment indent."
 597   (if (or (looking-at "\\s<\\s<\\s<")
 598       (pir-before-magic-comment-p))
 599       0
 600     (if (looking-at "\\<\\<")
 601     (calculate-pir-indent)
 602       (skip-syntax-backward " ")
 603       (max (if (bolp) 0 (1+ (current-column)))
 604        comment-column))))
 605
 606 (defun pir-indent-for-comment ()
 607   "Maybe insert and indent a PIR comment.
 608 If there is no comment already on this line, create a code-level comment
 609 \(started by two comment characters) if the line is empty, or an in-line
 610 comment (started by one comment character) otherwise.
 611 Point is left after the start of the comment which is properly aligned."
 612   (interactive)
 613   (indent-for-comment)
 614   (indent-according-to-mode))
 615
 616 (defun pir-indent-line (&optional arg)
 617   "Indent current line as PIR code.
 618 With optional ARG, use this as offset unless this line is a comment with
 619 fixed goal column."
 620   (interactive)
 621   (or arg (setq arg 0))
 622   (let ((icol (calculate-pir-indent))
 623     (relpos (- (current-column) (current-indentation))))
 624     (if (listp icol)
 625     (setq icol (car icol))
 626       (setq icol (+ icol arg)))
 627     (if (< icol 0)
 628     (error "Unmatched end keyword")
 629       (indent-line-to icol)
 630       (if (> relpos 0)
 631       (move-to-column (+ icol relpos))))))
 632
 633 (defun pir-indent-new-comment-line ()
 634   "Break PIR line at point, continuing comment if within one.
 635 If within code, insert `pir-continuation-string' before breaking the
 636 line.  If within a string, signal an error.
 637 The new line is properly indented."
 638   (interactive)
 639   (delete-horizontal-space)
 640   (cond
 641    ((pir-in-comment-p)
 642     (indent-new-comment-line))
 643    (t
 644     (error "Don't know how to split this code line"))))
 645
 646 (defun pir-indent-defun ()
 647   "Properly indent the PIR function which contains point."
 648   (interactive)
 649   (save-excursion
 650     (pir-mark-defun)
 651     (message "Indenting function...")
 652     (indent-region (point) (mark) nil))
 653   (message "Indenting function...done."))
 654
 655 \f
 656 ;;; Motion
 657 (defun pir-next-code-line (&optional arg)
 658   "Move ARG lines of PIR code forward (backward if ARG is negative).
 659 Skips past all empty and comment lines.  Default for ARG is 1.
 660
 661 On success, return 0.  Otherwise, go as far as possible and return -1."
 662   (interactive "p")
 663   (or arg (setq arg 1))
 664   (beginning-of-line)
 665   (let ((n 0)
 666     (inc (if (> arg 0) 1 -1)))
 667     (while (and (/= arg 0) (= n 0))
 668       (setq n (forward-line inc))
 669       (while (and (= n 0)
 670           (looking-at "\\s-*\\($\\|\\s<\\)"))
 671     (setq n (forward-line inc)))
 672       (setq arg (- arg inc)))
 673     n))
 674
 675 (defun pir-previous-code-line (&optional arg)
 676   "Move ARG lines of PIR code backward (forward if ARG is negative).
 677 Skips past all empty and comment lines.  Default for ARG is 1.
 678
 679 On success, return 0.  Otherwise, go as far as possible and return -1."
 680   (interactive "p")
 681   (or arg (setq arg 1))
 682   (pir-next-code-line (- arg)))
 683
 684 (defun pir-beginning-of-line ()
 685   "Move point to beginning of current PIR line.
 686 If on an empty or comment line, go to the beginning of that line."
 687   (interactive)
 688   (beginning-of-line)
 689   (if (not (looking-at "\\s-*\\($\\|\\s<\\)"))
 690       (while (or (condition-case nil
 691              (progn
 692                (up-list -1)
 693                (beginning-of-line)
 694                t)
 695            (error nil))
 696          (and (looking-at "\\s-*\\($\\|\\s<\\)")
 697               (zerop (forward-line -1)))))))
 698
 699 (defun pir-end-of-line ()
 700   "Move point to end of current PIR line.
 701 If on an empty or comment line, go to the end of that line.
 702 Otherwise, move forward to the end of the first PIR code line which
 703 does not end in `...' or `\\' or is inside an open parenthesis list."
 704   (interactive)
 705   (end-of-line)
 706   (if (save-excursion
 707     (beginning-of-line)
 708     (looking-at "\\s-*\\($\\|\\s<\\)"))
 709       ()
 710     (while (or (condition-case nil
 711            (progn
 712              (up-list 1)
 713              (end-of-line)
 714              t)
 715          (error nil))
 716            (and (save-excursion
 717               (beginning-of-line)
 718               (looking-at "\\s-*\\($\\|\\s<\\)"))
 719             (zerop (forward-line 1)))))
 720     (end-of-line)))
 721
 722 (defun pir-scan-blocks (from count depth)
 723   "Scan from character number FROM by COUNT PIR begin-end blocks.
 724 Returns the character number of the position thus found.
 725
 726 If DEPTH is nonzero, block depth begins counting from that value.
 727 Only places where the depth in blocks becomes zero are candidates for
 728 stopping; COUNT such places are counted.
 729
 730 If the beginning or end of the buffer is reached and the depth is wrong,
 731 an error is signaled."
 732   (let ((min-depth (if (> depth 0) 0 depth))
 733     (inc (if (> count 0) 1 -1)))
 734     (save-excursion
 735       (while (/= count 0)
 736     (catch 'foo
 737       (while (or (re-search-forward
 738               pir-block-begin-or-end-regexp nil 'move inc)
 739              (if (/= depth 0)
 740              (error "Unbalanced block")))
 741         (if (pir-not-in-string-or-comment-p)
 742         (progn
 743           (cond
 744            ((match-end 1)
 745             (setq depth (+ depth inc)))
 746            ((match-end 2)
 747             (setq depth (- depth inc))))
 748           (if (< depth min-depth)
 749               (error "Containing expression ends prematurely"))
 750           (if (= depth 0)
 751               (throw 'foo nil))))))
 752     (setq count (- count inc)))
 753       (point))))
 754
 755 (defun pir-forward-block (&optional arg)
 756   "Move forward across one balanced PIR begin-end block.
 757 With argument, do it that many times.
 758 Negative arg -ARG means move backward across ARG blocks."
 759   (interactive "p")
 760   (or arg (setq arg 1))
 761   (goto-char (or (pir-scan-blocks (point) arg 0) (buffer-end arg))))
 762
 763 (defun pir-backward-block (&optional arg)
 764   "Move backward across one balanced PIR begin-end block.
 765 With argument, do it that many times.
 766 Negative arg -ARG means move forward across ARG blocks."
 767   (interactive "p")
 768   (or arg (setq arg 1))
 769   (pir-forward-block (- arg)))
 770
 771 (defun pir-down-block (arg)
 772   "Move forward down one begin-end block level of PIR code.
 773 With ARG, do this that many times.
 774 A negative ARG means move backward but still go down a level.
 775 In Lisp programs, an argument is required."
 776   (interactive "p")
 777   (let ((inc (if (> arg 0) 1 -1)))
 778     (while (/= arg 0)
 779       (goto-char (or (pir-scan-blocks (point) inc -1)
 780              (buffer-end arg)))
 781       (setq arg (- arg inc)))))
 782
 783 (defun pir-backward-up-block (arg)
 784   "Move backward out of one begin-end block level of PIR code.
 785 With ARG, do this that many times.
 786 A negative ARG means move forward but still to a less deep spot.
 787 In Lisp programs, an argument is required."
 788   (interactive "p")
 789   (pir-up-block (- arg)))
 790
 791 (defun pir-up-block (arg)
 792   "Move forward out of one begin-end block level of PIR code.
 793 With ARG, do this that many times.
 794 A negative ARG means move backward but still to a less deep spot.
 795 In Lisp programs, an argument is required."
 796   (interactive "p")
 797   (let ((inc (if (> arg 0) 1 -1)))
 798     (while (/= arg 0)
 799       (goto-char (or (pir-scan-blocks (point) inc 1)
 800              (buffer-end arg)))
 801       (setq arg (- arg inc)))))
 802
 803 (defun pir-mark-block ()
 804   "Put point at the beginning of this PIR block, mark at the end.
 805 The block marked is the one that contains point or follows point."
 806   (interactive)
 807   (let ((pos (point)))
 808     (if (or (and (pir-in-block-p)
 809          (skip-syntax-forward "w"))
 810         (condition-case nil
 811         (progn
 812           (pir-down-block 1)
 813           (pir-in-block-p))
 814           (error nil)))
 815     (progn
 816       (pir-up-block -1)
 817       (push-mark (point))
 818       (pir-forward-block)
 819       (exchange-point-and-mark))
 820       (goto-char pos)
 821       (message "No block to mark found"))))
 822
 823 (defun pir-close-block ()
 824   "Close the current PIR block on a separate line.
 825 An error is signaled if no block to close is found."
 826   (interactive)
 827   (let (bb-keyword)
 828     (condition-case nil
 829     (progn
 830       (save-excursion
 831         (pir-backward-up-block 1)
 832         (setq bb-keyword (buffer-substring-no-properties
 833                   (match-beginning 1) (match-end 1))))
 834       (if (save-excursion
 835         (beginning-of-line)
 836         (looking-at "^\\s-*$"))
 837           (indent-according-to-mode)
 838         (pir-reindent-then-newline-and-indent))
 839       (insert (cadr (assoc bb-keyword
 840                    pir-block-match-alist)))
 841       (pir-reindent-then-newline-and-indent)
 842       t)
 843       (error (message "No block to close found")))))
 844
 845 (defun pir-blink-matching-block-open ()
 846   "Blink the matching PIR begin block keyword.
 847 If point is right after a PIR else or end type block keyword, move
 848 cursor momentarily to the corresponding begin keyword.
 849 Signal an error if the keywords are incompatible."
 850   (interactive)
 851   (let (bb-keyword bb-arg eb-keyword pos eol)
 852     (if (and (pir-not-in-string-or-comment-p)
 853          (looking-at "\\>")
 854          (save-excursion
 855            (skip-syntax-backward "w_.")
 856            (looking-at pir-block-end-regexp)))
 857     (save-excursion
 858       (setq eb-keyword
 859         (buffer-substring-no-properties
 860          (match-beginning 1) (match-end 1)))
 861       (pir-backward-block)
 862       (setq pos (match-end 1)
 863         bb-keyword
 864         (buffer-substring-no-properties
 865          (match-beginning 1) pos)
 866         pos (+ pos 1)
 867         eol (line-end-position))
 868       (if (member eb-keyword
 869               (cdr (assoc bb-keyword pir-block-match-alist)))
 870           (progn
 871         (message "Matches `.%s'" bb-keyword)
 872         (if (pos-visible-in-window-p)
 873             (sit-for blink-matching-delay)))
 874         (error "Block keywords `%s' and `%s' do not match"
 875            bb-keyword eb-keyword))))))
 876
 877 (defun pir-beginning-of-defun (&optional arg)
 878   "Move backward to the beginning of a PIR function.
 879 With positive ARG, do it that many times.  Negative argument -N means
 880 move forward to Nth following beginning of a function.
 881 Returns t unless search stops at the beginning or end of the buffer."
 882   (interactive "p")
 883   (let* ((arg (or arg 1))
 884      (inc (if (> arg 0) 1 -1))
 885      (found))
 886     (and (not (eobp))
 887      (not (and (> arg 0) (looking-at "\\<function\\>")))
 888      (skip-syntax-forward "w"))
 889     (while (and (/= arg 0)
 890         (setq found
 891               (re-search-backward "\\<function\\>" nil 'move inc)))
 892       (if (pir-not-in-string-or-comment-p)
 893       (setq arg (- arg inc))))
 894     (if found
 895     (progn
 896       (and (< inc 0) (goto-char (match-beginning 0)))
 897       t))))
 898
 899 (defun pir-end-of-defun (&optional arg)
 900   "Move forward to the end of a PIR function.
 901 With positive ARG, do it that many times.  Negative argument -N means
 902 move back to Nth preceding end of a function.
 903
 904 An end of a function occurs right after the end keyword matching the
 905 `function' keyword that starts the function."
 906   (interactive "p")
 907   (or arg (setq arg 1))
 908   (and (< arg 0) (skip-syntax-backward "w"))
 909   (and (> arg 0) (skip-syntax-forward "w"))
 910   (if (pir-in-defun-p)
 911       (setq arg (- arg 1)))
 912   (if (= arg 0) (setq arg -1))
 913   (if (pir-beginning-of-defun (- arg))
 914       (pir-forward-block)))
 915
 916 (defun pir-mark-defun ()
 917   "Put point at the beginning of this PIR function, mark at its end.
 918 The function marked is the one containing point or following point."
 919   (interactive)
 920   (let ((pos (point)))
 921     (if (or (pir-in-defun-p)
 922         (and (pir-beginning-of-defun -1)
 923          (pir-in-defun-p)))
 924     (progn
 925       (skip-syntax-forward "w")
 926       (pir-beginning-of-defun)
 927       (push-mark (point))
 928       (pir-end-of-defun)
 929       (exchange-point-and-mark))
 930       (goto-char pos)
 931       (message "No function to mark found"))))
 932
 933 \f
 934 ;;; Filling
 935
 936 (defun pir-fill-paragraph (&optional arg)
 937  "Fill paragraph of PIR code, handling PIR comments.
 938 Optional argument ARG appears to be ignored.  Um..."
 939  (interactive "P")
 940  (save-excursion
 941    (let ((end (progn (forward-paragraph) (point)))
 942      (beg (progn
 943         (forward-paragraph -1)
 944         (skip-chars-forward " \t\n")
 945         (beginning-of-line)
 946         (point)))
 947      (cfc (current-fill-column))
 948      (ind (calculate-pir-indent))
 949      comment-prefix)
 950      (save-restriction
 951        (goto-char beg)
 952        (narrow-to-region beg end)
 953        (if (listp ind) (setq ind (nth 1 ind)))
 954        (while (not (eobp))
 955      (condition-case nil
 956          (pir-indent-line ind)
 957        (error nil))
 958      (if (and (> ind 0)
 959           (not
 960            (save-excursion
 961              (beginning-of-line)
 962              (looking-at "^\\s-*\\($\\|\\s<+\\)"))))
 963          (setq ind 0))
 964      (move-to-column cfc)
 965      ;; First check whether we need to combine non-empty comment lines
 966      (if (and (< (current-column) cfc)
 967           (pir-in-comment-p)
 968           (not (save-excursion
 969              (beginning-of-line)
 970              (looking-at "^\\s-*\\s<+\\s-*$"))))
 971          ;; This is a nonempty comment line which does not extend
 972          ;; past the fill column.  If it is followed by a nonempty
 973          ;; comment line with the same comment prefix, try to
 974          ;; combine them, and repeat this until either we reach the
 975          ;; fill-column or there is nothing more to combine.
 976          (progn
 977            ;; Get the comment prefix
 978            (save-excursion
 979          (beginning-of-line)
 980          (while (and (re-search-forward "\\s<+")
 981                  (not (pir-in-comment-p))))
 982          (setq comment-prefix (match-string 0)))
 983            ;; And keep combining ...
 984            (while (and (< (current-column) cfc)
 985                (save-excursion
 986                  (forward-line 1)
 987                  (and (looking-at
 988                    (concat "^\\s-*"
 989                        comment-prefix
 990                        "\\S<"))
 991                   (not (looking-at
 992                     (concat "^\\s-*"
 993                         comment-prefix
 994                         "\\s-*$"))))))
 995          (delete-char 1)
 996          (re-search-forward comment-prefix)
 997          (delete-region (match-beginning 0) (match-end 0))
 998          (fixup-whitespace)
 999          (move-to-column cfc))))
1000      ;; We might also try to combine continued code lines>  Perhaps
1001      ;; some other time ...
1002      (skip-chars-forward "^ \t\n")
1003      (delete-horizontal-space)
1004      (if (or (< (current-column) cfc)
1005          (and (= (current-column) cfc) (eolp)))
1006          (forward-line 1)
1007        (if (not (eolp)) (insert " "))
1008            (forward-line 1))))
1009      t)))
1010 \f
1011
1012 ;;; Electric characters && friends
1013 (defun pir-reindent-then-newline-and-indent ()
1014   "Reindent current PIR line, insert newline, and indent the new line.
1015 If Abbrev mode is on, expand abbrevs first."
1016   (interactive)
1017   (if abbrev-mode (expand-abbrev))
1018   (if pir-blink-matching-block
1019       (pir-blink-matching-block-open))
1020   (save-excursion
1021     (delete-region (point) (progn (skip-chars-backward " \t") (point)))
1022     (indent-according-to-mode))
1023   (insert "\n")
1024   (indent-according-to-mode))
1025
1026 (defun pir-electric-semi ()
1027   "Insert a semicolon in PIR mode.
1028 Maybe expand abbrevs and blink matching block open keywords.
1029 Reindent the line of `pir-auto-indent-flag' is non-nil.
1030 Insert a newline if `pir-auto-newline' is non-nil."
1031   (interactive)
1032   (if (not (pir-not-in-string-or-comment-p))
1033       (insert ";")
1034     (if abbrev-mode (expand-abbrev))
1035     (if pir-blink-matching-block
1036     (pir-blink-matching-block-open))
1037     (if pir-auto-indent-flag
1038     (indent-according-to-mode))
1039     (insert ";")
1040     (if pir-auto-newline
1041     (newline-and-indent))))
1042
1043 (defun pir-electric-space ()
1044   "Insert a space in PIR mode.
1045 Maybe expand abbrevs and blink matching block open keywords.
1046 Reindent the line of `pir-auto-indent-flag' is non-nil."
1047   (interactive)
1048   (setq last-command-char ? )
1049   (if (not (pir-not-in-string-or-comment-p))
1050       (progn
1051     (indent-according-to-mode)
1052     (self-insert-command 1))
1053     (if abbrev-mode (expand-abbrev))
1054     (if pir-blink-matching-block
1055     (pir-blink-matching-block-open))
1056     (if (and pir-auto-indent-flag
1057          (save-excursion
1058            (skip-syntax-backward " ")
1059            (not (bolp))))
1060     (indent-according-to-mode))
1061     (self-insert-command 1)))
1062
1063 (defun pir-abbrev-start ()
1064   "Start entering a PIR abbreviation.
1065 If Abbrev mode is turned on, typing ` (grave accent) followed by ? or
1066 \\[help-command] lists all PIR abbrevs.  Any other key combination is
1067 executed normally.
1068 Note that all PIR mode abbrevs start with a grave accent."
1069   (interactive)
1070   (if (not abbrev-mode)
1071       (self-insert-command 1)
1072     (let (c)
1073       (insert last-command-char)
1074       (if ;(if pir-xemacs-p
1075       ;    (or (eq (event-to-character (setq c (next-event))) ??)
1076       ;   (eq (event-to-character c) help-char))
1077       (or (eq (setq c (read-event)) ??)
1078           (eq c help-char))
1079       (let ((abbrev-table-name-list '(pir-abbrev-table)))
1080         (list-abbrevs))
1081     (setq unread-command-events (list c))))))
1082
1083 (defun pir-insert-defun (name args vals)
1084   "Insert a PIR function skeleton.
1085 Prompt for the function's NAME, ARGS and return VALS (to be
1086 entered without parens)."
1087   (interactive
1088    (list
1089     (read-from-minibuffer "Function name: "
1090               (substring (buffer-name) 0 -2))
1091     (read-from-minibuffer "Arguments: ")
1092     (read-from-minibuffer "Return values: ")))
1093   (let ((string (format "%s %s (%s)"
1094             (cond
1095              ((string-equal vals "")
1096               vals)
1097              ((string-match "[ ,]" vals)
1098               (concat " [" vals "] ="))
1099              (t
1100               (concat " " vals " =")))
1101             name
1102             args))
1103     (prefix pir-block-comment-start))
1104     (if (not (bobp)) (newline))
1105     (insert "function" string)
1106     (indent-according-to-mode)
1107     (newline 2)
1108     (insert prefix "usage: " string)
1109     (reindent-then-newline-and-indent)
1110     (insert prefix)
1111     (reindent-then-newline-and-indent)
1112     (insert prefix)
1113     (indent-according-to-mode)
1114     (save-excursion
1115       (newline 2)
1116       (insert "endfunction")
1117       (indent-according-to-mode))))
1118
1119 \f
1120 ;;; Completions
1121 (defun pir-initialize-completions ()
1122   "Initialize the completion table for PIR symbols."
1123   (if pir-completion-alist
1124       ()
1125     (setq pir-completion-alist
1126       (mapcar '(lambda (var) (cons var var))
1127           (append pir-PMC-keyword-symbols
1128               pir-ops pir-dotted-directives
1129               pir-variable-declarations)))))
1130
1131 (defun pir-complete-symbol ()
1132   "Perform completion on PIR symbol preceding point.
1133 Compare that symbol against PIR's reserved words and builtin
1134 variables."
1135   ;; This code taken from lisp-complete-symbol
1136   (interactive)
1137   (let* ((end (point))
1138      (beg (save-excursion (backward-sexp 1) (point)))
1139      (string (buffer-substring-no-properties beg end))
1140      (completion (try-completion string pir-completion-alist)))
1141     (cond ((eq completion t))       ; ???
1142       ((null completion)
1143        (message "Can't find completion for \"%s\"" string)
1144        (ding))
1145       ((not (string= string completion))
1146            (delete-region beg end)
1147            (insert completion))
1148       (t
1149        (let ((list (all-completions string pir-completion-alist))
1150          (conf (current-window-configuration)))
1151          ;; Taken from comint.el
1152          (message "Making completion list...")
1153          (with-output-to-temp-buffer "*Completions*"
1154            (display-completion-list list))
1155          (message "Hit space to flush")
1156          (let (key first)
1157            (if (save-excursion
1158              (set-buffer (get-buffer "*Completions*"))
1159              (setq key (read-key-sequence nil)
1160                first (aref key 0))
1161              (and (consp first) (consp (event-start first))
1162               (eq (window-buffer (posn-window (event-start
1163                                first)))
1164                   (get-buffer "*Completions*"))
1165               (eq (key-binding key) 'mouse-choose-completion)))
1166            (progn
1167              (mouse-choose-completion first)
1168              (set-window-configuration conf))
1169          (if (eq first ?\ )
1170              (set-window-configuration conf)
1171            (setq unread-command-events
1172              (listify-key-sequence key))))))))))
1173
1174 \f
1175 ;;; Menu
1176 (defun pir-add-pir-menu ()
1177   "Add the `PIR' menu to the menu bar in PIR mode."
1178   (require 'easymenu)
1179   (easy-menu-define pir-mode-menu-map pir-mode-map
1180     "Menu keymap for PIR mode." pir-mode-menu)
1181   (easy-menu-add pir-mode-menu-map pir-mode-map))
1182
1183
1184 (provide 'pir-mode)
1185
1186 ;;; pir-mode.el ends here