aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOmar Polo <op@omarpolo.com>2020-07-24 21:28:07 +0200
committerOmar Polo <op@omarpolo.com>2020-07-24 21:28:07 +0200
commit054438e8f1f136e45bb843a16cee29d730ee5cd4 (patch)
tree5e088d0a4e75465bf877b43044113398b295b3ee
downloadsam.el-054438e8f1f136e45bb843a16cee29d730ee5cd4.tar.gz
sam.el-054438e8f1f136e45bb843a16cee29d730ee5cd4.tar.bz2
initial commit
-rw-r--r--.gitignore1
-rw-r--r--Makefile16
-rw-r--r--README.md9
-rw-r--r--sam-test.el20
-rw-r--r--sam.el231
5 files changed, 277 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c531d98
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.elc
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..d175b52
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,16 @@
+.POSIX:
+EMACS = emacs
+
+compile: sam.elc sam-test.elc
+
+sam-test.elc: sam.elc
+
+check: sam-test.elc
+ ${EMACS} -Q --batch -L . -l sam.elc -f ert-run-tests-batch
+
+clean:
+ rm -f *.elc
+
+.SUFFIXES: .el .elc
+.el.elc:
+ ${EMACS} -Q --batch -L . -f batch-byte-compile $<
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..a4fd0da
--- /dev/null
+++ b/README.md
@@ -0,0 +1,9 @@
+sam.el
+======
+
+`sam.el` is a work in progress emulation of sam in pure emacs lisp.
+
+The goal is to being able to control emacs and edit files using the
+structural regular expression, with the same syntax of sam.
+
+Think of it like an evil-mode but for plan9 people :)
diff --git a/sam-test.el b/sam-test.el
new file mode 100644
index 0000000..1c6fafb
--- /dev/null
+++ b/sam-test.el
@@ -0,0 +1,20 @@
+;;; sam-test.el --- sam test suite. -*- lexical-binding: t -*-
+
+(eval-when-compile
+ (require 'cl-lib))
+
+(require 'ert)
+(require 'sam)
+
+(ert-deftest sam-parse-command-test ()
+ (dolist (spec '(("3" "p" <- "3p")
+ ("3" "p" <- "3 p")
+ ("34" "p" <- "34\tp")
+ ("" "b" <- "b")
+ ("32" "" <- "32")))
+ (cl-destructuring-bind (exp-addr exp-cmd _ cmd) spec
+ (cl-destructuring-bind (address . command) (sam-parse-command cmd)
+ (should (string-equal exp-addr address))
+ (should (string-equal exp-cmd command))))))
+
+;; (ert-run-tests-interactively t)
diff --git a/sam.el b/sam.el
new file mode 100644
index 0000000..9a30c6e
--- /dev/null
+++ b/sam.el
@@ -0,0 +1,231 @@
+;;; sam.el --- sam for Emacs. -*- lexical-binding: t -*-
+
+;; Copyright © 2020 Omar Polo <op@omarpolo.com>
+
+;; This file is not part of GNU Emacs.
+
+;; This file is free software.
+;;
+;; Permission to use, copy, modify, and distribute this software for
+;; any purpose with or without fee is hereby granted, provided that
+;; the above copyright notice and this permission notice appear in all
+;; copies.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+;; Author: Omar Polo <op@omarpolo.com>
+;; URL: https://git.omarpolo.com/sam-mode
+;; Keywords: emulation
+
+;;; Commentary
+
+;; TODO.
+
+;;; Code:
+
+(eval-when-compile ; subr-x.el says so.
+ (require 'subr-x))
+
+(require 'cl-lib)
+
+(defgroup sam nil
+ "sam for Emacs."
+ :prefix "sam-"
+ :group 'emulations
+ :link '(url-link :tag "Git repo" "https://git.omarpolo.com/sam"))
+
+(defvar sam-current-buffer nil
+ "The active buffer where command would operate on.'")
+
+(defvar sam-prompt ""
+ "The sam prompt.")
+
+(defvar sam-display-prompt nil
+ "Whether to display the prompt or not.")
+
+(defvar sam-is-inserting nil
+ "t if sam is accepting text input instead of commands.")
+
+(defvar sam-last-replace nil
+ "last replaced regexp.")
+
+(defvar sam-mark-alist nil
+ "Sam marks.")
+
+(defvar sam-mode-hook nil
+ "Hook run when entering sam mode.")
+
+(defvar sam-mode-map (make-sparse-keymap)
+ "Keymap for sam mode.")
+
+(define-key sam-mode-map "\r" 'sam-newline)
+
+(defconst sam-cmd-alist
+ '(;; ("=#" . sam-cmd-charoffset)
+ ("=" . sam-cmd-linenum)
+ ("P" . sam-cmd-filename)
+ ("p" . sam-cmd-print)
+ ("b" . sam-cmd-switch-buffer)
+ ("B" . sam-cmd-switch-buffer-no-fuzzy)
+ ("n" . sam-cmd-buflist)
+ ("q" . sam-cmd-quit)))
+
+(defun sam-get-buffer ()
+ "Gets the buffer of this sam instance."
+ (get-buffer "*sam*"))
+
+(defun sam-report-error (err)
+ (with-current-buffer (sam-get-buffer)
+ (insert "?" err)))
+
+(defun sam-parse-command (s)
+ "Returns an cons of `address' and `command'"
+ (let ((address "")
+ (command "")
+ (run t)
+ (i 0)
+ (len (length s)))
+ (while (and run
+ (< i len))
+ (if (cl-digit-char-p (aref s i))
+ (setq i (1+ i))
+ (setq run nil)))
+ (setq address (substring s 0 i)
+ command (substring s i))
+ `(,address . ,(string-trim-left command))))
+
+(defun sam-dot-select-line (lineno)
+ (with-current-buffer sam-current-buffer
+ (with-no-warnings
+ (goto-line lineno)
+ (let (p1 p2)
+ (setq p1 (line-beginning-position)
+ p2 (line-end-position))
+ (goto-char p2)
+ (push-mark p1)
+ (setq mark-active t)))))
+
+(defun sam-set-dot (address)
+ (when sam-current-buffer
+ (if (string-equal address "")
+ nil
+ (sam-dot-select-line (string-to-number address)))))
+
+(defun sam-get-line ()
+ "Returns the string on the current line."
+ (copy-region-as-kill
+ (+ (if (and (not sam-is-inserting)
+ sam-display-prompt)
+ (length sam-display-prompt)
+ 0)
+ (point-at-bol))
+ (point-at-eol))
+ (pop kill-ring))
+
+(defun sam-exec-command (cmd)
+ ;; TODO: naïve
+ (if (= (length cmd) 0)
+ nil
+ (let* ((c (substring cmd 0 1))
+ (f (cdr (assoc c sam-cmd-alist))))
+ (if f
+ (funcall f)
+ (sam-report-error (concat "unknown command ``" cmd "''"))))))
+
+(defun sam-exec-line ()
+ "Run the sam command on this line."
+ (let* ((line (sam-get-line))
+ (parsed (sam-parse-command line))
+ (addr (car parsed))
+ (cmd (cdr parsed)))
+ (insert "\n")
+ (sam-set-dot addr)
+ (sam-exec-command cmd)))
+
+(defun sam-newline ()
+ "Insert a newline, executing the command on this line if in
+ command mode."
+ (interactive)
+ (sam-exec-line)
+ (message "foo")
+ (if (and (not sam-is-inserting) sam-display-prompt)
+ (insert sam-prompt)))
+
+(defun sam-current-buffer-region ()
+ "Returns a cons of `region-beginning' . `region-end' in the current buffer."
+ (with-current-buffer sam-current-buffer
+ `(,(region-beginning) . (region-end))))
+
+(defun sam-list-file-buffers ()
+ "Return a list of buffer that are visiting a file."
+ (cl-loop for buf in (buffer-list)
+ when (buffer-file-name buf)
+ collect buf))
+
+(defun sam-get-region-as-string ()
+ (with-current-buffer sam-current-buffer
+ (buffer-substring-no-properties (region-beginning)
+ (region-end))))
+
+(defun sam-cmd-charoffset ()
+ (cl-destructuring-bind (begin . end) (sam-current-buffer-region)
+ (with-current-buffer (sam-get-buffer)
+ (insert "#" (number-to-string begin) ","
+ "#" (number-to-string end) "\n"))))
+
+(defun sam-cmd-linenum ()
+ (cl-destructuring-bind (begin . end) (sam-current-buffer-region)
+ (with-current-buffer (sam-get-buffer)
+ (insert "TODO,TODO; "
+ "#" (number-to-string begin) ","
+ "#" (number-to-string end) "\n"))))
+
+(defun sam-cmd-filename ()
+ (with-current-buffer (sam-get-buffer)
+ (insert (buffer-name sam-current-buffer) "\n")))
+
+(defun sam-cmd-print ()
+ (let ((s (sam-get-region-as-string)))
+ (with-current-buffer (sam-get-buffer)
+ (insert s "\n"))))
+
+(defun sam-cmd-switch-buffer ()
+ (with-current-buffer (sam-get-buffer)
+ (sam-report-error "not implemented yet")))
+
+(defun sam-cmd-switch-buffer-no-fuzzy ()
+ (with-current-buffer (sam-get-buffer)
+ (sam-report-error "not implemented yet")))
+
+(defun sam-cmd-buflist ()
+ (with-current-buffer (sam-get-buffer)
+ (dolist (buf (sam-list-file-buffers))
+ (insert " " (buffer-file-name buf) "\n"))))
+
+(defun sam-cmd-quit ()
+ (kill-buffer (sam-get-buffer)))
+
+(defun sam-mode ()
+ "Major mode for sam buffers."
+ (kill-all-local-variables)
+ (use-local-map sam-mode-map)
+ (setq mode-name "sam")
+ (setq major-mode 'sam-mode)
+ (run-hooks 'sam-mode-hook))
+
+(defun sam ()
+ "Launch a sam session associated with the current buffer."
+ (interactive)
+ (let ((edit-buffer (buffer-name)))
+ (pop-to-buffer "*sam*")
+ (sam-mode)
+ (setq sam-current-buffer (get-buffer edit-buffer))))
+
+(provide 'sam)