| (if (not (boundp 'emacs-major-version)) |
(if (not (boundp 'emacs-major-version)) |
| (defconst emacs-major-version |
(defconst emacs-major-version |
| (progn (string-match "^[0-9]+" emacs-version) |
(progn (string-match "^[0-9]+" emacs-version) |
| (string-to-int (match-string 0 emacs-version))))) |
(string-to-number (match-string 0 emacs-version))))) |
| |
|
| ;; Code ripped from `subr.el' for compatability with Emacs versions |
;; Code ripped from `subr.el' for compatability with Emacs versions |
| ;; prior to 20.1 |
;; prior to 20.1 |
| ;; in Lisp?? |
;; in Lisp?? |
| (defun forth-filter (predicate list) |
(defun forth-filter (predicate list) |
| (let ((filtered nil)) |
(let ((filtered nil)) |
| (mapcar (lambda (item) |
(dolist (item list) |
| (when (funcall predicate item) |
(when (funcall predicate item) |
| (if filtered |
(if filtered |
| (nconc filtered (list item)) |
(nconc filtered (list item)) |
| (setq filtered (cons item nil)))) |
(setq filtered (cons item nil))))) |
| nil) list) |
|
| filtered)) |
filtered)) |
| |
|
| ;; Helper function for `forth-compile-word': return whether word has to be |
;; Helper function for `forth-compile-word': return whether word has to be |
| (regexp |
(regexp |
| (concat "\\(" (cond ((stringp matcher) matcher) |
(concat "\\(" (cond ((stringp matcher) matcher) |
| ((listp matcher) (regexp-opt matcher)) |
((listp matcher) (regexp-opt matcher)) |
| (t (error "Invalid matcher `%s'"))) |
(t (error "Invalid matcher"))) |
| "\\)")) |
"\\)")) |
| (depth (regexp-opt-depth regexp)) |
(depth (regexp-opt-depth regexp)) |
| (description (cdr word))) |
(description (cdr word))) |
| (eval-when-compile |
(eval-when-compile |
| (defmacro forth-save-buffer-state (varlist &rest body) |
(defmacro forth-save-buffer-state (varlist &rest body) |
| "Bind variables according to VARLIST and eval BODY restoring buffer state." |
"Bind variables according to VARLIST and eval BODY restoring buffer state." |
| (` (let* ((,@ (append varlist |
`(let* (,@(append varlist |
| '((modified (buffer-modified-p)) (buffer-undo-list t) |
'((modified (buffer-modified-p)) (buffer-undo-list t) |
| (inhibit-read-only t) (inhibit-point-motion-hooks t) |
(inhibit-read-only t) (inhibit-point-motion-hooks t) |
| before-change-functions after-change-functions |
before-change-functions after-change-functions |
| deactivate-mark buffer-file-name buffer-file-truename)))) |
deactivate-mark buffer-file-name buffer-file-truename))) |
| (,@ body) |
,@body |
| (when (and (not modified) (buffer-modified-p)) |
(when (and (not modified) (buffer-modified-p)) |
| (set-buffer-modified-p nil)))))) |
(set-buffer-modified-p nil))))) |
| |
|
| ;; Function that is added to the `change-functions' hook. Calls |
;; Function that is added to the `change-functions' hook. Calls |
| ;; `forth-update-properties' and keeps care of disabling undo information |
;; `forth-update-properties' and keeps care of disabling undo information |
| (progn |
(progn |
| (delete-other-windows) |
(delete-other-windows) |
| (split-window-vertically |
(split-window-vertically |
| (/ (* (screen-height) forth-percent-height) 100)) |
(/ (frame-height) 2)) |
| (other-window 1) |
(other-window 1) |
| (switch-to-buffer buffer) |
(switch-to-buffer buffer) |
| (goto-char (point-max)) |
(goto-char (point-max)) |
| (other-window 1)))) |
(other-window 1)))) |
| |
|
| (defun forth-compile (command) |
|
| (interactive (list (setq forth-compile-command (read-string "Compile command: " forth-compile-command)))) |
|
| (forth-split-1 "*compilation*") |
|
| (setq ctools-compile-command command) |
|
| (compile1 ctools-compile-command "No more errors")) |
|
| |
|
| ;;; Forth menu |
;;; Forth menu |
| ;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
;;; Mikael Karlsson <qramika@eras70.ericsson.se> |
| |
|
| (forth-end-of-paragraph) |
(forth-end-of-paragraph) |
| (skip-chars-backward "\t\n ") |
(skip-chars-backward "\t\n ") |
| (setq end (point)) |
(setq end (point)) |
| (if (re-search-backward "\n[ \t]*\n" nil t) |
(if (null (re-search-backward "\n[ \t]*\n" nil t)) |
| (setq start (point)) |
|
| (goto-char (point-min))) |
(goto-char (point-min))) |
| (skip-chars-forward "\t\n ") |
(skip-chars-forward "\t\n ") |
| (forth-send-region (point) end)))) |
(forth-send-region (point) end)))) |
| (push-mark) |
(push-mark) |
| (goto-char (point-max))))) |
(goto-char (point-max))))) |
| |
|
| (defun forth-send-region-and-go (start end) |
(defun forth-send-region-and-go (my-start end) |
| "Send the current region to the inferior Forth process. |
"Send the current region to the inferior Forth process. |
| Then switch to the process buffer." |
Then switch to the process buffer." |
| (interactive "r") |
(interactive "r") |
| (forth-send-region start end) |
(forth-send-region my-start end) |
| (forth-switch-to-interactive t)) |
(forth-switch-to-interactive t)) |
| |
|
| (defcustom forth-source-modes '(forth-mode forth-block-mode) |
(defcustom forth-source-modes '(forth-mode forth-block-mode) |
