]> code.delx.au - gnu-emacs-elpa/commitdiff
* lmc.el: Make it work on Emacs-22.
authorStefan Monnier <monnier@iro.umontreal.ca>
Wed, 12 Oct 2011 04:18:07 +0000 (00:18 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Wed, 12 Oct 2011 04:18:07 +0000 (00:18 -0400)
(lmc--with-silent-modifications): Compatibility macro.
(lmc-store-word): Use it.
(lmc): New group.
(lmc-store-flash): Make into a defcustom.

packages/lmc/lmc.el

index 82142d1ee3071c59ee4beb70f0f9e524c2d6571c..2e6e34ea6f30908383bd7e1cf286d13401a020b8 100644 (file)
 (eval-when-compile (require 'cl))
 (require 'hexl)
 
+(defgroup lmc ()
+  "Customization group for the Little Man Computer simulator."
+  :group 'languages)
+
 ;;; The LMC-Simulator
 
 (defvar lmc--pc 0 "Program counter for LMC.")
 (defvar lmc-acc 0 "Accumulator for LMC.")
 (make-variable-buffer-local 'lmc--acc)
 
+;; Emacs-22 backward compatibility.
+(defmacro lmc--with-silent-modifications (&rest body)
+  (declare (debug t) (indent 0))
+  (if (fboundp 'with-silent-modifications)
+      `(with-silent-modifications ,@body)
+    (let ((modified (make-symbol "modified")))
+      `(let* ((,modified (buffer-modified-p))
+             (buffer-undo-list t)
+             (inhibit-read-only t)
+             (inhibit-modification-hooks t)
+             deactivate-mark
+             ;; Avoid setting and removing file locks and checking
+             ;; buffer's uptodate-ness w.r.t the underlying file.
+             buffer-file-name
+             buffer-file-truename)
+        (unwind-protect
+            (progn
+              ,@body)
+          (unless ,modified
+            (restore-buffer-modified-p nil)))))))
+
 ;; (defun lmc-check (cmds)
 ;;   (dolist (cmd cmds)
 ;;     (pcase cmd
       (setq addr (1+ addr))))
   (lmc-update-pc))
 
-(defvar lmc-store-flash t)
+(defcustom lmc-store-flash t
+  "If non-nil, memory words blink when modified."
+  :type 'boolean)
 
 (defun lmc-store-word (addr word)
   (save-excursion
     (if (not (re-search-forward "\t.*\t\\(.*\\)$" (line-end-position) t))
         (error "Missing memory cell %S" addr)
       (when lmc-store-flash
-        (with-silent-modifications
+        (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)
-        (with-silent-modifications
+        (lmc--with-silent-modifications
           (put-text-property (match-beginning 1) (point)
                              'face 'region))
         (sit-for 0.1)
-        (with-silent-modifications
+        (lmc--with-silent-modifications
           (put-text-property (match-beginning 1) (point)
                              'face nil))
         (sit-for 0.1)))))