branch: elpa/forth-mode
commit 93756ec224a0fc341d6436f5c63bf904d4da68a2
Author: Lars Brinkhoff <[email protected]>
Commit: Lars Brinkhoff <[email protected]>
Some basic and flawed support for block files.
---
TMP | 1 +
block.fth | 1 +
forth-block-mode.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
forth-mode.el | 4 +++
4 files changed, 94 insertions(+), 1 deletion(-)
diff --git a/TMP b/TMP
new file mode 100644
index 0000000000..009ec3a0bb
--- /dev/null
+++ b/TMP
@@ -0,0 +1 @@
+( Screen #1 -------------------------------------------------- \
\ Line 2
\
\
\ \
\
[...]
\ No newline at end of file
diff --git a/block.fth b/block.fth
new file mode 100644
index 0000000000..5d68241302
--- /dev/null
+++ b/block.fth
@@ -0,0 +1 @@
+( Screen #1 -------------------------------------------------- )\
\ Line 2
\
\
\ \
\
[...]
\ No newline at end of file
diff --git a/forth-block-mode.el b/forth-block-mode.el
index 5edbbf0524..0e4a857be1 100644
--- a/forth-block-mode.el
+++ b/forth-block-mode.el
@@ -1,3 +1,90 @@
+(defun forth-block-p ()
+ "Guess whether the current buffer is a Forth block file."
+ (message (format "%s %s" (point-max) (logand (point-max) 1023)))
+ (and (eq (logand (point-max) 1023) 1)
+ (save-excursion
+ (beginning-of-buffer)
+ (not (search-forward "\n" 1024 t)))))
+
+(defun forth-unblockify ()
+ (let ((after-change-functions nil))
+ (save-excursion
+ (beginning-of-buffer)
+ (while (ignore-errors (forward-char 64) t)
+ (insert ?\n))
+ (let ((delete-trailing-lines t))
+ (delete-trailing-whitespace))
+ (set-buffer-modified-p nil))))
+
+(defun forth-pad-line ()
+ (end-of-line)
+ (while (plusp (logand (1- (point)) 63))
+ (insert " "))
+ (ignore-errors (delete-char 1)
+ (if (looking-at "\n")
+ (insert " "))
+ t))
+
+(defun forth-blockify ()
+ (let ((after-change-functions nil))
+ (save-excursion
+ (beginning-of-buffer)
+ (while (forth-pad-line))
+ (while (plusp (logand (point) 1023))
+ (insert " "))
+ (insert " "))))
+
+(defun forth-block-annotations ())
+
+;;; format-alist
+'(forth/blocks "Forth blocks" nil forth-unblockify forth-block-annotations
+ nil forth-block-mode nil)
+
+(defvar forth-change-newlines)
+
+(defun forth-count-newlines (start end)
+ (let ((n 0))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (if (looking-at "\n")
+ (incf n))
+ (forward-char 1)))
+ (message "N = %d" n)
+ n))
+
+(defun forth-before-change (start end)
+ (setq forth-change-newlines (forth-count-newlines start end)))
+
+(defun forth-after-change (start end z)
+ (message "Change: %s %s %s" start end z)
+ (setq forth-change-newlines (- (forth-count-newlines start end)
+ forth-change-newlines))
+ (message "New lines: %d" forth-change-newlines)
+ (cond ((plusp forth-change-newlines)
+ (let ((n (logand (+ (line-number-at-pos) 15) -16)))
+ (save-excursion
+ (goto-line (1+ n))
+ (delete-region (line-beginning-position) (line-end-position))
+ (delete-char 1))))
+ ((minusp forth-change-newlines)
+ (let ((n (logand (+ (line-number-at-pos) 15) -16)))
+ (save-excursion
+ (goto-line n)
+ (insert "\n")))))
+ (save-excursion
+ (end-of-line)
+ (while (> (- (point) (line-beginning-position)) 64)
+ (delete-backward-char 1))))
+
(define-minor-mode forth-block-mode
"Minor mode for Forth code in blocks."
- :lighter " block")
+ :lighter " block"
+ (setq require-final-newline nil)
+ (forth-unblockify)
+ (add-hook (make-local-variable 'before-save-hook) #'forth-blockify)
+ (add-hook (make-local-variable 'after-save-hook) #'forth-unblockify)
+ (add-to-list (make-local-variable 'before-change-functions)
+ #'forth-before-change)
+ (add-to-list (make-local-variable 'after-change-functions)
+ #'forth-after-change))
diff --git a/forth-mode.el b/forth-mode.el
index 1360b629cd..8247d8a868 100644
--- a/forth-mode.el
+++ b/forth-mode.el
@@ -1,6 +1,8 @@
;;;; -*- emacs-lisp -*-
;;; Copyright 2014 Lars Brinkhoff
+(load-file "forth-block-mode.el")
+
(defvar forth-mode-map
(let ((map (make-sparse-keymap)))
;; (define-key (kbd "C-x C-e") #'forth-eval-last-sexp)
@@ -60,6 +62,8 @@
(define-derived-mode forth-mode prog-mode "Forth"
"Major mode for editing Forth files."
:syntax-table forth-mode-syntax-table
+ (if (forth-block-p)
+ (forth-block-mode))
(setq font-lock-defaults '(forth-font-lock-keywords))
(setq ;; font-lock-defaults
indent-line-function #'forth-indent
