;;; package --- Summary
;; newlisp.el --- An Emacs mode for newlisp
;; this file is not a part of gnu Emacs or Xemacs
;; Author: Tim johnson <
tim@johnsons-web.com> (TJ)
;;
;;; License:
;; Copyright (C) 2006 Tim Johnson
;; 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 of
;; the License, 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 program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA
;;; History:
;; Originally a shameless hack of quack.el. Now a properly derived major
;; mode. V 0.002
;;
;;; Commentary:
;; Thanks to Stefan Monnier <
monnier@iro.umontreal.ca> (SM)
;; Thanks also to: johan bockgård <
bojohan+news@dd.chalmers.se> (JB)
;;
;;; Related links and files
;;
http://www.johnsons-web.com/demo/emacs/ ... e/dmode.el
;; Mode template to "roll your own programming mode"
;;
;; 'Emacs' is meant to refer to *either* GNU Emacs *or* to the Xemacs fork
;;
;; About 'help-command': The standard Emacs installation maps control-h to the
;; 'help-command' prefix. Sometimes control-h is mapped to backward-delete.
;; if you have done so, then where 'c-h' is used in this file, substitute
;; the appropriate prefix (such as F1)
;;
;;; Quickstart:
;; control-c control-h
;;; Code:
;; ===========================================================================================
(require 'scheme) ;; Enherit Scheme mode
(require 'tj-parenface) ;; Highlight parens and brackets
(require 'nl-docs) ;; oneline docs
(require 'nl-docstrings) ;; multi-line docs
;; ===========================================================================================
(defvar newlisp-function-begin-regexp "(\\(?:def\\(?:ine\\|un\\)\\|fn\\)"
"Used to find function definitions. NOTE: No whitespace after parens!")
;; ===========================================================================================
;; 'helper' functions
;; ===========================================================================================
(defun safe-kill-buff (n)
"kill a buffer, don't worry whether it exists."
(interactive)
(condition-case nil
(kill-buffer n)
(error nil) ) )
;; ===========================================================================================
(defun newlisp-replace-newlines (S)
"Replace newlines in string 'S' with spaces.
Use for sendbing code to newlisp."
(mapconcat (lambda (x) x) (split-string S "\n") " "))
;; ===========================================================================================
(defvar newlisp-function-names '("define" "defun" "fn")
"Names of Newlisp function definitions")
;; ===========================================================================================
(defun newlisp-at-function-startp ()
"Is cursor at the beginning of a function?"
(interactive)
(cond ((string-equal (char-to-string (char-after)) "(") ;; cursor on '('
(forward-char 1)
(cond ((member (current-word) newlisp-function-names)
(backward-char 1) ;; found. Reset
(message "found")
t)
(t ;; not found. Reset
(message "not found")
(backward-char 1) nil)))
(t nil)))
;; ===========================================================================================
(put 'fn 'scheme-indent-function 1) ;; treat fn as a function
;; ===========================================================================================
;; Create some faces for special fontification.
;; NOTE: XEmacs seems to ignore the (background light) form.
;; IOWS: You may need to use customize to set a readable color if using light background
;; ===========================================================================================
(defface newlisp-font-lock-keywords-face
'((((class color) (background light)) (:foreground "green4"))
(((class color) (background dark)) (:foreground "yellow"))
(((class grayscale) (background light)) (:foreground "dimgray" :italic t))
(((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
(t (:bold t)))
"Font lock mode face used to highlight a syntax group for newlisp mode."
:group 'font-lock-faces)
(defvar newlisp-font-lock-keywords-face 'newlisp-font-lock-keywords-face)
;; ===========================================================================================
(defface newlisp-font-lock-function-names-face
'((((class color) (background light)) (:foreground "darkcyan"))
(((class color) (background dark)) (:foreground "cyan"))
(((class grayscale) (background light)) (:foreground "dimgray" :italic t))
(((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
(t (:bold t)))
"Font lock mode face used to highlight functions (defun, define, fn) for newlisp mode."
:group 'font-lock-faces)
(defvar newlisp-font-lock-function-names-face 'newlisp-font-lock-function-names-face)
;; ===========================================================================================
(defface newlisp-font-lock-user-keywords-face
'((((class color) (background light)) (:foreground "red4"))
(((class color) (background dark)) (:foreground "yellow3"))
(((class grayscale) (background light)) (:foreground "dimgray" :italic t))
(((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
(t (:bold t)))
"Font lock mode face used to highlight user-defined keywords for newlisp mode."
:group 'font-lock-faces)
(defvar newlisp-font-lock-user-keywords-face 'newlisp-font-lock-user-keywords-face)
;; ===========================================================================================
(defface newlisp-font-lock-quote-face
'((((class color) (background light)) (:foreground "purple"))
(((class color) (background dark)) (:foreground "magenta"))
(((class grayscale) (background light)) (:foreground "dimgray" :italic t))
(((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
(t (:bold t)))
"Font lock mode face used to highlight quoted symbols in newlisp mode."
:group 'font-lock-faces)
(defvar newlisp-font-lock-quote-face 'newlisp-font-lock-quote-face)
;; ==========================================================================
(defconst
newlisp-function-names-regexp
(regexp-opt '("define" "defun" "fn")))
;; ==========================================================================
(defconst
newlisp-keywords-regexp
(regexp-opt '( ;; c-h f regexp-opt <ret>
"!" "$" "+" "-" "*" "/" "%" "<" ">" "=" "<=" ">=" "!=" "<<" ">>" "&" "|" "^^" "~"
"abs" "acos" "add" "address" "amb" "and" "append" "append-file" "apply" "args" "array"
"array-list" "array?" "asin" "assoc" "atan" "atan2" "atom?" "base64-dec" "base64-enc"
"bayes-query" "bayes-train" "begin" "beta" "betai" "binomial" "case" "catch" "ceil"
"change-dir" "char" "chop" "close" "command-line" "cond" "cons" "constant" "context"
"context?" "copy-file" "cos" "count" "cpymem" "crc32" "crit-chi2" "crit-z" "current-line"
"date" "date-value" "debug" "dec" "define-macro" "def-new" "delete" "delete-file"
"device" "difference" "directory" "directory?" "div" "dolist" "dotimes" "dotree"
"do-until" "do-while" "dump" "dup" "empty?" "encrypt" "ends-with" "env" "erf" "error-event"
"error-number" "error-text" "eval" "eval-string" "exec" "exit" "exp" "expand" "explode"
"factor" "fft" "file-info" "file?" "filter" "find" "first" "flat" "float" "float?"
"floor" "flt" "for" "fork" "format" "fv" "gammai" "gammaln" "get-char" "get-float"
"get-int" "get-string" "get-url" "global" "if" "ifft" "import" "inc" "index" "int"
"integer?" "intersect" "invert" "irr" "join" "lambda?" "last" "legal?" "length" "let"
"letn" "list" "list?" "load" "log" "lookup" "lower-case" "macro?" "main-args" "make-dir"
"map" "match" "max" "member" "min" "mod" "mul" "multiply" "name" "NaN?" "net-accept"
"net-close" "net-connect" "net-error" "net-eval" "net-listen" "net-local" "net-lookup"
"net-peek" "net-peer" "net-ping" "net-receive" "net-receive-from" "net-receive-udp"
"net-select" "net-send" "net-send-to" "net-send-udp" "net-service" "net-sessions"
"new" "nil?" "not" "normal" "now" "nper" "npv" "nth" "nth-set" "number?" "open" "or"
"pack" "parse" "peek" "pipe" "pmt" "pop" "post-url" "pow" "pretty-print" "primitive?"
"print" "println" "prob-chi2" "prob-z" "process" "push" "put-url" "pv" "quote" "quote?"
"rand" "random" "randomize" "read-buffer" "read-char" "read-file" "read-key" "read-line"
"ref" "regex" "remove-dir" "rename-file" "replace" "replace-assoc" "reset" "rest"
"reverse" "rotate" "save" "search" "seed" "seek" "select" "semaphore" "sequence"
"series" "set" "setq" "set!" "set-locale" "set-nth" "sgn" "share" "signal" "silent"
"sin" "sleep" "slice" "sort" "source" "sqrt" "starts-with" "string" "string?" "sub"
"swap" "sym" "symbol?" "symbols" "sys-error" "sys-info" "tan" "throw" "throw-error"
"time" "time-of-day" "timer" "title-case" "trace" "trace-highlight" "transpose" "trim"
"true?" "unicode" "unique" "unless" "unpack" "until" "upper-case" "utf8" "wait-pid"
"while" "write-buffer" "write-char" "write-file" "write-line" "xml-error" "xml-parse"
)))
;; ==========================================================================
(defconst
newlisp-user-keywords-regexp
(regexp-opt '( ;; c-h f regexp-opt <ret>
;; for your own libraries
"sqlite" ;; test
)))
;; ==========================================================================
(defun newlisp-sexp-start ()
"Move point to nearest opening parens"
(interactive)
(re-search-backward "("))
;; ==========================================================================
(defun newlisp-sexp-end()
"Move point to nearest closing parens"
(interactive)
(re-search-forward ")"))
;; ==========================================================================
;; Inferior process functions and constants
;; ==========================================================================
(defun newlisp-select-sexp ()
"Select the innermost sexp (closest to cursor)"
(interactive)
(re-search-backward "(")
(set-mark (point))
(forward-sexp))
;; ==========================================================================
(defun newlisp-select-function ()
"Select enclosing function OR
previous function if cursor not inside of a function sexp.
Cursor moved to end of function."
(interactive)
(let ((found nil))
(cond ((newlisp-at-function-startp)
(setq found t))
((newlisp-previous-functionp)
(setq found t)))
(cond (found
(set-mark (point))
(forward-sexp))
(t (message "No enclosing or previous function to select")))))
;; ==========================================================================
(defun newlisp-evaluate-function ()
"Evaluate the enclosing (or previous) function"
(interactive)
(save-excursion
(let ((found nil))
(cond ((newlisp-at-function-startp)
(setq found t))
((newlisp-previous-functionp)
(setq found t)))
(cond (found
(forward-sexp)
(newlisp-evaluate-last-sexp))
(t (message
"No enclosing or previous function to select for evaluation"))))))
;; ==========================================================================
;; ==========================================================================
(defun newlisp-quote-comments (str)
(setq idx 0)
(while (setq idx (string-match ";" str idx))
(store-substring str idx ?{)
(setq idx (string-match "\n" str idx))
(store-substring str idx ?}))
str
)
;; ==========================================================================
(defun newlisp-surround-cmds (str)
(concat "\n[cmd]\n" str "\n[/cmd]\n"))
;; ==========================================================================
(defun newlisp-evaluate-region (beg end)
"Send the current region to the inferior newlisp process, removing newlines."
(interactive "r")
(setq str (newlisp-surround-cmds (buffer-substring-no-properties beg end)))
(process-send-string
newlisp-process-name str))
;; ==========================================================================
(defun newlisp-evaluate-region-old (beg end)
"Send the current region to the inferior newlisp process, removing newlines."
(interactive "r")
(setq str (concat (newlisp-replace-newlines (newlisp-quote-comments
(buffer-substring-no-properties beg end))) "\n"))
(process-send-string
newlisp-process-name str))
;; ==========================================================================
(defun newlisp-evaluate-buffer()
"Tells the inferior process to load the current buffer.
Uses the newlisp 'load command."
(interactive)
(setq file-name (buffer-file-name))
(if (equal system-type 'ms-dos)
(let ((i (length file-name)))
(while (>= (setq i (1- i)) 0)
(if (eq (aref file-name i) ?\\) (aset file-name i ?/)))))
(process-send-string
newlisp-process-name
(concat "(load {" file-name "})\n")))
;; ==========================================================================
(defun newlisp-evaluate-last-sexp()
"Send the previous sexp to the inferior Scheme process.
Newlines removed."
(interactive)
(newlisp-evaluate-region (save-excursion (backward-sexp) (point)) (point)))
;; =====================================================================================
;; Top-level Values
;; =====================================================================================
(defvar newlisp-binary-name "newlisp" "Process executable")
;; =====================================================================================
(defconst newlisp-process-name "newlisp" "Newlisp Process Name")
;; =====================================================================================
(defconst newlisp-function-regexp
(regexp-opt '("define" "defun" "fn"))
"Newlisp function names")
;; =====================================================================================
(defcustom newlisp-doc-buffer "*newlisp-doc-buffer*"
"Unique buffer name for newlisp docs"
:type 'string
:group 'newlisp)
;; ===========================================================================
(defcustom newlisp-docstring-prefix "new*lisp-"
"Prefix for dummy defuns holding docstrings. Avoid 'newlisp' to avoid
overloading 'appropos results."
:type 'string
:group 'quack)
;; ==========================================================================
(defvar newlisp-help-buffers
`("*Help*" ,newlisp-doc-buffer)
"Can hold any buffer that can get in the way. newlisp-kill-help-buffers
uses this for cleanup.")
;; ==========================================================================
(defcustom newlisp-comment-prefix ";"
"*String used by \\[comment-region] to comment out a block of code."
:type 'string
:group 'newlisp)
;; ==========================================================================
(defun newlisp-font-lock-fontify-buffer ()
"Just a wrapper for font-lock-fontify-buffer. Use liberally to refontify
multi-line strings. HINT: put cursor outside of string when using."
(interactive)
(font-lock-fontify-buffer))
;; ==========================================================================
(defun newlisp-previous-functionp ()
"Look for the preceding function definition.
Move there and return t if found.
Reset to starting point and return nil if not found."
(interactive)
(let (res (start (point)))
(setq res
(re-search-backward
newlisp-function-begin-regexp nil 'move))
(cond
(res
(if (newlisp-at-function-startp)
(setq res t)
(goto-char start)
(setq res nil)))
(t
(goto-char start)
(setq res nil)))
res)
)
;; ==========================================================================
(defun newlisp-next-functionp ()
"Look for next function definition.
Move there and return t if found.
Reset to starting point and return nil if not found."
(interactive)
(let (res (start (point)))
(setq res
(re-search-forward newlisp-function-begin-regexp nil 'move))
(cond
(res
(re-search-backward "(")
(if (newlisp-at-function-startp)
(setq res t)
(goto-char start)
(setq res nil)))
(t (goto-char start) ;; go back to where we started
(setq res nil)))
res))
;; ==========================================================================
(defun newlisp-previous-function()
"Moves point backwards to the beginning of the nearest function definition"
(interactive)
(let (res)
(setq res (newlisp-previous-functionp))
(if (not res)
(message "No previous function"))))
;; ==========================================================================
(defun newlisp-next-function()
"Moves point backwards to the beginning of the nearest function definition"
(interactive)
(let (res)
(setq res (newlisp-next-functionp))
(if (not res)
(message "No function found while searching forward."))))
;; ==========================================================================
(defun newlisp-comment-region (beg end &optional arg)
"Like comment out the region."
(interactive "r\nP")
(let ((comment-start newlisp-comment-prefix))
(comment-region beg end arg)))
;; ==========================================================================
(defun newlisp-uncomment-region (beg end &optional arg)
"Uncomment region."
(interactive "r\nP")
(let ((comment-start newlisp-comment-prefix))
(comment-region beg end -1)))
;; ===============================================================================================
;; Inferior process
;; ===============================================================================================
(defun newlisp-show-interpreter()
"Start and/or show interpreter in other window.
Cursor stays at point."
(interactive)
(switch-to-buffer-other-window
(make-comint newlisp-process-name newlisp-binary-name ))
(other-window -1))
;; ===============================================================================================
(defun newlisp-visit-interpreter()
"Start and/or show interpreter in other window.
Then, put cursor in other window."
(interactive)
(switch-to-buffer-other-window
(make-comint newlisp-process-name newlisp-binary-name)))
;; ===========================================================================
;; Documentation
;; ===========================================================================
(defun newlisp-kill-help-buffers ()
"Kill unwanted help and documentation buffers"
(interactive)
(let ((buff-list newlisp-help-buffers))
(while buff-list
(safe-kill-buff (car buff-list))
(setq buff-list (cdr buff-list)))))
;; ===========================================================================
(defun newlisp-kill-doc-buffer ()
"Kill the newlisp documentation buffer. If exists."
(interactive)
(safe-kill-buff newlisp-doc-buffer))
;; ===========================================================================
(defun newlisp-show-doc-oneliner ()
"Show one-line doc for newlisp symbol in minibuffer"
(interactive "*")
(let ((kwd (current-word)) res msg)
(setq res (assoc (intern kwd) newlisp-short-docs))
(cond
(res
(setq msg (concat kwd ": " (cdr res))))
(t
(setq msg (concat "** NO MATCH FOR KEYWORD \"" kwd "\" **"))))
(message msg)))
;; ===========================================================================
(defun newlisp-doc-keyword ()
"Get newlisp keyword documentation"
(interactive "*")
(let(kwd func-name doc-result doc-string)
(setq kwd (current-word))
(if (string-equal kwd "") ;; no keyword found
(progn
(message "NO KEYWORD SELECTED. Place cursor on a word.")
(setq doc-string nil))
(progn ;; check for existence of doc-string
(setq func-name (intern (concat newlisp-docstring-prefix kwd)))
(setq doc-result
(condition-case nil
(documentation func-name)
(error nil)))
(if doc-result ;; docstring returned. Prepare it by prepending a header
(setq doc-string (concat kwd "\n=========================\n" doc-result))
(message (concat "** NO DOCUMENTATION FOR: " kwd " **"))
(setq doc-string nil)))))) ;; return a nil value
;; =====================================================================================
(defun newlisp-show-doc-message-box ()
"get newlisp documentation and display in message box"
(interactive "*")
(let (result)
(setq result (newlisp-doc-keyword))
(if (stringp result)
(message-box result))))
;; =====================================================================================
(defun newlisp-show-doc-buffer ()
"get newlisp documentation and display in buffer"
(interactive)
(newlisp-make-doc-buffer (newlisp-doc-keyword)))
;; =====================================================================================
(defun newlisp-make-doc-buffer (text)
"Generate newlisp documentation buffer"
(interactive "*p")
(newlisp-kill-doc-buffer)
(if (stringp text)
(let (prev-buffer)
(setq prev-buffer (buffer-name))
(switch-to-buffer-other-window newlisp-doc-buffer)
(insert "DOCUMENTATION FOR KEYWORD: ")
(insert text)
(beginning-of-buffer)
(toggle-read-only)
(switch-to-buffer-other-window prev-buffer))))
;; ==========================================================================
(defun newlisp-indent-line ()
"Set a line to proper lisp-style indentation.
Sometimes this means that a line may be `out'dented."
(interactive) (lisp-indent-line))
;; ==========================================================================
(defun newlisp-indent-sexp()
"Set a sexp to proper lisp-style indentation.
Sometimes this means that a sexp may be `out'dented."
(interactive) (indent-sexp))
;; ==========================================================================
(defun newlisp-nudge-region ()
"Indent region by space"
(interactive "r\nP")
(indent-rigidly beg end 1)
(exchange-point-and-mark))
;; =====================================================================
(defun newlisp-tab-region (beg end &optional arg)
"Indent a region by a tab."
(interactive "r\nP")
(indent-rigidly beg end tab-width)
(exchange-point-and-mark))
;; ==========================================================================
(defvar newlisp-font-lock-keywords
`(,@scheme-font-lock-keywords ;; note: backquote and splice operator!
;; add new keywords for highlighting in our sample face
(,(concat "\\<\\(" newlisp-keywords-regexp "\\)\\>") ;; builtin keywords + word boundaries
0 newlisp-font-lock-keywords-face t)
(,(concat "\\<\\(" newlisp-user-keywords-regexp "\\)\\>") ;; user keywords + word boundaries
0 newlisp-font-lock-user-keywords-face)
(,(concat "\\<\\(" newlisp-function-names-regexp "\\)\\>") ;; function keywords + word boundaries
0 newlisp-font-lock-function-names-face t)
;; Multi-line string highlighting. HINT: use ctrl-c f to refontify
;; NOTE: emacs does not handle multi-line string well in this manner.
;; (JB) suggests looking at how perl and AUCTex handle this.
("[^#]\\({[^{}]*}\\)" 0 'font-lock-string-face) ;; braces, {}
("[^#]\\(\\[text\\][^{}]*\\[/text\\]\\)" 0 'font-lock-string-face t) ;; [text] [/text]
("'[A-Za-z0-9\-_*0-9]*" 0 'newlisp-font-lock-quote-face)
("\\(^\\|[^\$\\\]\\)#.*" 0 'font-lock-comment-face t) ;; ## comments
("\\(^\\|[^\$\\\]\\);.*" 0 'font-lock-comment-face t) ;; `;;' comments
)
"List of newlisp keywords and faces.")
;; ==========================================================================
;; Construct a keymap for the mode.
;; ==========================================================================
(defvar newlisp-mode-map
(let ((map (make-sparse-keymap))) ;; c-h make-sparse-keymap <RET>
;; Here we may define any number of key sequences for our mode
;; c-h define-key <RET>
(define-key map [(control c) (control b) (s)] 'newlisp-show-interpreter)
(define-key map [(control c) (control b) (v)] 'newlisp-visit-interpreter)
; --------------------------------------------------------------
(define-key map [(control c) (control e) (b)] 'newlisp-evaluate-buffer)
(define-key map [(control c) (control e) (l)] 'newlisp-evaluate-last-sexp)
(define-key map [(control c) (control e) (r)] 'newlisp-evaluate-region)
(define-key map [(control c) (control e) (s)] 'newlisp-evaluate-function)
; --------------------------------------------------------------
(define-key map [(control c) (control d) (b)] 'newlisp-show-doc-buffer)
(define-key map [(control c) (control d) (k)] 'newlisp-kill-help-buffers)
(define-key map [(control c) (control d) (m)] 'newlisp-show-doc-message-box)
(define-key map [(control c) (control d) (o)] 'newlisp-show-doc-oneliner)
; --------------------------------------------------------------
(define-key map [(control c) (control i) (n)] 'newlisp-nudge-region)
(define-key map [(control c) (control i) (t)] 'newlisp-tab-region)
(define-key map [(control c) (control i) (l)] 'newlisp-indent-line)
(define-key map [(control c) (control i) (x)] 'newlisp-indent-sexp)
; --------------------------------------------------------------
(define-key map [(control c) (control n)] 'newlisp-next-function)
(define-key map [(control c) (control p)] 'newlisp-previous-function)
(define-key map [(control c) (?\[)] 'newlisp-sexp-start)
(define-key map [(control c) (?\])] 'newlisp-sexp-end)
(define-key map [(control c) (control ?\[)] 'forward-sexp) ;; note: menu and help view will show C-c ESC
(define-key map [(control c) (control ?\])] 'backward-sexp)
; --------------------------------------------------------------
(define-key map [(control c) (control s) (x)] 'newlisp-select-sexp)
(define-key map [(control c) (control s) (s)] 'newlisp-select-function)
(define-key map [(control c) (control c) (c)] 'newlisp-comment-region)
(define-key map [(control c) (control c) (u)] 'newlisp-uncomment-region)
(define-key map [(control c) (control f)] 'newlisp-font-lock-fontify-buffer)
map)
"Keymap for `newlisp-mode'.")
;; ==========================================================================
;; Define the menu using 'easy-menu-define for
;; best compatibility for both forks.
;; ==========================================================================
(easy-menu-define ;; c-h f easy-menu-define <RET>
newlisp-menu newlisp-mode-map "Newlisp Mode Menu"
'("Newlisp"
["Show Interpreter" newlisp-show-interpreter]
["Visit Interpreter" newlisp-visit-interpreter]
["Load File" newlisp-evaluate-buffer]
["Evaluate Region" newlisp-evaluate-region]
["Evaluate Sexp" newlisp-evaluate-last-sexp]
["Evaluate function" newlisp-evaluate-function]
"-" ;; seperator
("Text Operations" ;; submenu
["Indent Region by TAB" newlisp-tab-region]
["Indent Region by SPACE" newlisp-nudge-region]
["Indentation for Line" newlisp-indent-line]
["Indent Sexp" newlisp-indent-sexp]
)
"-" ;; seperator
["Help Buffer" newlisp-show-doc-buffer]
["Help Oneliner" newlisp-show-doc-oneliner]
["Help Popup" newlisp-show-doc-message-box]
["Kill Help Buffer" newlisp-kill-help-buffers]
"-" ;; seperator
["Next function" newlisp-next-function]
["Previous function" newlisp-previous-function]
["Nearest Start of Sexp" newlisp-sexp-start]
["Nearest End of Sexp" newlisp-sexp-end]
["Forward Sexp" forward-sexp]
["Backward Sexp" backward-sexp]
"-" ;; seperator
["Select function" newlisp-select-function]
["Select Sexp" newlisp-select-sexp]
["Comment Out Region" newlisp-comment-region]
["Uncomment Region" newlisp-uncomment-region]
["Fontify Buffer" newlisp-font-lock-fontify-buffer]
))
;; ==========================================================================
;;(lambda ()
;; (set (make-local-variable font-lock-comment-face) ugly-face))
(define-derived-mode newlisp-mode scheme-mode "newlisp"
"A major mode for Newlisp."
(easy-menu-add newlisp-menu) ;; install main menu
(imenu-add-menubar-index) ;; install imenu with title "Index"
(setq imenu-sort-function 'imenu--sort-by-name) ;; alternatively: 'imenu--sort-by-position
(setq auto-rescan t) ;; tell imenu to rescan every time it is used
;; Highly Recommended: c-h v font-lock-keywords <RET>
(set (make-local-variable 'font-lock-defaults)
(cons 'newlisp-font-lock-keywords
(or (cdr font-lock-defaults)
'(nil t ;; syntax table modifications follow: You may wish to use
;; For help: C-h f modify-syntax-entry <RET>
;; Bind non-alpha characters to the 'word' syntax class
((?+ . "w") (?- . "w") (?* . "w") (?/ . "w")
(?. . "w") (?< . "w") (?> . "w") (?= . "w")
(?? . "w") (?$ . "w") (?% . "w") (?_ . "w")
(?& . "w") (?~ . "w") (?^ . "w") (?: . "w"))))))
;; NOTE: Emacs accepts a more compact approach.
;; The cons-cell list approach used here is for XEmacs compatibility.
(define-key scheme-mode-map [menu-bar scheme] nil) ;; drop the scheme menu
)
;;; newlisp.el ends here