Some EMACS code for Colour Forth
- To: misc
- Subject: Some EMACS code for Colour Forth
- From: Christopher Biggs <chris@xxxxxxxxxxxxxx>
- Date: 11 Aug 1997 10:40:11 +1000
Here's some code I knocked up (to extend the forth.el available with
gforth or from Taygeta) to do colour highlighting of Forth code.
If you're colour blind, change the colours to different fonts. If
you're not colour-blind, stop bloody nitpicking about minority
interests, and let them worry about it.
You will need the file ftp://ftp.taygeta.com/pub/Forth/Tools/forth.el
installed in your load-path.
Chris.
p.s. I have code to implement the outline-headers and fancy comments
in C, Lisp and Scheme, if anybody is interested.
--
| Christopher J. Biggs | EMAIL: chris@stallion.oz.au (PGP and MIME OK) |
| R&D Software Engineer | PHONE: +61 7 3270-4266 FAX: +61 7 3270-4245 |
| Stallion Technologies | Microsoft is not the Answer. |
\ Queensland, AUSTRALIA | Microsoft is the Question. NO is the answer! /
;;; local-forth.el --- Configuration for editing forth files
;;; Copyright (C) 1996 Christopher Biggs
;;; Time-stamp: <97/08/11 10:10:40 chris>
;; Author: Christopher Biggs <chris@stallion.oz.au>
;; Maintainer: Christopher Biggs <chris@stallion.oz.au>
;; Created: 29 May 1996
;; Version: $Revision: 1.1 $
;; Keywords: forth emacs pfe
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License along
;; with this file or with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;;;
;;; Extensions to the forth-mode provided by gforth.el.
;;;
;;; This file provides font-lock highlighting of FORTH code, and some
;;; layout constructs I use in my own code:
;;;
;;; Comments of the form "\ @+" are outline-headers for emacs' folding outline
;;; mode.
;;;
;;; M-; creates a block comment. An optional numeric argument adds an
;;; outline-header to the block comment.
;;;
;;; M-' creates a "rule-comment". Positive argument produces a major rule
;;; at the given outline level (\ @**** comment *****), a negative argument
;;; produces a minor rule at the given outline level (\ @---- comment ----).
;;;
;;; Keys are defined to expand and collapse outline body sections. If
;;; forth-auto-outline-p is set, a buffer will be collapsed to an outline when
;;; it is loaded, making it easier to move to the section you want.
;;;
;;; Comments of the form (S ) (G ) (R ) etc. are from a coding-rules guide
;;; posted to comp.lang.forth by Paul Bennett <peb@transcotech.cu.uk>.
;;; The article was <851786739snz@transcontech.co.uk> dated 28 Dec 1996.
;;;
;;; You can define these stuctured comments:
;;;
;;; : (C POSTPONE ( ; IMMEDIATE \ control stack effect
;;; : (F POSTPONE ( ; IMMEDIATE \ floating-point stack effect
;;; : (G POSTPONE ( ; IMMEDIATE \ Glossary entry
;;; : (S POSTPONE ( ; IMMEDIATE \ Data stack effect
;;; : (R POSTPONE ( ; IMMEDIATE \ Return stack effect
;;;
;;;
;;; Just put (load "local-forth") in your .emacs to activate the facilities
;;; provided by this file.
;;;
;;; TODO:
;;;
;;; Add more standard words to be highlighted (but which ones?)
;;; Highlight immediate code within colon definitions
;;; Highlight parsed strings somehow
;;; BUGS:
;;; Code:
(defconst local-forth-version (substring "$Revision: 1.1 $" 11 -2)
"$Id: elisp-insert.el,v 1.1 1995/05/21 05:53:34 chris Exp $
Report bugs to: Christopher Biggs <chris@stallion.oz.au>")
;;
;;@*************************** Font-Lock rules *****************************
(defvar forth-font-lock-keywords nil
"expressions to highlight in Forth mode.")
(setq
forth-font-lock-keywords
(let ((forth-defining-words
;;(make-regexp '(":" ":NONAME" "VARIABLE" "CONSTANT"
;;"CREATE" "DOES>" "CODE" "END-CODE" "PARSE" "WORD" ))
":\\(\\|NONAME\\)\\|C\\(O\\(DE\\|NSTANT\\)\\|REATE\\)\\|DOES>\\|END-CODE\\|PARSE\\|VARIABLE\\|WORD"
)
(forth-immediate-words
;;(make-regexp '( "[IF]" "[THEN]" "[ELSE]" "IMMEDIATE" ";" "[" "]" ))
"[;\\[\\]]\\|IMMEDIATE\\|\\[\\(ELSE\\]\\|IF\\]\\|THEN\\]\\)"
)
(forth-core-words
;;(make-regexp '("ABORT" "BEGIN" "DO" "ELSE" "EXIT" "IF" "LEAVE"
;; "LOOP" "QUIT" "RECURSE" "REPEAT" "THEN" "UNLOOP"
;; "UNTIL" "WHILE" "?DO" "AGAIN" "CASE" "ENDCASE"
;; "ENDOF" "OF" "AHEAD" "BYE" "CS-PICK" "CS-ROLL"))
"?DO\\|A\\(BORT\\|GAIN\\|HEAD\\)\\|B\\(EGIN\\|YE\\)\\|C\\(ASE\\|S-\\(PICK\\|ROLL\\)\\)\\|DO\\|E\\(LSE\\|ND\\(CASE\\|OF\\)\\|XIT\\)\\|IF\\|L\\(EAVE\\|OOP\\)\\|OF\\|QUIT\\|RE\\(CURSE\\|PEAT\\)\\|THEN\\|UN\\(LOOP\\|TIL\\)\\|WHILE"
)
);end let-bindings
(list
'("\\(\\\\ @+\\*.+\\)" 1 font-lock-type-face t)
'("\\(\\\\ @+\\-.+\\)" 1 font-lock-function-name-face t)
'("\\(\\\\ @+ .+\\)" 1 font-lock-keyword-face t)
'("\\(\\\\ .*\\)" 1 font-lock-comment-face)
'("\\(^\\|\\s \\):[ \t]+\\(\\sw+\\)" 2 font-lock-function-name-face)
'("\\(([CSGRF] .*\\s )\\)" 1 font-lock-comment-face)
'("\\(( .* )\\)" 1 font-lock-comment-face)
(list (concat "\\<\\(" forth-defining-words "\\)\\>")
1 'font-lock-variable-name-face)
(list (concat "\\<\\(" forth-immediate-words "\\)\\>")
1 'font-lock-type-face)
(list (concat "\\<\\(" forth-core-words "\\)\\>")
1 'font-lock-keyword-face)
)))
;;;@******************* Forth outline configuration ********************
;;
;; Look for my custom header comments, and if any are found,
;; shrink the buffer to show only headings
;;
(defun local-forth-outline-mode ()
"Set the outline regular expression to match Forth comments of the form \ @,
and activate outline-minor-mode."
(make-local-variable 'outline-regexp)
(setq outline-regexp "^[ \t]*\\\\ @+")
(setq outline-level 'outline-level)
(outline-minor-mode 1)
(if forth-auto-outline-p (local-outline-collapse-all-bodies))
)
(defun find-long-line ()
"Search forward for the next line longer than 80 cols.
If none, leave point unchanged."
(interactive)
;;
;; Search forward until we are at end of file, or
;; we find a line longer than 80 cols
;;
(let ((bad-pos
(save-excursion
;;
;; If we are at end-of-line already, go forward one first
;;
(if (= (point) (save-excursion (end-of-line) (point)))
(forward-line 1))
(while (and (< (current-column) 80)
(< (point) (point-max)))
(forward-line 1)
(end-of-line))
(if (>= (current-column) 80)
(point))))
)
(if bad-pos
(progn
(goto-char bad-pos)
(message "Line %d has %d columns" (count-lines 1 (point))
(current-column))
t)
;;else
(message "No lines >80 chars after point")
nil)
))
;;
;; Set up the keys to use enhanced comments and outline mode.
;;
(defun local-forth-set-keys ()
"Set keys for moving between outline headers, for adding structured
comments, and for collapsing and expanding headers"
(local-set-key "\eP" 'outline-backward-same-level)
(local-set-key "\eN" 'outline-forward-same-level)
(local-set-key "\eB" 'outline-previous-visible-heading)
(local-set-key "\eF" 'outline-next-visible-heading)
(local-set-key "\e;" 'local-forth-insert-block-comment)
(local-set-key "\e'" 'local-forth-insert-comment-hrule)
(local-set-key "\eo" 'local-outline-collapse-all-bodies)
(local-set-key "\eO" 'show-all)
(local-set-key "\e*" 'find-long-line)
(local-set-key [C-tab] 'tab-to-tab-stop)
)
(defvar forth-comment-end-column 78
"This variable controls to which column the ends of comments will be padded"
)
(defun local-forth-insert-block-comment(&optional level headerstring)
"Inserts a comment of the form
\
\ <point ends up here>
\
The comment will be indented at the same level as the surrounding code.
With optional numeric argument add 'level' @ characters after first '\ '"
(interactive "P")
(let*
((outlvl (or level 0))
(hdr
(if (not level)
""
(or headerstring
(read-from-minibuffer "Heading: " ""
nil nil
'(local-forth-hrule-hdr-hist . 1) ))))
) ;;end let bindings
(beginning-of-line) (open-line 3)
(forth-indent-command)
(insert "\\ ")
(insert-char ?@ outlvl) (insert " ") (insert hdr)
(forward-line 1)
(insert "\\ ")
(forth-indent-command)
(forward-line 1)
(insert "\\ ")
(forth-indent-command)
(forward-line -1)
);end let
(end-of-line)
)
(defvar local-forth-hrule-hdr-hist nil
"History for Forth outline header strings")
(defvar local-forth-hrule-lvl-hist nil
"History for Forth outline header levels")
(defun local-forth-insert-comment-hrule (&optional level headerstring)
"Insert a comment of the form \\ @@@*** STRING ***
Prefix argument gives number of @'s, -ve prefix argument replaces
'*' with '-'."
(interactive "p")
(let
((outlvl
(or level
(string-to-int
(read-from-minibuffer
"Outline level: "
(int-to-string level)
nil nil '(local-forth-hrule-lvl-hist . 0) ))))
(hdr
(or headerstring
(read-from-minibuffer
"Heading: " ""
nil nil
'(local-forth-hrule-hdr-hist . 0) )))
(startcol (progn
(beginning-of-line) (open-line 1)
(forth-indent-command) (current-column)))
)
(progn
(let ((fillchar (if (> outlvl 0) ?* ?- ))
(fillnum (- forth-comment-end-column
(+ 4 (length hdr) startcol)))
);end let bindings
(progn
(insert "\\ ")
(insert-char ?@ (abs outlvl))
(insert-char fillchar (- (/ fillnum 2) (abs outlvl)))
(insert " " hdr " ")
(insert-char fillchar (if (= (mod fillnum 2) 0)
(/ fillnum 2)
(/ (+ fillnum 1) 2) )
)
(forward-line 1)
(beginning-of-line)
)
); end let fillchar
); end progn
) ;end let outlvl
) ;end defun local-forth-insert-comment-hrule
(defun local-forth-make-hrule-line (&optional hlvl)
"Cut the current line, and insert a c-comment-hrule with the level as given
and a text-field of whatever was the current line. Default level is 1.
This is used as part of the auto-insert-tkld package which provides
templates for creating new buffers of various types. My boilerplate forth
buffer template contains commands to create a hrule with the name of the file.
"
(let* ( (begin (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point)))
(hlevel (or hlvl 1))
(hstring (buffer-substring begin end))
)
(delete-region begin end)
(local-forth-insert-comment-hrule hlevel hstring)
))
;;
;;@*************************** Forth mode hooks ****************************
(defvar forth-auto-outline-p nil
"Set this to t if you want a forth file automatically collapsed to an
outline when it is opened")
(defun local-forth-config ()
"Set up variables and other stuff common to all forth-mode buffers"
; default forth-program-name is gforth.
;(setq forth-program-name "pfe") ; run pfe as forth environment (messy!)
(add-hook 'forth-mode-hook 'local-forth-mode-config t))
(defun local-forth-mode-config ()
"Set up variables and other stuff for forth mode "
(setq fill-column 80)
(setq forth-indent-level 2)
(setq tab-width 2)
(setq tab-stop-list '(2 4 6 8 10 12 14 16 24 32 40 48 56 64 72))
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(forth-font-lock-keywords t nil nil nil))
(turn-on-font-lock)
(local-forth-set-keys)
(local-forth-outline-mode)
)
(unless (rassoc 'forth-mode auto-mode-alist)
(push (cons "\\.f$" 'forth-mode) auto-mode-alist)
(push (cons "\\.fth$" 'forth-mode) auto-mode-alist)
(push (cons "\\.seq$" 'forth-mode) auto-mode-alist)
(push (cons "\\.f83$" 'forth-mode) auto-mode-alist))
(autoload 'forth-mode "forth" "Mode for editing FORTH files" t)
(eval-after-load "forth" (local-forth-config))
;;; local-forth.el ends here
