aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-11-25 09:31:04 -0500
committerStefan Monnier2013-11-25 09:31:04 -0500
commite82ad66cd05a4fd9da7e54d90f562d5d8c472098 (patch)
treee42630ee9428f116a2a64b1e6779dcbbf979c9a3
parent1288751c496c0eeabf0b8f2c474f67332a8a460d (diff)
downloademacs-e82ad66cd05a4fd9da7e54d90f562d5d8c472098.tar.gz
emacs-e82ad66cd05a4fd9da7e54d90f562d5d8c472098.zip
* lisp/play/gomoku.el: Don't use intangible property. Use lexical-binding.
(gomoku--last-pos): New var. (gomoku--intangible-chars): New const. (gomoku--intangible): New function. (gomoku-mode): Use it. Derive from special-mode. (gomoku-move-up): Adjust line count. (gomoku-click, gomoku-point-y, gomoku-point-square, gomoku-goto-xy) (gomoku-plot-square, gomoku-init-display, gomoku-cross-qtuple): Simplify accordingly.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/play/gomoku.el114
2 files changed, 68 insertions, 56 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d8b176fad65..9c89b7b1166 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,15 @@
12013-11-25 Stefan Monnier <monnier@iro.umontreal.ca> 12013-11-25 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * play/gomoku.el: Don't use intangible property. Use lexical-binding.
4 (gomoku--last-pos): New var.
5 (gomoku--intangible-chars): New const.
6 (gomoku--intangible): New function.
7 (gomoku-mode): Use it. Derive from special-mode.
8 (gomoku-move-up): Adjust line count.
9 (gomoku-click, gomoku-point-y, gomoku-point-square, gomoku-goto-xy)
10 (gomoku-plot-square, gomoku-init-display, gomoku-cross-qtuple):
11 Simplify accordingly.
12
3 * frame.el (handle-focus-in, handle-focus-out): Move from frame.c. 13 * frame.el (handle-focus-in, handle-focus-out): Move from frame.c.
4 Remove blink-cursor code. 14 Remove blink-cursor code.
5 (blink-cursor-timer-function, blink-cursor-suspend): 15 (blink-cursor-timer-function, blink-cursor-suspend):
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 609585c9522..4a2523ad987 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,4 +1,4 @@
1;;; gomoku.el --- Gomoku game between you and Emacs 1;;; gomoku.el --- Gomoku game between you and Emacs -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1988, 1994, 1996, 2001-2013 Free Software Foundation, 3;; Copyright (C) 1988, 1994, 1996, 2001-2013 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -176,14 +176,9 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
176 ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X))) 176 ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
177 "Font lock rules for Gomoku.") 177 "Font lock rules for Gomoku.")
178 178
179(put 'gomoku-mode 'front-sticky
180 (put 'gomoku-mode 'rear-nonsticky '(intangible)))
181(put 'gomoku-mode 'intangible 1)
182;; This one is for when they set view-read-only to t: Gomoku cannot 179;; This one is for when they set view-read-only to t: Gomoku cannot
183;; allow View Mode to be activated in its buffer. 180;; allow View Mode to be activated in its buffer.
184(put 'gomoku-mode 'mode-class 'special) 181(define-derived-mode gomoku-mode special-mode "Gomoku"
185
186(define-derived-mode gomoku-mode nil "Gomoku"
187 "Major mode for playing Gomoku against Emacs. 182 "Major mode for playing Gomoku against Emacs.
188You and Emacs play in turn by marking a free square. You mark it with X 183You and Emacs play in turn by marking a free square. You mark it with X
189and Emacs marks it with O. The winner is the first to get five contiguous 184and Emacs marks it with O. The winner is the first to get five contiguous
@@ -196,7 +191,8 @@ Other useful commands:\n
196 (gomoku-display-statistics) 191 (gomoku-display-statistics)
197 (make-local-variable 'font-lock-defaults) 192 (make-local-variable 'font-lock-defaults)
198 (setq font-lock-defaults '(gomoku-font-lock-keywords t) 193 (setq font-lock-defaults '(gomoku-font-lock-keywords t)
199 buffer-read-only t)) 194 buffer-read-only t)
195 (add-hook 'post-command-hook #'gomoku--intangible nil t))
200 196
201;;; 197;;;
202;;; THE BOARD. 198;;; THE BOARD.
@@ -836,8 +832,7 @@ Use \\[describe-mode] for more info."
836 (min (max (/ (+ (- (cdr click) 832 (min (max (/ (+ (- (cdr click)
837 gomoku-y-offset 833 gomoku-y-offset
838 1) 834 1)
839 (let ((inhibit-point-motion-hooks t)) 835 (count-lines (point-min) (window-start))
840 (count-lines 1 (window-start)))
841 gomoku-square-height 836 gomoku-square-height
842 (% gomoku-square-height 2) 837 (% gomoku-square-height 2)
843 (/ gomoku-square-height 2)) 838 (/ gomoku-square-height 2))
@@ -961,16 +956,15 @@ If the game is finished, this command requests for another game."
961 956
962(defun gomoku-point-y () 957(defun gomoku-point-y ()
963 "Return the board row where point is." 958 "Return the board row where point is."
964 (let ((inhibit-point-motion-hooks t)) 959 (1+ (/ (- (count-lines (point-min) (point))
965 (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1)) 960 gomoku-y-offset (if (bolp) 0 1))
966 gomoku-square-height)))) 961 gomoku-square-height)))
967 962
968(defun gomoku-point-square () 963(defun gomoku-point-square ()
969 "Return the index of the square point is on." 964 "Return the index of the square point is on."
970 (let ((inhibit-point-motion-hooks t)) 965 (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
971 (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset) 966 gomoku-square-width))
972 gomoku-square-width)) 967 (gomoku-point-y)))
973 (gomoku-point-y))))
974 968
975(defun gomoku-goto-square (index) 969(defun gomoku-goto-square (index)
976 "Move point to square number INDEX." 970 "Move point to square number INDEX."
@@ -978,20 +972,18 @@ If the game is finished, this command requests for another game."
978 972
979(defun gomoku-goto-xy (x y) 973(defun gomoku-goto-xy (x y)
980 "Move point to square at X, Y coords." 974 "Move point to square at X, Y coords."
981 (let ((inhibit-point-motion-hooks t)) 975 (goto-char (point-min))
982 (goto-char (point-min)) 976 (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y))))
983 (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y)))))
984 (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x))))) 977 (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x)))))
985 978
986(defun gomoku-plot-square (square value) 979(defun gomoku-plot-square (square value)
987 "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." 980 "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
988 (or (= value 1) 981 (or (= value 1)
989 (gomoku-goto-square square)) 982 (gomoku-goto-square square))
990 (let ((inhibit-read-only t) 983 (let ((inhibit-read-only t))
991 (inhibit-point-motion-hooks t)) 984 (insert (cond ((= value 1) ?X)
992 (insert-and-inherit (cond ((= value 1) ?X) 985 ((= value 6) ?O)
993 ((= value 6) ?O) 986 (?.)))
994 (?.)))
995 (and (zerop value) 987 (and (zerop value)
996 (add-text-properties 988 (add-text-properties
997 (1- (point)) (point) 989 (1- (point)) (point)
@@ -1004,8 +996,7 @@ If the game is finished, this command requests for another game."
1004 "Display an N by M Gomoku board." 996 "Display an N by M Gomoku board."
1005 (buffer-disable-undo (current-buffer)) 997 (buffer-disable-undo (current-buffer))
1006 (let ((inhibit-read-only t) 998 (let ((inhibit-read-only t)
1007 (point 1) opoint 999 (point (point-min)) opoint
1008 (intangible t)
1009 (i m) j x) 1000 (i m) j x)
1010 ;; Try to minimize number of chars (because of text properties) 1001 ;; Try to minimize number of chars (because of text properties)
1011 (setq tab-width 1002 (setq tab-width
@@ -1014,17 +1005,15 @@ If the game is finished, this command requests for another game."
1014 (max (/ (+ (% gomoku-x-offset gomoku-square-width) 1005 (max (/ (+ (% gomoku-x-offset gomoku-square-width)
1015 gomoku-square-width 1) 2) 2))) 1006 gomoku-square-width 1) 2) 2)))
1016 (erase-buffer) 1007 (erase-buffer)
1017 (newline gomoku-y-offset) 1008 (insert-char ?\n gomoku-y-offset)
1018 (while (progn 1009 (while (progn
1019 (setq j n 1010 (setq j n
1020 x (- gomoku-x-offset gomoku-square-width)) 1011 x (- gomoku-x-offset gomoku-square-width))
1021 (while (>= (setq j (1- j)) 0) 1012 (while (>= (setq j (1- j)) 0)
1022 (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width)) 1013 (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
1023 (current-column)) 1014 (current-column))
1024 tab-width)) 1015 tab-width))
1025 (insert-char ? (- x (current-column))) 1016 (insert-char ?\s (- x (current-column)))
1026 (if (setq intangible (not intangible))
1027 (put-text-property point (point) 'intangible 2))
1028 (and (zerop j) 1017 (and (zerop j)
1029 (= i (- m 2)) 1018 (= i (- m 2))
1030 (progn 1019 (progn
@@ -1042,16 +1031,9 @@ If the game is finished, this command requests for another game."
1042 (if (= i (1- m)) 1031 (if (= i (1- m))
1043 (setq opoint point)) 1032 (setq opoint point))
1044 (insert-char ?\n gomoku-square-height)) 1033 (insert-char ?\n gomoku-square-height))
1045 (or (eq (char-after 1) ?.) 1034 (insert-char ?\n))
1046 (put-text-property 1 2 'point-entered
1047 (lambda (_x _y) (if (bobp) (forward-char)))))
1048 (or intangible
1049 (put-text-property point (point) 'intangible 2))
1050 (put-text-property point (point) 'point-entered
1051 (lambda (_x _y) (if (eobp) (backward-char))))
1052 (put-text-property (point-min) (point) 'category 'gomoku-mode))
1053 (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board 1035 (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
1054 (sit-for 0)) ; Display NOW 1036 (sit-for 0)) ; Display NOW
1055 1037
1056(defun gomoku-display-statistics () 1038(defun gomoku-display-statistics ()
1057 "Obnoxiously display some statistics about previous games in mode line." 1039 "Obnoxiously display some statistics about previous games in mode line."
@@ -1114,8 +1096,7 @@ If the game is finished, this command requests for another game."
1114 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." 1096 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
1115 (save-excursion ; Not moving point from last square 1097 (save-excursion ; Not moving point from last square
1116 (let ((depl (gomoku-xy-to-index dx dy)) 1098 (let ((depl (gomoku-xy-to-index dx dy))
1117 (inhibit-read-only t) 1099 (inhibit-read-only t))
1118 (inhibit-point-motion-hooks t))
1119 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 1100 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
1120 (while (/= square1 square2) 1101 (while (/= square1 square2)
1121 (gomoku-goto-square square1) 1102 (gomoku-goto-square square1)
@@ -1134,36 +1115,57 @@ If the game is finished, this command requests for another game."
1134 (setq n (1+ n)) 1115 (setq n (1+ n))
1135 (forward-line 1) 1116 (forward-line 1)
1136 (indent-to column) 1117 (indent-to column)
1137 (insert-and-inherit ?|)))) 1118 (insert ?|))))
1138 ((= dx -1) ; 1st Diagonal 1119 ((= dx -1) ; 1st Diagonal
1139 (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2)) 1120 (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2))
1140 (forward-line (/ gomoku-square-height 2)))) 1121 (forward-line (/ gomoku-square-height 2))))
1141 (insert-and-inherit ?/)) 1122 (insert ?/))
1142 (t ; 2nd Diagonal 1123 (t ; 2nd Diagonal
1143 (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2)) 1124 (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2))
1144 (forward-line (/ gomoku-square-height 2)))) 1125 (forward-line (/ gomoku-square-height 2))))
1145 (insert-and-inherit ?\\)))))) 1126 (insert ?\\))))))
1146 (sit-for 0)) ; Display NOW 1127 (sit-for 0)) ; Display NOW
1147 1128
1148;;; 1129;;;
1149;;; CURSOR MOTION. 1130;;; CURSOR MOTION.
1150;;; 1131;;;
1132
1133(defvar-local gomoku--last-pos 0)
1134
1135(defconst gomoku--intangible-chars "- \t\n|/\\\\")
1136
1137(defun gomoku--intangible ()
1138 (when (or (eobp)
1139 (save-excursion
1140 (not (zerop (skip-chars-forward gomoku--intangible-chars)))))
1141 (if (<= gomoku--last-pos (point)) ;Moving forward.
1142 (progn
1143 (skip-chars-forward gomoku--intangible-chars)
1144 (when (eobp)
1145 (skip-chars-backward gomoku--intangible-chars)
1146 (forward-char -1)))
1147 (skip-chars-backward gomoku--intangible-chars)
1148 (if (bobp)
1149 (skip-chars-forward gomoku--intangible-chars)
1150 (forward-char -1))))
1151 (setq gomoku--last-pos (point)))
1152
1151;; previous-line and next-line don't work right with intangible newlines 1153;; previous-line and next-line don't work right with intangible newlines
1152(defun gomoku-move-down () 1154(defun gomoku-move-down ()
1153 "Move point down one row on the Gomoku board." 1155 "Move point down one row on the Gomoku board."
1154 (interactive) 1156 (interactive)
1155 (if (< (gomoku-point-y) gomoku-board-height) 1157 (when (< (gomoku-point-y) gomoku-board-height)
1156 (let ((column (current-column))) 1158 (let ((column (current-column)))
1157 (forward-line gomoku-square-height) 1159 (forward-line gomoku-square-height)
1158 (move-to-column column)))) 1160 (move-to-column column))))
1159 1161
1160(defun gomoku-move-up () 1162(defun gomoku-move-up ()
1161 "Move point up one row on the Gomoku board." 1163 "Move point up one row on the Gomoku board."
1162 (interactive) 1164 (interactive)
1163 (if (> (gomoku-point-y) 1) 1165 (when (> (gomoku-point-y) 1)
1164 (let ((column (current-column))) 1166 (let ((column (current-column)))
1165 (forward-line (- 1 gomoku-square-height)) 1167 (forward-line (- gomoku-square-height))
1166 (move-to-column column)))) 1168 (move-to-column column))))
1167 1169
1168(defun gomoku-move-ne () 1170(defun gomoku-move-ne ()
1169 "Move point North East on the Gomoku board." 1171 "Move point North East on the Gomoku board."