X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/1acf9ec859d39ee5c1a04cbb4d4bcf51fcb41788..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/lmc/lmc.el

diff --git a/packages/lmc/lmc.el b/packages/lmc/lmc.el
index 2e6e34ea6..b8c8ee028 100644
--- a/packages/lmc/lmc.el
+++ b/packages/lmc/lmc.el
@@ -1,9 +1,9 @@
-;;; lmc.el --- Little Man Computer in Elisp
+;;; lmc.el --- Little Man Computer in Elisp  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2011  Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013, 2014  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Version: 1.0
+;; Version: 1.3
 
 ;; 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
@@ -76,6 +76,12 @@
 (defvar lmc-acc 0 "Accumulator for LMC.")
 (make-variable-buffer-local 'lmc--acc)
 
+(defvar lmc-turbo nil
+  "When non-nil, evaluate the code without extra delays.
+When nil, evaluation flashes the cursor at to help you see what's going on,
+which slows it down significantly.
+Also, when nil, evaluation is interrupted when the user hits a key.")
+
 ;; Emacs-22 backward compatibility.
 (defmacro lmc--with-silent-modifications (&rest body)
   (declare (debug t) (indent 0))
@@ -202,8 +208,7 @@
   (let ((word (car word))
         (label (nth 1 word))
         (code (nth 2 word)))
-    (let ((basepos (point))
-          (base (current-column)))
+    (let () ;; ((basepos (point)) (base (current-column)))
       (if (and label (symbolp label))
           (insert (symbol-name label)))
       ;; (when (>= (current-column) (+ base tab-width))
@@ -344,7 +349,7 @@
      (2 (lmc-font-lock-label)))
     (".$" (0 (lmc-font-lock-opcode)))))
 
-(defun lmc-after-change (beg end len)
+(defun lmc-after-change (beg end _len)
   (unless inhibit-read-only
     (save-excursion
       ;; Replace any TAB or NL inserted, which could interfere with parsing.
@@ -357,7 +362,7 @@
 (make-variable-buffer-local 'lmc-pc)
 (defvar lmc-acc nil "LMC accumulator.")
 (make-variable-buffer-local 'lmc-acc)
-(defvar lmc-output nil "Past LMC output,")
+(defvar lmc-output nil "Past LMC output.")
 (make-variable-buffer-local 'lmc-output)
 
 (defvar lmc--stopped nil "State where we stopped.")
@@ -414,7 +419,7 @@
 (defun lmc-tool-bar-to-string (&optional map)
   (let ((res ""))
     (map-keymap
-     (lambda (k v)
+     (lambda (_k v)
        (when (eq (car v) 'menu-item)
          (let* ((label (nth 1 v))
                 (cmd (nth 2 v))
@@ -535,27 +540,29 @@
   "If non-nil, memory words blink when modified."
   :type 'boolean)
 
+(defun lmc--sit-for (secs)
+  (unless lmc-turbo (sit-for secs)))
+
 (defun lmc-store-word (addr word)
   (save-excursion
     (lmc-addr->point addr)
     (if (not (re-search-forward "\t.*\t\\(.*\\)$" (line-end-position) t))
         (error "Missing memory cell %S" addr)
-      (when lmc-store-flash
-        (lmc--with-silent-modifications
-          (put-text-property (match-beginning 1) (point)
-                             'face 'region))
-        (sit-for 0.2))
-      (replace-match (format "  %03d" word) t t nil 1)
-      (when lmc-store-flash
-        (sit-for 0.1)
-        (lmc--with-silent-modifications
-          (put-text-property (match-beginning 1) (point)
-                             'face 'region))
-        (sit-for 0.1)
-        (lmc--with-silent-modifications
-          (put-text-property (match-beginning 1) (point)
-                             'face nil))
-        (sit-for 0.1)))))
+      (let ((mb1 (match-beginning 1)))
+        (when lmc-store-flash
+          (lmc--with-silent-modifications
+           (put-text-property mb1 (point) 'face 'region))
+          (lmc--sit-for 0.2))
+        (let ((me1 (point)))
+          (insert (format "  %03d" word)) (delete-region mb1 me1))
+        (when lmc-store-flash
+          (lmc--sit-for 0.1)
+          (lmc--with-silent-modifications
+           (put-text-property mb1 (point) 'face 'region))
+          (lmc--sit-for 0.1)
+          (lmc--with-silent-modifications
+           (put-text-property mb1 (point) 'face nil))
+          (lmc--sit-for 0.1))))))
 
 (defun lmc-step ()
   "Execute one LMC instruction."
@@ -568,7 +575,7 @@
              (setq lmc--stopped (lmc--state))
              (force-mode-line-update)
              (message "Done.")))
-      (IN (setq lmc-acc (mod (read-number "Enter a number") 1000))
+      (IN (setq lmc-acc (mod (read-number "Enter a number: ") 1000))
           (incf lmc-pc))
       (OUT (message "Output: %03d" lmc-acc)
            (push (format "%03d" lmc-acc) lmc-output)
@@ -598,9 +605,9 @@
   "Run the code until hitting a HLT.
 The machine will also stop if the user presses a key."
   (interactive)
-  (while (not (or (input-pending-p) (lmc-stopped-p)))
+  (while (not (or (unless lmc-turbo (input-pending-p)) (lmc-stopped-p)))
     (lmc-step)
-    (sit-for 0.05)))
+    (lmc--sit-for 0.05)))
 
 ;;; The LMC assembly language editor.
 
@@ -703,7 +710,8 @@ The machine will also stop if the user presses a key."
     (cond
      ((> (nth 0 (syntax-ppss)) 0) nil)
      ((looking-at "(") tab-width)
-     ((not (looking-at comment-start-skip)) 0)
+     ((not (looking-at comment-start-skip))
+      (if (looking-at "[ \t]*$") tab-width 0))
      ((not (looking-at "\\s<\\s<")) nil)
      ((save-excursion (forward-comment (- (point))) (bobp)) 0)
      (t (forward-comment (point-max)) (lmc-asm-indentation)))))