commit/w3: kehoea: Check for the menubar feature before calling #'custom-menu-create, w3-menu.el
12 years, 7 months
Bitbucket
Bitbucket
1 new commit in w3:
https://bitbucket.org/xemacs/w3/changeset/c6c39f2ef647/
changeset: c6c39f2ef647
user: kehoea
date: 2012-05-15 12:30:04
summary: Check for the menubar feature before calling #'custom-menu-create, w3-menu.el
lisp/ChangeLog addition:
2012-05-15 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp/w3-menu.el (w3-menu-edit-menu):
Check for the menubar or menu-bar feature before calling
#'custom-menu-create, making building with a headless XEmacs
practical.
affected #: 2 files
diff -r 59e99a00a59ffa39e51bb866ca30f2ec426459ee -r c6c39f2ef647b9cfd97f0f6f838bc99d1d7117d5 ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
＠＠ -1,3 +1,10 ＠＠
+2012-05-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp/w3-menu.el (w3-menu-edit-menu):
+ Check for the menubar or menu-bar feature before calling
+ #'custom-menu-create, making building with a headless XEmacs
+ practical.
+
2012-05-11 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.37 released.
diff -r 59e99a00a59ffa39e51bb866ca30f2ec426459ee -r c6c39f2ef647b9cfd97f0f6f838bc99d1d7117d5 lisp/w3-menu.el
--- a/lisp/w3-menu.el
+++ b/lisp/w3-menu.el
＠＠ -311,10 +311,12 ＠＠
"----"
(list
"Preferences"
- (if (fboundp 'custom-menu-create)
+ (if (and (fboundp 'custom-menu-create) (or (featurep 'menubar)
+ (featurep 'menu-bar)))
(custom-menu-create 'w3)
["W3" ignore nil])
- (if (fboundp 'custom-menu-create)
+ (if (and (fboundp 'custom-menu-create) (or (featurep 'menubar)
+ (featurep 'menu-bar)))
(custom-menu-create 'url)
["URL" ignore nil])
)
Repository URL: https://bitbucket.org/xemacs/w3/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] #'byte-optimize-letX; group constant initialisations together in let forms
12 years, 7 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1337005007 -3600
# Node ID b4715fcbe00185e5ab8c00208e14d15fb3c936a9
# Parent daf5accfe9736ac481b1bdd6063d060f8b4a633d
#'byte-optimize-letX; group constant initialisations together in let forms
lisp/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el (byte-optimize-letX):
In (let ...) forms, group constant initialisations together, so we
can just dup in the byte code.
diff -r daf5accfe973 -r b4715fcbe001 lisp/ChangeLog
--- a/lisp/ChangeLog Mon May 14 08:46:05 2012 +0100
+++ b/lisp/ChangeLog Mon May 14 15:16:47 2012 +0100
＠＠ -1,3 +1,9 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el (byte-optimize-letX):
+ In (let ...) forms, group constant initialisations together, so we
+ can just dup in the byte code.
+
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
Update minibuf.el to use #'test-completion, use the generality of
diff -r daf5accfe973 -r b4715fcbe001 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Mon May 14 08:46:05 2012 +0100
+++ b/lisp/byte-optimize.el Mon May 14 15:16:47 2012 +0100
＠＠ -1194,7 +1194,27 ＠＠
;; No bindings
(cons 'progn (cdr (cdr form))))
((or (nth 2 form) (nthcdr 3 form))
- form)
+ (if (and (eq 'let (car form)) (> (length (nth 1 form)) 2))
+ ;; Group constant initialisations together, so we can
+ ;; just dup in the lap code. Can't group other
+ ;; initialisations together if they have side-effects,
+ ;; that would re-order them.
+ (let ((sort (stable-sort
+ (copy-list (nth 1 form))
+ #'< :key #'(lambda (object)
+ (cond ((atom object)
+ most-positive-fixnum)
+ ((null (cadr object))
+ most-positive-fixnum)
+ ((byte-compile-trueconstp
+ (cadr object))
+ (mod (sxhash (cadr object))
+ most-positive-fixnum))
+ (t 0))))))
+ (if (equal sort (nth 1 form))
+ form
+ `(let ,sort ,＠(cddr form))))
+ form))
;; The body is nil
((eq (car form) 'let)
(append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: #'byte-optimize-letX; group constant initialisations together in let forms
12 years, 7 months
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/changeset/b4715fcbe001/
changeset: b4715fcbe001
user: kehoea
date: 2012-05-14 16:16:47
summary: #'byte-optimize-letX; group constant initialisations together in let forms
lisp/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el (byte-optimize-letX):
In (let ...) forms, group constant initialisations together, so we
can just dup in the byte code.
affected #: 2 files
diff -r daf5accfe9736ac481b1bdd6063d060f8b4a633d -r b4715fcbe00185e5ab8c00208e14d15fb3c936a9 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
＠＠ -1,3 +1,9 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el (byte-optimize-letX):
+ In (let ...) forms, group constant initialisations together, so we
+ can just dup in the byte code.
+
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
Update minibuf.el to use #'test-completion, use the generality of
diff -r daf5accfe9736ac481b1bdd6063d060f8b4a633d -r b4715fcbe00185e5ab8c00208e14d15fb3c936a9 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el
+++ b/lisp/byte-optimize.el
＠＠ -1194,7 +1194,27 ＠＠
;; No bindings
(cons 'progn (cdr (cdr form))))
((or (nth 2 form) (nthcdr 3 form))
- form)
+ (if (and (eq 'let (car form)) (> (length (nth 1 form)) 2))
+ ;; Group constant initialisations together, so we can
+ ;; just dup in the lap code. Can't group other
+ ;; initialisations together if they have side-effects,
+ ;; that would re-order them.
+ (let ((sort (stable-sort
+ (copy-list (nth 1 form))
+ #'< :key #'(lambda (object)
+ (cond ((atom object)
+ most-positive-fixnum)
+ ((null (cadr object))
+ most-positive-fixnum)
+ ((byte-compile-trueconstp
+ (cadr object))
+ (mod (sxhash (cadr object))
+ most-positive-fixnum))
+ (t 0))))))
+ (if (equal sort (nth 1 form))
+ form
+ `(let ,sort ,＠(cddr form))))
+ form))
;; The body is nil
((eq (car form) 'let)
(append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Use #'test-completion, minibuf.el, instead of implementing same.
12 years, 7 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1336981565 -3600
# Node ID daf5accfe9736ac481b1bdd6063d060f8b4a633d
# Parent 8593e614573a4a167af4d3e73201dfa46c7e30a8
Use #'test-completion, minibuf.el, instead of implementing same.
lisp/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
Update minibuf.el to use #'test-completion, use the generality of
recent completion changes to avoid some unnecessary consing when
reading.
* behavior.el (read-behavior):
* cus-edit.el (custom-face-prompt):
* cus-edit.el (widget-face-action):
* faces.el (read-face-name):
* minibuf.el:
* minibuf.el (minibuffer-completion-table):
* minibuf.el (exact-minibuffer-completion-p):
Removed. #'test-completion is equivalent to this, but more
general.
* minibuf.el (minibuffer-do-completion-1): Use #'test-completion.
* minibuf.el (completing-read): Update the documentation of the
arguments used for completion.
* minibuf.el (minibuffer-complete-and-exit): Use #'test-completion.
* minibuf.el (exit-minibuffer): Use #'test-completion.
* minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion.
* minibuf.el (read-color): No need to construct a completion table
separate from the colour list.
src/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
* minibuf.c (Ftest_completion):
Correct some documentation here.
diff -r 8593e614573a -r daf5accfe973 lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 12 18:12:13 2012 +0100
+++ b/lisp/ChangeLog Mon May 14 08:46:05 2012 +0100
＠＠ -1,3 +1,26 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Update minibuf.el to use #'test-completion, use the generality of
+ recent completion changes to avoid some unnecessary consing when
+ reading.
+ * behavior.el (read-behavior):
+ * cus-edit.el (custom-face-prompt):
+ * cus-edit.el (widget-face-action):
+ * faces.el (read-face-name):
+ * minibuf.el:
+ * minibuf.el (minibuffer-completion-table):
+ * minibuf.el (exact-minibuffer-completion-p):
+ Removed. #'test-completion is equivalent to this, but more
+ general.
+ * minibuf.el (minibuffer-do-completion-1): Use #'test-completion.
+ * minibuf.el (completing-read): Update the documentation of the
+ arguments used for completion.
+ * minibuf.el (minibuffer-complete-and-exit): Use #'test-completion.
+ * minibuf.el (exit-minibuffer): Use #'test-completion.
+ * minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion.
+ * minibuf.el (read-color): No need to construct a completion table
+ separate from the colour list.
+
2012-05-12 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
diff -r 8593e614573a -r daf5accfe973 lisp/behavior.el
--- a/lisp/behavior.el Sat May 12 18:12:13 2012 +0100
+++ b/lisp/behavior.el Mon May 14 08:46:05 2012 +0100
＠＠ -345,16 +345,10 ＠＠
for history command, and as the value to return if the user enters the
empty string."
(let ((result
- (completing-read
- prompt
- (let (list)
- (maphash #'(lambda (key value)
- (push (cons (symbol-name key) value) list))
- behavior-hash-table)
- list)
- nil must-match initial-contents (or history 'behavior-history)
- default-value)))
- (if (and result (stringp result))
+ (completing-read prompt behavior-hash-table nil must-match
+ initial-contents (or history 'behavior-history)
+ default-value)))
+ (if (stringp result)
(intern result)
result)))
diff -r 8593e614573a -r daf5accfe973 lisp/cus-edit.el
--- a/lisp/cus-edit.el Sat May 12 18:12:13 2012 +0100
+++ b/lisp/cus-edit.el Mon May 14 08:46:05 2012 +0100
＠＠ -878,10 +878,7 ＠＠
;; Make a choice only amongst the faces under point:
(let ((choice (completing-read
"Customize face: (default all faces at point) "
- (mapcar (lambda (face)
- (list (symbol-name face) face))
- faces)
- nil t)))
+ faces nil t)))
(if (eql (length choice) 0)
(list faces)
(list (intern choice)))))))))
＠＠ -2972,12 +2969,8 ＠＠
(defun widget-face-action (widget &optional event)
"Prompt for a face."
- (let ((answer (completing-read "Face: "
- (mapcar (lambda (face)
- (list (symbol-name face)))
- (face-list))
- nil nil nil
- 'face-history)))
+ (let ((answer (completing-read "Face: " (face-list) nil nil nil
+ 'face-history)))
(unless (eql (length answer) 0)
(widget-value-set widget (intern answer))
(widget-apply widget :notify widget event)
diff -r 8593e614573a -r daf5accfe973 lisp/faces.el
--- a/lisp/faces.el Sat May 12 18:12:13 2012 +0100
+++ b/lisp/faces.el Mon May 14 08:46:05 2012 +0100
＠＠ -54,14 +54,10 ＠＠
Such a collection of attributes is called a \"face\"."
:group 'emacs)
-
(defun read-face-name (prompt)
(let (face)
(while (eql (length face) 0) ; nil or ""
- (setq face (completing-read prompt
- (mapcar (lambda (x) (list (symbol-name x)))
- (face-list))
- nil t)))
+ (setq face (completing-read prompt (face-list) nil t)))
(intern face)))
(defun face-interactive (what &optional bool)
diff -r 8593e614573a -r daf5accfe973 lisp/minibuf.el
--- a/lisp/minibuf.el Sat May 12 18:12:13 2012 +0100
+++ b/lisp/minibuf.el Mon May 14 08:46:05 2012 +0100
＠＠ -58,18 +58,11 ＠＠
:group 'minibuffer)
(defvar minibuffer-completion-table nil
- "Alist or obarray used for completion in the minibuffer.
-This becomes the ALIST argument to `try-completion' and `all-completions'.
+ "List, hash table, function or obarray used for minibuffer completion.
-The value may alternatively be a function, which is given three arguments:
- STRING, the current buffer contents;
- PREDICATE, the predicate for filtering possible matches;
- CODE, which says what kind of things to do.
-CODE can be nil, t or `lambda'.
-nil means to return the best completion of STRING, nil if there is none,
- or t if it is already a unique completion.
-t means to return a list of all possible completions of STRING.
-`lambda' means to return t if STRING is a valid completion as it stands.")
+This becomes the COLLECTION argument to `try-completion', `all-completions'
+and `test-completion'; see the documentation of those functions for how
+values are interpreted.")
(defvar minibuffer-completion-predicate nil
"Within call to `completing-read', this holds the PREDICATE argument.")
＠＠ -621,56 +614,6 ＠＠
(setq unread-command-event (character-to-event (quit-char))
quit-flag nil)))))
-
-;; Determines whether buffer-string is an exact completion
-(defun exact-minibuffer-completion-p (buffer-string)
- (cond ((not minibuffer-completion-table)
- ;; Empty alist
- nil)
- ((vectorp minibuffer-completion-table)
- (let ((tem (intern-soft buffer-string
- minibuffer-completion-table)))
- (if (or tem
- (and (string-equal buffer-string "nil")
- ;; intern-soft loses for 'nil
- (catch 'found
- (mapatoms #'(lambda (s)
- (if (string-equal
- (symbol-name s)
- buffer-string)
- (throw 'found t)))
- minibuffer-completion-table)
- nil)))
- (if minibuffer-completion-predicate
- (funcall minibuffer-completion-predicate
- tem)
- t)
- nil)))
- ((and (consp minibuffer-completion-table)
- ;;#### Emacs-Lisp truly sucks!
- ;; lambda, autoload, etc
- (not (symbolp (car minibuffer-completion-table))))
- (if (not completion-ignore-case)
- (assoc buffer-string minibuffer-completion-table)
- (let ((s (upcase buffer-string))
- (tail minibuffer-completion-table)
- tem)
- (while tail
- (setq tem (car (car tail)))
- (if (or (equal tem buffer-string)
- (equal tem s)
- (if tem (equal (upcase tem) s)))
- (setq s 'win
- tail nil) ;exit
- (setq tail (cdr tail))))
- (eq s 'win))))
- (t
- (funcall minibuffer-completion-table
- buffer-string
- minibuffer-completion-predicate
- 'lambda)))
- )
-
;; 0 'none no possible completion
;; 1 'unique was already an exact and unique completion
;; 3 'exact was already an exact (but nonunique) completion
＠＠ -693,7 +636,8 ＠＠
(erase-buffer)
(insert completion)
(setq buffer-string completion)))
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
;; An exact completion was possible
(if completedp
;; Since no callers need to know the difference, don't bother
＠＠ -752,20 +696,18 ＠＠
;;;; completing-read
-(defun completing-read (prompt table
- &optional predicate require-match
- initial-contents history default)
+(defun completing-read (prompt collection &optional predicate require-match
+ initial-contents history default)
"Read a string in the minibuffer, with completion.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
-TABLE is an alist whose elements' cars are strings, or an obarray.
-TABLE can also be a function which does the completion itself.
-PREDICATE limits completion to a subset of TABLE.
-See `try-completion' and `all-completions' for more details
- on completion, TABLE, and PREDICATE.
+COLLECTION is a set of objects that are the possible completions.
+PREDICATE limits completion to a subset of COLLECTION.
+See `try-completion' and `all-completions' for details of COLLECTION,
+ PREDICATE, and completion in general.
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
- the input is (or completes to) an element of TABLE or is null.
+ the input is (or completes to) an element of COLLECTION or is null.
If it is also not t, Return does not exit if it does non-null completion.
If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
If it is (STRING . POSITION), the initial input
＠＠ -785,7 +727,7 ＠＠
Completion ignores case if the ambient value of
`completion-ignore-case' is non-nil."
- (let ((minibuffer-completion-table table)
+ (let ((minibuffer-completion-table collection)
(minibuffer-completion-predicate predicate)
(minibuffer-completion-confirm (if (eq require-match 't) nil t))
(last-exact-completion nil)
＠＠ -862,7 +804,8 ＠＠
(let ((buffer-string (buffer-string)))
;; Short-cut -- don't call minibuffer-do-completion if we already
;; have an (possibly nonunique) exact completion.
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
(throw 'exit nil))
(let ((status (minibuffer-do-completion buffer-string)))
(if (or (eq status 'unique)
＠＠ -893,7 +836,8 ＠＠
(if (not minibuffer-confirm-incomplete)
(throw 'exit nil))
(let ((buffer-string (buffer-string)))
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
(throw 'exit nil))
(let ((completion (if (not minibuffer-completion-table)
t
＠＠ -1092,6 +1036,9 ＠＠
;; prefix for other completions. This means that we
;; can't just do the obvious thing, (eq t
;; (try-completion ...)).
+ ;;
+ ;; Could be reasonable to use #'test-completion
+ ;; instead. Aidan Kehoe, Mo 14 Mai 2012 08:17:10 IST
(let (comp)
(if (and filename-kludge-p
;; #### evil evil evil evil
＠＠ -2186,7 +2133,7 ＠＠
to build a completion table.
On TTY devices, this uses `tty-color-list'.
On mswindows devices, this uses `mswindows-color-list'."
- (let ((table (read-color-completion-table)))
+ (let ((table (color-list)))
(completing-read prompt table nil (and table must-match)
initial-contents)))
diff -r 8593e614573a -r daf5accfe973 src/ChangeLog
--- a/src/ChangeLog Sat May 12 18:12:13 2012 +0100
+++ b/src/ChangeLog Mon May 14 08:46:05 2012 +0100
＠＠ -1,3 +1,8 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * minibuf.c (Ftest_completion):
+ Correct some documentation here.
+
2012-05-07 Jeff Sparkes <jsparkes(a)gmail.com>
* search.c (skip_chars): Add cast to Ibyte *.
diff -r 8593e614573a -r daf5accfe973 src/minibuf.c
--- a/src/minibuf.c Sat May 12 18:12:13 2012 +0100
+++ b/src/minibuf.c Mon May 14 08:46:05 2012 +0100
＠＠ -688,13 +688,12 ＠＠
}
DEFUN ("test-completion", Ftest_completion, 2, 3, 0, /*
-Return non-nil if STRING is a valid completion in COLLECTION.
+Return non-nil if STRING is an exact completion in COLLECTION.
COLLECTION must be a list, a hash table, an obarray, or a function.
Each string (or symbol) in COLLECTION is tested to see if it (or its
-name) begins with STRING. The value is a list of all the strings from
-COLLECTION that match.
+name) begins with STRING, until a valid, exact completion is found.
If COLLECTION is a list, the elements of the list that are not cons
cells and the cars of the elements of the list that are cons cells
＠＠ -755,7 +754,7 ＠＠
lookup, 0) ? Qnil : Qt;
/* It would be reasonable to do something similar for the hash
- tables, except, both symbol and string keys are vaild
+ tables, except, both symbol and string keys are valid
completions there. So a negative #'gethash for the string
(with #'equal as the hash table tests) still means you have
to do the linear search, for any symbols with that string
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: Use #'test-completion, minibuf.el, instead of implementing same.
12 years, 7 months
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/changeset/daf5accfe973/
changeset: daf5accfe973
user: kehoea
date: 2012-05-14 09:46:05
summary: Use #'test-completion, minibuf.el, instead of implementing same.
lisp/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
Update minibuf.el to use #'test-completion, use the generality of
recent completion changes to avoid some unnecessary consing when
reading.
* behavior.el (read-behavior):
* cus-edit.el (custom-face-prompt):
* cus-edit.el (widget-face-action):
* faces.el (read-face-name):
* minibuf.el:
* minibuf.el (minibuffer-completion-table):
* minibuf.el (exact-minibuffer-completion-p):
Removed. #'test-completion is equivalent to this, but more
general.
* minibuf.el (minibuffer-do-completion-1): Use #'test-completion.
* minibuf.el (completing-read): Update the documentation of the
arguments used for completion.
* minibuf.el (minibuffer-complete-and-exit): Use #'test-completion.
* minibuf.el (exit-minibuffer): Use #'test-completion.
* minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion.
* minibuf.el (read-color): No need to construct a completion table
separate from the colour list.
src/ChangeLog addition:
2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
* minibuf.c (Ftest_completion):
Correct some documentation here.
affected #: 7 files
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
＠＠ -1,3 +1,26 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Update minibuf.el to use #'test-completion, use the generality of
+ recent completion changes to avoid some unnecessary consing when
+ reading.
+ * behavior.el (read-behavior):
+ * cus-edit.el (custom-face-prompt):
+ * cus-edit.el (widget-face-action):
+ * faces.el (read-face-name):
+ * minibuf.el:
+ * minibuf.el (minibuffer-completion-table):
+ * minibuf.el (exact-minibuffer-completion-p):
+ Removed. #'test-completion is equivalent to this, but more
+ general.
+ * minibuf.el (minibuffer-do-completion-1): Use #'test-completion.
+ * minibuf.el (completing-read): Update the documentation of the
+ arguments used for completion.
+ * minibuf.el (minibuffer-complete-and-exit): Use #'test-completion.
+ * minibuf.el (exit-minibuffer): Use #'test-completion.
+ * minibuf.el (minibuffer-smart-mouse-tracker): Use #'test-completion.
+ * minibuf.el (read-color): No need to construct a completion table
+ separate from the colour list.
+
2012-05-12 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d lisp/behavior.el
--- a/lisp/behavior.el
+++ b/lisp/behavior.el
＠＠ -345,16 +345,10 ＠＠
for history command, and as the value to return if the user enters the
empty string."
(let ((result
- (completing-read
- prompt
- (let (list)
- (maphash #'(lambda (key value)
- (push (cons (symbol-name key) value) list))
- behavior-hash-table)
- list)
- nil must-match initial-contents (or history 'behavior-history)
- default-value)))
- (if (and result (stringp result))
+ (completing-read prompt behavior-hash-table nil must-match
+ initial-contents (or history 'behavior-history)
+ default-value)))
+ (if (stringp result)
(intern result)
result)))
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d lisp/cus-edit.el
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
＠＠ -878,10 +878,7 ＠＠
;; Make a choice only amongst the faces under point:
(let ((choice (completing-read
"Customize face: (default all faces at point) "
- (mapcar (lambda (face)
- (list (symbol-name face) face))
- faces)
- nil t)))
+ faces nil t)))
(if (eql (length choice) 0)
(list faces)
(list (intern choice)))))))))
＠＠ -2972,12 +2969,8 ＠＠
(defun widget-face-action (widget &optional event)
"Prompt for a face."
- (let ((answer (completing-read "Face: "
- (mapcar (lambda (face)
- (list (symbol-name face)))
- (face-list))
- nil nil nil
- 'face-history)))
+ (let ((answer (completing-read "Face: " (face-list) nil nil nil
+ 'face-history)))
(unless (eql (length answer) 0)
(widget-value-set widget (intern answer))
(widget-apply widget :notify widget event)
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d lisp/faces.el
--- a/lisp/faces.el
+++ b/lisp/faces.el
＠＠ -54,14 +54,10 ＠＠
Such a collection of attributes is called a \"face\"."
:group 'emacs)
-
(defun read-face-name (prompt)
(let (face)
(while (eql (length face) 0) ; nil or ""
- (setq face (completing-read prompt
- (mapcar (lambda (x) (list (symbol-name x)))
- (face-list))
- nil t)))
+ (setq face (completing-read prompt (face-list) nil t)))
(intern face)))
(defun face-interactive (what &optional bool)
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d lisp/minibuf.el
--- a/lisp/minibuf.el
+++ b/lisp/minibuf.el
＠＠ -58,18 +58,11 ＠＠
:group 'minibuffer)
(defvar minibuffer-completion-table nil
- "Alist or obarray used for completion in the minibuffer.
-This becomes the ALIST argument to `try-completion' and `all-completions'.
+ "List, hash table, function or obarray used for minibuffer completion.
-The value may alternatively be a function, which is given three arguments:
- STRING, the current buffer contents;
- PREDICATE, the predicate for filtering possible matches;
- CODE, which says what kind of things to do.
-CODE can be nil, t or `lambda'.
-nil means to return the best completion of STRING, nil if there is none,
- or t if it is already a unique completion.
-t means to return a list of all possible completions of STRING.
-`lambda' means to return t if STRING is a valid completion as it stands.")
+This becomes the COLLECTION argument to `try-completion', `all-completions'
+and `test-completion'; see the documentation of those functions for how
+values are interpreted.")
(defvar minibuffer-completion-predicate nil
"Within call to `completing-read', this holds the PREDICATE argument.")
＠＠ -621,56 +614,6 ＠＠
(setq unread-command-event (character-to-event (quit-char))
quit-flag nil)))))
-
-;; Determines whether buffer-string is an exact completion
-(defun exact-minibuffer-completion-p (buffer-string)
- (cond ((not minibuffer-completion-table)
- ;; Empty alist
- nil)
- ((vectorp minibuffer-completion-table)
- (let ((tem (intern-soft buffer-string
- minibuffer-completion-table)))
- (if (or tem
- (and (string-equal buffer-string "nil")
- ;; intern-soft loses for 'nil
- (catch 'found
- (mapatoms #'(lambda (s)
- (if (string-equal
- (symbol-name s)
- buffer-string)
- (throw 'found t)))
- minibuffer-completion-table)
- nil)))
- (if minibuffer-completion-predicate
- (funcall minibuffer-completion-predicate
- tem)
- t)
- nil)))
- ((and (consp minibuffer-completion-table)
- ;;#### Emacs-Lisp truly sucks!
- ;; lambda, autoload, etc
- (not (symbolp (car minibuffer-completion-table))))
- (if (not completion-ignore-case)
- (assoc buffer-string minibuffer-completion-table)
- (let ((s (upcase buffer-string))
- (tail minibuffer-completion-table)
- tem)
- (while tail
- (setq tem (car (car tail)))
- (if (or (equal tem buffer-string)
- (equal tem s)
- (if tem (equal (upcase tem) s)))
- (setq s 'win
- tail nil) ;exit
- (setq tail (cdr tail))))
- (eq s 'win))))
- (t
- (funcall minibuffer-completion-table
- buffer-string
- minibuffer-completion-predicate
- 'lambda)))
- )
-
;; 0 'none no possible completion
;; 1 'unique was already an exact and unique completion
;; 3 'exact was already an exact (but nonunique) completion
＠＠ -693,7 +636,8 ＠＠
(erase-buffer)
(insert completion)
(setq buffer-string completion)))
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
;; An exact completion was possible
(if completedp
;; Since no callers need to know the difference, don't bother
＠＠ -752,20 +696,18 ＠＠
;;;; completing-read
-(defun completing-read (prompt table
- &optional predicate require-match
- initial-contents history default)
+(defun completing-read (prompt collection &optional predicate require-match
+ initial-contents history default)
"Read a string in the minibuffer, with completion.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
-TABLE is an alist whose elements' cars are strings, or an obarray.
-TABLE can also be a function which does the completion itself.
-PREDICATE limits completion to a subset of TABLE.
-See `try-completion' and `all-completions' for more details
- on completion, TABLE, and PREDICATE.
+COLLECTION is a set of objects that are the possible completions.
+PREDICATE limits completion to a subset of COLLECTION.
+See `try-completion' and `all-completions' for details of COLLECTION,
+ PREDICATE, and completion in general.
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
- the input is (or completes to) an element of TABLE or is null.
+ the input is (or completes to) an element of COLLECTION or is null.
If it is also not t, Return does not exit if it does non-null completion.
If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
If it is (STRING . POSITION), the initial input
＠＠ -785,7 +727,7 ＠＠
Completion ignores case if the ambient value of
`completion-ignore-case' is non-nil."
- (let ((minibuffer-completion-table table)
+ (let ((minibuffer-completion-table collection)
(minibuffer-completion-predicate predicate)
(minibuffer-completion-confirm (if (eq require-match 't) nil t))
(last-exact-completion nil)
＠＠ -862,7 +804,8 ＠＠
(let ((buffer-string (buffer-string)))
;; Short-cut -- don't call minibuffer-do-completion if we already
;; have an (possibly nonunique) exact completion.
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
(throw 'exit nil))
(let ((status (minibuffer-do-completion buffer-string)))
(if (or (eq status 'unique)
＠＠ -893,7 +836,8 ＠＠
(if (not minibuffer-confirm-incomplete)
(throw 'exit nil))
(let ((buffer-string (buffer-string)))
- (if (exact-minibuffer-completion-p buffer-string)
+ (if (test-completion buffer-string minibuffer-completion-table
+ minibuffer-completion-predicate)
(throw 'exit nil))
(let ((completion (if (not minibuffer-completion-table)
t
＠＠ -1092,6 +1036,9 ＠＠
;; prefix for other completions. This means that we
;; can't just do the obvious thing, (eq t
;; (try-completion ...)).
+ ;;
+ ;; Could be reasonable to use #'test-completion
+ ;; instead. Aidan Kehoe, Mo 14 Mai 2012 08:17:10 IST
(let (comp)
(if (and filename-kludge-p
;; #### evil evil evil evil
＠＠ -2186,7 +2133,7 ＠＠
to build a completion table.
On TTY devices, this uses `tty-color-list'.
On mswindows devices, this uses `mswindows-color-list'."
- (let ((table (read-color-completion-table)))
+ (let ((table (color-list)))
(completing-read prompt table nil (and table must-match)
initial-contents)))
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -1,3 +1,8 ＠＠
+2012-05-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * minibuf.c (Ftest_completion):
+ Correct some documentation here.
+
2012-05-07 Jeff Sparkes <jsparkes(a)gmail.com>
* search.c (skip_chars): Add cast to Ibyte *.
diff -r 8593e614573a4a167af4d3e73201dfa46c7e30a8 -r daf5accfe9736ac481b1bdd6063d060f8b4a633d src/minibuf.c
--- a/src/minibuf.c
+++ b/src/minibuf.c
＠＠ -688,13 +688,12 ＠＠
}
DEFUN ("test-completion", Ftest_completion, 2, 3, 0, /*
-Return non-nil if STRING is a valid completion in COLLECTION.
+Return non-nil if STRING is an exact completion in COLLECTION.
COLLECTION must be a list, a hash table, an obarray, or a function.
Each string (or symbol) in COLLECTION is tested to see if it (or its
-name) begins with STRING. The value is a list of all the strings from
-COLLECTION that match.
+name) begins with STRING, until a valid, exact completion is found.
If COLLECTION is a list, the elements of the list that are not cons
cells and the cars of the elements of the list that are cons cells
＠＠ -755,7 +754,7 ＠＠
lookup, 0) ? Qnil : Qt;
/* It would be reasonable to do something similar for the hash
- tables, except, both symbol and string keys are vaild
+ tables, except, both symbol and string keys are valid
completions there. So a negative #'gethash for the string
(with #'equal as the hash table tests) still means you have
to do the linear search, for any symbols with that string
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/xemacs-packages: 3 new changesets
12 years, 7 months
Bitbucket
Bitbucket
3 new commits in xemacs-packages:
https://bitbucket.org/xemacs/xemacs-packages/changeset/df2b8f6bfdca/
changeset: df2b8f6bfdca
user: Norbert Koch
date: 2012-05-14 09:15:21
summary: update prog-modes
affected #: 1 file
diff -r e72f7699b5466b57d4fd4ee3f8238c5600f788c9 -r df2b8f6bfdca197d2ed9793b48c270ba88c732cc .hgsubstate
--- a/.hgsubstate
+++ b/.hgsubstate
＠＠ -83,7 +83,7 ＠＠
bb764ada03558fbbb5453138c6437513fdea84bf xemacs-packages/pcomplete
be87a7f039ffe86a1129c8e37633de2d45c484c5 xemacs-packages/perl-modes
f937cd3de668adac94e4969c606c6bb90c750ac0 xemacs-packages/pgg
-af4ec0ea580ffa8f1579adb80742c36c22e605f8 xemacs-packages/prog-modes
+a246dff1f05567a1054fc4d870c9f7ea6db09705 xemacs-packages/prog-modes
a4fa5060de96681c204e05aa56c8b6c39d55055f xemacs-packages/ps-print
d0a307d344ea9cf04d68284fcb68be2f7686866a xemacs-packages/ps-print-nomule
3e112e0ce8588d4e0631f32692ae169f19ee4b42 xemacs-packages/psgml
https://bitbucket.org/xemacs/xemacs-packages/changeset/6ff97e6525c3/
changeset: 6ff97e6525c3
user: Norbert Koch
date: 2012-05-14 09:16:02
summary: XEmacs Package Release
affected #: 1 file
diff -r df2b8f6bfdca197d2ed9793b48c270ba88c732cc -r 6ff97e6525c3e4b759f89a888fec5b38e421fef4 ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
＠＠ -1,3 +1,7 ＠＠
+2012-05-14 Norbert Koch <viteno(a)xemacs.org>
+
+ * Packages released: prog-modes.
+
2012-05-11 Norbert Koch <viteno(a)xemacs.org>
* Packages released: xemacs-base.
https://bitbucket.org/xemacs/xemacs-packages/changeset/743cf26d6019/
changeset: 743cf26d6019
user: Norbert Koch
date: 2012-05-14 09:21:56
summary: Prerelease prog-modes
affected #: 1 file
diff -r 6ff97e6525c3e4b759f89a888fec5b38e421fef4 -r 743cf26d6019c985e998df8de7c377df58f6b79f .hgsubstate
--- a/.hgsubstate
+++ b/.hgsubstate
＠＠ -83,7 +83,7 ＠＠
bb764ada03558fbbb5453138c6437513fdea84bf xemacs-packages/pcomplete
be87a7f039ffe86a1129c8e37633de2d45c484c5 xemacs-packages/perl-modes
f937cd3de668adac94e4969c606c6bb90c750ac0 xemacs-packages/pgg
-a246dff1f05567a1054fc4d870c9f7ea6db09705 xemacs-packages/prog-modes
+2ced404880d95a9bcbd996948643136770cfd8fb xemacs-packages/prog-modes
a4fa5060de96681c204e05aa56c8b6c39d55055f xemacs-packages/ps-print
d0a307d344ea9cf04d68284fcb68be2f7686866a xemacs-packages/ps-print-nomule
3e112e0ce8588d4e0631f32692ae169f19ee4b42 xemacs-packages/psgml
Repository URL: https://bitbucket.org/xemacs/xemacs-packages/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/prog-modes: 2 new changesets
12 years, 7 months
Bitbucket
Bitbucket
2 new commits in prog-modes:
https://bitbucket.org/xemacs/prog-modes/changeset/367ebc30d292/
changeset: 367ebc30d292
user: Norbert Koch
date: 2012-05-14 09:16:01
summary: XEmacs Package Release 2.26
affected #: 2 files
diff -r a246dff1f05567a1054fc4d870c9f7ea6db09705 -r 367ebc30d2921dbb5f56367f8febbdfb7828489b ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
＠＠ -1,3 +1,7 ＠＠
+2012-05-14 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 2.26 released.
+
2012-05-13 Mats Lidell <matsl(a)xemacs.org>
* prog-modes.texi (go-mode): New mode for Go source.
diff -r a246dff1f05567a1054fc4d870c9f7ea6db09705 -r 367ebc30d2921dbb5f56367f8febbdfb7828489b Makefile
--- a/Makefile
+++ b/Makefile
＠＠ -17,7 +17,7 ＠＠
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
-VERSION = 2.25
+VERSION = 2.26
AUTHOR_VERSION =
MAINTAINER = XEmacs Development Team <xemacs-beta(a)xemacs.org>
PACKAGE = prog-modes
https://bitbucket.org/xemacs/prog-modes/changeset/2ced404880d9/
changeset: 2ced404880d9
user: Norbert Koch
date: 2012-05-14 09:16:02
summary: Added tag prog-modes-2_26 for changeset 367ebc30d292
affected #: 1 file
diff -r 367ebc30d2921dbb5f56367f8febbdfb7828489b -r 2ced404880d95a9bcbd996948643136770cfd8fb .hgtags
--- a/.hgtags
+++ b/.hgtags
＠＠ -148,3 +148,4 ＠＠
147fe6a7028e6b25ba63164d86cf7ca3d93ab9e8 xemacs-sumo-2001-07-08
4e19e6180dde2e12620a3f810c614505e8b5a437 sumo-2003-02-05
c67d1a294c973add2253898c2c675215d847bb2e sumo-2006-05-10
+367ebc30d2921dbb5f56367f8febbdfb7828489b prog-modes-2_26
Repository URL: https://bitbucket.org/xemacs/prog-modes/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT PROG-MODES] Added go-mode.el
12 years, 7 months
The XEmacs Package Smoketest
The XEmacs Package Smoketest
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Mats Lidell <matsl(a)xemacs.org>
# Date 1336937625 -7200
# Node ID a246dff1f05567a1054fc4d870c9f7ea6db09705
# Parent 9a5e5e7332618c86410233a50441d7a58cc62848
Added go-mode.el
diff -r 9a5e5e733261 -r a246dff1f055 ChangeLog
--- a/ChangeLog Fri Dec 23 11:41:10 2011 -0500
+++ b/ChangeLog Sun May 13 21:33:45 2012 +0200
＠＠ -1,3 +1,8 ＠＠
+2012-05-13 Mats Lidell <matsl(a)xemacs.org>
+
+ * prog-modes.texi (go-mode): New mode for Go source.
+ * go-mode.el: New.
+
2011-12-22 Vin Shelton <acs(a)xemacs.org>
* verilog-mode.el (verilog-mode-version):
diff -r 9a5e5e733261 -r a246dff1f055 Makefile
--- a/Makefile Fri Dec 23 11:41:10 2011 -0500
+++ b/Makefile Sun May 13 21:33:45 2012 +0200
＠＠ -34,7 +34,7 ＠＠
postscript.elc prolog.elc rexx-mode.elc simula.elc \
sql.elc tcl.elc teco.elc verilog-mode.elc vrml-mode.elc p4.elc \
old-c-mode.elc php-mode.elc javascript-mode.elc \
- rpm-spec-mode.elc uil-mode.elc
+ rpm-spec-mode.elc uil-mode.elc go-mode.elc
STANDARD_DOCS = t
diff -r 9a5e5e733261 -r a246dff1f055 go-mode.el
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/go-mode.el Sun May 13 21:33:45 2012 +0200
＠＠ -0,0 +1,860 ＠＠
+;;; go-mode.el --- Major mode for the Go programming language
+
+;; Copyright (c) 2012 The Go Authors. All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following disclaimer
+;; in the documentation and/or other materials provided with the
+;; distribution.
+;; * Neither the name of Google Inc. nor the names of its
+;; contributors may be used to endorse or promote products derived from
+;; this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Synced up with: upstream go-mode.el 13182:9d6693456f93
+
+;;; Commentary:
+
+;; For installation instructions, see go-mode-load.el
+
+;;; To do:
+
+;; * Indentation is *almost* identical to gofmt
+;; ** We think struct literal keys are labels and outdent them
+;; ** We disagree on the indentation of function literals in arguments
+;; ** There are bugs with the close brace of struct literals
+;; * Highlight identifiers according to their syntactic context: type,
+;; variable, function call, or tag
+;; * Command for adding an import
+;; ** Check if it's already there
+;; ** Factor/unfactor the import line
+;; ** Alphabetize
+;; * Remove unused imports
+;; ** This is hard, since I have to be aware of shadowing to do it
+;; right
+;; * Format region using gofmt
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar go-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; Add _ to :word: character class
+ (modify-syntax-entry ?_ "w" st)
+
+ ;; Operators (punctuation)
+ (modify-syntax-entry ?+ "." st)
+ (modify-syntax-entry ?- "." st)
+ (modify-syntax-entry ?* ". 23" st) ; also part of comments
+ (modify-syntax-entry ?/ (if (featurep 'xemacs) ". 1456" ". 124b") st) ; ditto
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?& "." st)
+ (modify-syntax-entry ?| "." st)
+ (modify-syntax-entry ?^ "." st)
+ (modify-syntax-entry ?! "." st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+
+ ;; Strings and comments are font-locked separately.
+ (modify-syntax-entry ?\" "." st)
+ (modify-syntax-entry ?\' "." st)
+ (modify-syntax-entry ?` "." st)
+ (modify-syntax-entry ?\\ "." st)
+
+ ;; Newline is a comment-ender.
+ (modify-syntax-entry ?\n "> b" st)
+
+ st)
+ "Syntax table for Go mode.")
+
+(defvar go-mode-keywords
+ '("break" "default" "func" "interface" "select"
+ "case" "defer" "go" "map" "struct"
+ "chan" "else" "goto" "package" "switch"
+ "const" "fallthrough" "if" "range" "type"
+ "continue" "for" "import" "return" "var")
+ "All keywords in the Go language. Used for font locking and
+some syntax analysis.")
+
+(defvar go-mode-font-lock-keywords
+ (let ((builtins '("append" "cap" "close" "complex" "copy" "delete" "imag" "len"
+ "make" "new" "panic" "print" "println" "real" "recover"))
+ (constants '("nil" "true" "false" "iota"))
+ (type-name "\\s *\\(?:[*(]\\s *\\)*\\(?:\\w+\\s *\\.\\s *\\)?\\(\\w+\\)")
+ )
+ `((go-mode-font-lock-cs-comment 0 font-lock-comment-face t)
+ (go-mode-font-lock-cs-string 0 font-lock-string-face t)
+ (,(regexp-opt go-mode-keywords 'words) . font-lock-keyword-face)
+ (,(regexp-opt builtins 'words) . font-lock-builtin-face)
+ (,(regexp-opt constants 'words) . font-lock-constant-face)
+ ;; Function names in declarations
+ ("\\<func\\>\\s *\\(\\w+\\)" 1 font-lock-function-name-face)
+ ;; Function names in methods are handled by function call pattern
+ ;; Function names in calls
+ ;; XXX Doesn't match if function name is surrounded by parens
+ ("\\(\\w+\\)\\s *(" 1 font-lock-function-name-face)
+ ;; Type names
+ ("\\<type\\>\\s *\\(\\w+\\)" 1 font-lock-type-face)
+ (,(concat "\\<type\\>\\s *\\w+\\s *" type-name) 1 font-lock-type-face)
+ ;; Arrays/slices/map value type
+ ;; XXX Wrong. Marks 0 in expression "foo[0] * x"
+ ;; (,(concat "]" type-name) 1 font-lock-type-face)
+ ;; Map key type
+ (,(concat "\\<map\\s *\\[" type-name) 1 font-lock-type-face)
+ ;; Channel value type
+ (,(concat "\\<chan\\>\\s *\\(?:<-\\)?" type-name) 1 font-lock-type-face)
+ ;; new/make type
+ (,(concat "\\<\\(?:new\\|make\\)\\>\\(?:\\s \\|)\\)*(" type-name) 1 font-lock-type-face)
+ ;; Type conversion
+ (,(concat "\\.\\s *(" type-name) 1 font-lock-type-face)
+ ;; Method receiver type
+ (,(concat "\\<func\\>\\s *(\\w+\\s +" type-name) 1 font-lock-type-face)
+ ;; Labels
+ ;; XXX Not quite right. Also marks compound literal fields.
+ ("^\\s *\\(\\w+\\)\\s *:\\(\\S.\\|$\\)" 1 font-lock-constant-face)
+ ("\\<\\(goto\\|break\\|continue\\)\\>\\s *\\(\\w+\\)" 2 font-lock-constant-face)))
+ "Basic font lock keywords for Go mode. Highlights keywords,
+built-ins, functions, and some types.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Key map
+;;
+
+(defvar go-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "}" #'go-mode-insert-and-indent)
+ (define-key m ")" #'go-mode-insert-and-indent)
+ (define-key m "," #'go-mode-insert-and-indent)
+ (define-key m ":" #'go-mode-delayed-electric)
+ ;; In case we get : indentation wrong, correct ourselves
+ (define-key m "=" #'go-mode-insert-and-indent)
+ m)
+ "Keymap used by Go mode to implement electric keys.")
+
+(defun go-mode-insert-and-indent (key)
+ "Invoke the global binding of KEY, then reindent the line."
+
+ (interactive (list (this-command-keys)))
+ (call-interactively (lookup-key (current-global-map) key))
+ (indent-according-to-mode))
+
+(defvar go-mode-delayed-point nil
+ "The point following the previous insertion if the insertion
+was a delayed electric key. Used to communicate between
+`go-mode-delayed-electric' and `go-mode-delayed-electric-hook'.")
+(make-variable-buffer-local 'go-mode-delayed-point)
+
+(defun go-mode-delayed-electric (p)
+ "Perform electric insertion, but delayed by one event.
+
+This inserts P into the buffer, as usual, then waits for another key.
+If that second key causes a buffer modification starting at the
+point after the insertion of P, reindents the line containing P."
+
+ (interactive "p")
+ (self-insert-command p)
+ (setq go-mode-delayed-point (point)))
+
+(defun go-mode-delayed-electric-hook (b e l)
+ "An after-change-function that implements `go-mode-delayed-electric'."
+
+ (when (and go-mode-delayed-point
+ (= go-mode-delayed-point b))
+ (save-excursion
+ (save-match-data
+ (goto-char go-mode-delayed-point)
+ (indent-according-to-mode))))
+ (setq go-mode-delayed-point nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parser
+;;
+
+(defvar go-mode-mark-cs-end 1
+ "The point at which the comment/string cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-cs-end)).")
+(make-variable-buffer-local 'go-mode-mark-cs-end)
+
+(defvar go-mode-mark-string-end 1
+ "The point at which the string cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-string-end)).")
+(make-variable-buffer-local 'go-mode-mark-string-end)
+
+(defvar go-mode-mark-comment-end 1
+ "The point at which the comment cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-comment-end)).")
+(make-variable-buffer-local 'go-mode-mark-comment-end)
+
+(defvar go-mode-mark-nesting-end 1
+ "The point at which the nesting cache ends. The buffer will be
+marked from the beginning up to this point.")
+(make-variable-buffer-local 'go-mode-mark-nesting-end)
+
+(defun go-mode-mark-clear-cache (b e)
+ "A before-change-function that clears the comment/string and
+nesting caches from the modified point on."
+
+ (save-restriction
+ (widen)
+ (when (<= b go-mode-mark-cs-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-cs)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-cs-end (point-max)) '(go-mode-cs nil))
+ (setq go-mode-mark-cs-end b)))
+
+ (when (<= b go-mode-mark-string-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-string)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-string-end (point-max)) '(go-mode-string nil))
+ (setq go-mode-mark-string-end b)))
+ (when (<= b go-mode-mark-comment-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-comment)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-string-end (point-max)) '(go-mode-comment nil))
+ (setq go-mode-mark-comment-end b)))
+
+ (when (< b go-mode-mark-nesting-end)
+ (remove-text-properties b (min go-mode-mark-nesting-end (point-max)) '(go-mode-nesting nil))
+ (setq go-mode-mark-nesting-end b))))
+
+(defmacro go-mode-parser (&rest body)
+ "Evaluate BODY in an environment set up for parsers that use
+text properties to mark text. This inhibits changes to the undo
+list or the buffer's modification status and inhibits calls to
+the modification hooks. It also saves the excursion and
+restriction and widens the buffer, since most parsers are
+context-sensitive."
+
+ (let ((modified-var (make-symbol "modified")))
+ `(let ((buffer-undo-list t)
+ (,modified-var (buffer-modified-p))
+ (inhibit-modification-hooks t)
+ (inhibit-read-only t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (unwind-protect
+ (progn ,＠body)
+ (set-buffer-modified-p ,modified-var)))))))
+
+(defun go-mode-cs (&optional pos)
+ "Return the comment/string state at point POS. If point is
+inside a comment or string (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-cs-end)
+ (go-mode-mark-cs pos))
+ (get-text-property pos 'go-mode-cs))
+
+(defun go-mode-mark-cs (end)
+ "Mark comments and strings up to point END. Don't call this
+directly; use `go-mode-cs'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-cs
+ (and (> go-mode-mark-cs-end 1)
+ (get-text-property (1- go-mode-mark-cs-end)
+ 'go-mode-cs))))
+ (if last-cs
+ (car last-cs)
+ (max 1 (1- go-mode-mark-cs-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((cs-end ; end of the text property
+ (cond
+ ((looking-at "//")
+ (end-of-line)
+ (1+ (point)))
+ ((looking-at "/\\*")
+ (goto-char (+ pos 2))
+ (if (search-forward "*/" (1+ end) t)
+ (point)
+ end))
+ ((looking-at "\"")
+ (goto-char (1+ pos))
+ (if (looking-at "[^\"\n\\\\]*\\(\\\\.[^\"\n\\\\]*\\)*\"")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "'")
+ (goto-char (1+ pos))
+ (if (looking-at "[^'\n\\\\]*\\(\\\\.[^'\n\\\\]*\\)*'")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "`")
+ (goto-char (1+ pos))
+ (while (if (search-forward "`" end t)
+ (if (eq (char-after) ?`)
+ (goto-char (1+ (point))))
+ (goto-char end)
+ nil))
+ (point)))))
+ (cond
+ (cs-end
+ (put-text-property pos cs-end 'go-mode-cs (cons pos cs-end))
+ (setq pos cs-end))
+ ((re-search-forward "[\"'`]\\|/[/*]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-cs-end pos)))))
+
+(defun go-mode-in-comment (&optional pos)
+ "Return the comment/string state at point POS. If point is
+inside a comment (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-comment-end)
+ (go-mode-mark-comment pos))
+ (get-text-property pos 'go-mode-comment))
+
+(defun go-mode-mark-comment (end)
+ "Mark comments up to point END. Don't call this directly; use `go-mode-in-comment'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-comment
+ (and (> go-mode-mark-comment-end 1)
+ (get-text-property (1- go-mode-mark-comment-end)
+ 'go-mode-comment))))
+ (if last-comment
+ (car last-comment)
+ (max 1 (1- go-mode-mark-comment-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((comment-end ; end of the text property
+ (cond
+ ((looking-at "//")
+ (end-of-line)
+ (1+ (point)))
+ ((looking-at "/\\*")
+ (goto-char (+ pos 2))
+ (if (search-forward "*/" (1+ end) t)
+ (point)
+ end)))))
+ (cond
+ (comment-end
+ (put-text-property pos comment-end 'go-mode-comment (cons pos comment-end))
+ (setq pos comment-end))
+ ((re-search-forward "/[/*]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-comment-end pos)))))
+
+(defun go-mode-in-string (&optional pos)
+ "Return the string state at point POS. If point is
+inside a string (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-string-end)
+ (go-mode-mark-string pos))
+ (get-text-property pos 'go-mode-string))
+
+(defun go-mode-mark-string (end)
+ "Mark strings up to point END. Don't call this
+directly; use `go-mode-in-string'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-cs
+ (and (> go-mode-mark-string-end 1)
+ (get-text-property (1- go-mode-mark-string-end)
+ 'go-mode-string))))
+ (if last-cs
+ (car last-cs)
+ (max 1 (1- go-mode-mark-string-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((cs-end ; end of the text property
+ (cond
+ ((looking-at "\"")
+ (goto-char (1+ pos))
+ (if (looking-at "[^\"\n\\\\]*\\(\\\\.[^\"\n\\\\]*\\)*\"")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "'")
+ (goto-char (1+ pos))
+ (if (looking-at "[^'\n\\\\]*\\(\\\\.[^'\n\\\\]*\\)*'")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "`")
+ (goto-char (1+ pos))
+ (while (if (search-forward "`" end t)
+ (if (eq (char-after) ?`)
+ (goto-char (1+ (point))))
+ (goto-char end)
+ nil))
+ (point)))))
+ (cond
+ (cs-end
+ (put-text-property pos cs-end 'go-mode-string (cons pos cs-end))
+ (setq pos cs-end))
+ ((re-search-forward "[\"'`]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-string-end pos)))))
+
+(defun go-mode-font-lock-cs (limit comment)
+ "Helper function for highlighting comment/strings. If COMMENT is t,
+set match data to the next comment after point, and advance point
+after it. If COMMENT is nil, use the next string. Returns nil
+if no further tokens of the type exist."
+ ;; Ensures that `next-single-property-change' below will work properly.
+ (go-mode-cs limit)
+ (let (cs next (result 'scan))
+ (while (eq result 'scan)
+ (if (or (>= (point) limit) (eobp))
+ (setq result nil)
+ (setq cs (go-mode-cs))
+ (if cs
+ (if (eq (= (char-after (car cs)) ?/) comment)
+ ;; If inside the expected comment/string, highlight it.
+ (progn
+ ;; If the match includes a "\n", we have a
+ ;; multi-line construct. Mark it as such.
+ (goto-char (car cs))
+ (when (search-forward "\n" (cdr cs) t)
+ (put-text-property
+ (car cs) (cdr cs) 'font-lock-multline t))
+ (set-match-data (list (car cs) (copy-marker (cdr cs))))
+ (goto-char (cdr cs))
+ (setq result t))
+ ;; Wrong type. Look for next comment/string after this one.
+ (goto-char (cdr cs)))
+ ;; Not inside comment/string. Search for next comment/string.
+ (setq next (next-single-property-change
+ (point) 'go-mode-cs nil limit))
+ (if (and next (< next limit))
+ (goto-char next)
+ (setq result nil)))))
+ result))
+
+(defun go-mode-font-lock-cs-string (limit)
+ "Font-lock iterator for strings."
+ (go-mode-font-lock-cs limit nil))
+
+(defun go-mode-font-lock-cs-comment (limit)
+ "Font-lock iterator for comments."
+ (go-mode-font-lock-cs limit t))
+
+(defsubst go-mode-nesting (&optional pos)
+ "Return the nesting at point POS. The nesting is a list
+of (START . END) pairs for all braces, parens, and brackets
+surrounding POS, starting at the inner-most nesting. START is
+the location of the open character. END is the location of the
+close character or nil if the nesting scanner has not yet
+encountered the close character."
+
+ (unless pos
+ (setq pos (point)))
+ (if (= pos 1)
+ '()
+ (when (> pos go-mode-mark-nesting-end)
+ (go-mode-mark-nesting pos))
+ (get-text-property (- pos 1) 'go-mode-nesting)))
+
+(defun go-mode-mark-nesting (pos)
+ "Mark nesting up to point END. Don't call this directly; use
+`go-mode-nesting'."
+
+ (go-mode-cs pos)
+ (go-mode-parser
+ ;; Mark depth
+ (goto-char go-mode-mark-nesting-end)
+ (let ((nesting (go-mode-nesting))
+ (last (point)))
+ (while (< last pos)
+ ;; Find the next depth-changing character
+ (skip-chars-forward "^(){}[]" pos)
+ ;; Mark everything up to this character with the current
+ ;; nesting
+ (put-text-property last (point) 'go-mode-nesting nesting)
+ (when nil
+ (let ((depth (length nesting)))
+ (put-text-property last (point) 'face
+ `((:background
+ ,(format "gray%d" (* depth 10)))))))
+ (setq last (point))
+ ;; Update nesting
+ (unless (eobp)
+ (let ((ch (unless (go-mode-cs) (char-after))))
+ (forward-char 1)
+ (case ch
+ ((?\( ?\{ ?\[)
+ (setq nesting (cons (cons (- (point) 1) nil)
+ nesting)))
+ ((?\) ?\} ?\])
+ (when nesting
+ (setcdr (car nesting) (- (point) 1))
+ (setq nesting (cdr nesting))))))))
+ ;; Update state
+ (setq go-mode-mark-nesting-end last))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Indentation
+;;
+
+(defvar go-mode-non-terminating-keywords-regexp
+ (let* ((kws go-mode-keywords)
+ (kws (remove "break" kws))
+ (kws (remove "continue" kws))
+ (kws (remove "fallthrough" kws))
+ (kws (remove "return" kws)))
+ (regexp-opt kws 'words))
+ "Regular expression matching all Go keywords that *do not*
+implicitly terminate a statement.")
+
+(defun go-mode-semicolon-p ()
+ "True iff point immediately follows either an explicit or
+implicit semicolon. Point should immediately follow the last
+token on the line."
+
+ ;; #Semicolons
+ (case (char-before)
+ ((?\;) t)
+ ;; String literal
+ ((?' ?\" ?`) t)
+ ;; One of the operators and delimiters ++, --, ), ], or }
+ ((?+) (eq (char-before (1- (point))) ?+))
+ ((?-) (eq (char-before (1- (point))) ?-))
+ ((?\) ?\] ?\}) t)
+ ;; An identifier or one of the keywords break, continue,
+ ;; fallthrough, or return or a numeric literal
+ (otherwise
+ (save-excursion
+ (when (/= (skip-chars-backward "[:word:]_") 0)
+ (not (looking-at go-mode-non-terminating-keywords-regexp)))))))
+
+(defun go-mode-whitespace-p (char)
+ "Is newline, or char whitespace in the syntax table for go."
+ (or (eq char ?\n)
+ (= (char-syntax char) ?\ )))
+
+(defun go-mode-backward-skip-comments ()
+ "Skip backward over comments and whitespace."
+ ;; only proceed if point is in a comment or white space
+ (if (or (go-mode-in-comment)
+ (go-mode-whitespace-p (char-after (point))))
+ (let ((loop-guard t))
+ (while (and
+ loop-guard
+ (not (bobp)))
+
+ (cond ((go-mode-whitespace-p (char-after (point)))
+ ;; moves point back over any whitespace
+ (re-search-backward "[^[:space:]]"))
+
+ ((go-mode-in-comment)
+ ;; move point to char preceeding current comment
+ (goto-char (1- (car (go-mode-in-comment)))))
+
+ ;; not in a comment or whitespace? we must be done.
+ (t (setq loop-guard nil)
+ (forward-char 1)))))))
+
+(defun go-mode-indentation ()
+ "Compute the ideal indentation level of the current line.
+
+To the first order, this is the brace depth of the current line,
+plus parens that follow certain keywords. case, default, and
+labels are outdented one level, and continuation lines are
+indented one level."
+
+ (save-excursion
+ (back-to-indentation)
+ (let ((cs (go-mode-cs)))
+ ;; Treat comments and strings differently only if the beginning
+ ;; of the line is contained within them
+ (when (and cs (= (point) (car cs)))
+ (setq cs nil))
+ ;; What type of context am I in?
+ (cond
+ ((and cs (save-excursion
+ (goto-char (car cs))
+ (looking-at "\\s\"")))
+ ;; Inside a multi-line string. Don't mess with indentation.
+ nil)
+ (cs
+ ;; Inside a general comment
+ (goto-char (car cs))
+ (forward-char 1)
+ (current-column))
+ (t
+ ;; Not in a multi-line string or comment
+ (let ((indent 0)
+ (inside-indenting-paren nil))
+ ;; Count every enclosing brace, plus parens that follow
+ ;; import, const, var, or type and indent according to
+ ;; depth. This simple rule does quite well, but also has a
+ ;; very large extent. It would be better if we could mimic
+ ;; some nearby indentation.
+ (save-excursion
+ (skip-chars-forward "})")
+ (let ((first t))
+ (dolist (nest (go-mode-nesting))
+ (case (char-after (car nest))
+ ((?\{)
+ (incf indent tab-width))
+ ((?\()
+ (goto-char (car nest))
+ (go-mode-backward-skip-comments)
+ (backward-char)
+ ;; Really just want the token before
+ (when (looking-back "\\<import\\|const\\|var\\|type\\|package"
+ (max (- (point) 7) (point-min)))
+ (incf indent tab-width)
+ (when first
+ (setq inside-indenting-paren t)))))
+ (setq first nil))))
+
+ ;; case, default, and labels are outdented 1 level
+ (when (looking-at "\\<case\\>\\|\\<default\\>\\|\\w+\\s *:\\(\\S.\\|$\\)")
+ (decf indent tab-width))
+
+ (when (looking-at "\\w+\\s *:.+,\\s *$")
+ (incf indent tab-width))
+
+ ;; Continuation lines are indented 1 level
+ (beginning-of-line) ; back up to end of previous line
+ (backward-char)
+ (go-mode-backward-skip-comments) ; back up past any comments
+ (when (case (char-before)
+ ((nil ?\{ ?:)
+ ;; At the beginning of a block or the statement
+ ;; following a label.
+ nil)
+ ((?\()
+ ;; Usually a continuation line in an expression,
+ ;; unless this paren is part of a factored
+ ;; declaration.
+ (not inside-indenting-paren))
+ ((?,)
+ ;; Could be inside a literal. We're a little
+ ;; conservative here and consider any comma within
+ ;; curly braces (as opposed to parens) to be a
+ ;; literal separator. This will fail to recognize
+ ;; line-breaks in parallel assignments as
+ ;; continuation lines.
+ (let ((depth (go-mode-nesting)))
+ (and depth
+ (not (eq (char-after (caar depth)) ?\{)))))
+ (t
+ ;; We're in the middle of a block. Did the
+ ;; previous line end with an implicit or explicit
+ ;; semicolon?
+ (not (go-mode-semicolon-p))))
+ (incf indent tab-width))
+
+ (max indent 0)))))))
+
+(defun go-mode-indent-line ()
+ "Indent the current line according to `go-mode-indentation'."
+ (interactive)
+
+ ;; turn off case folding to distinguish keywords from identifiers
+ ;; e.g. "default" is a keyword; "Default" can be a variable name.
+ (let ((case-fold-search nil))
+ (let ((col (go-mode-indentation)))
+ (when col
+ (let ((offset (- (current-column) (current-indentation))))
+ (indent-line-to col)
+ (when (> offset 0)
+ (forward-char offset)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Go mode
+;;
+
+;;;###autoload
+(define-derived-mode go-mode nil "Go"
+ "Major mode for editing Go source text.
+
+This provides basic syntax highlighting for keywords, built-ins,
+functions, and some types. It also provides indentation that is
+\(almost) identical to gofmt."
+
+ ;; Font lock
+ (set (make-local-variable 'font-lock-defaults)
+ '(go-mode-font-lock-keywords nil nil nil nil))
+
+ ;; Remove stale text properties
+ (save-restriction
+ (widen)
+ (remove-text-properties 1 (point-max)
+ '(go-mode-cs nil go-mode-nesting nil)))
+
+ ;; Reset the syntax mark caches
+ (setq go-mode-mark-cs-end 1
+ go-mode-mark-nesting-end 1)
+ (add-hook 'before-change-functions #'go-mode-mark-clear-cache nil t)
+
+ ;; Indentation
+ (set (make-local-variable 'indent-line-function)
+ #'go-mode-indent-line)
+ (add-hook 'after-change-functions #'go-mode-delayed-electric-hook nil t)
+
+ ;; Comments
+ (set (make-local-variable 'comment-start) "// ")
+ (set (make-local-variable 'comment-end) "")
+
+ ;; Go style
+ (setq indent-tabs-mode t))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist (cons "\\.go$" #'go-mode))
+
+(defun go-mode-reload ()
+ "Reload go-mode.el and put the current buffer into Go mode.
+Useful for development work."
+
+ (interactive)
+ (unload-feature 'go-mode)
+ (require 'go-mode)
+ (go-mode))
+
+;;;###autoload
+(defun gofmt ()
+ "Pipe the current buffer through the external tool `gofmt`.
+Replace the current buffer on success; display errors on failure."
+
+ (interactive)
+ (let ((currconf (current-window-configuration)))
+ (let ((srcbuf (current-buffer)))
+ (with-temp-buffer
+ (let ((outbuf (current-buffer))
+ (errbuf (get-buffer-create "*Gofmt Errors*"))
+ (coding-system-for-read 'utf-8) ;; use utf-8 with subprocesses
+ (coding-system-for-write 'utf-8))
+ (with-current-buffer errbuf (erase-buffer))
+ (with-current-buffer srcbuf
+ (save-restriction
+ (let (deactivate-mark)
+ (widen)
+ (if (= 0 (shell-command-on-region (point-min) (point-max) "gofmt"
+ outbuf nil errbuf))
+ ;; restore window config
+ ;; gofmt succeeded: replace the current buffer with outbuf,
+ ;; restore the mark and point, and discard errbuf.
+ (let ((old-mark (mark t))
+ (old-point (point))
+ (old-start (window-start)))
+ (erase-buffer)
+ (insert-buffer-substring outbuf)
+ (set-window-configuration currconf)
+ (set-window-start (selected-window) (min old-start (point-max)))
+ (goto-char (min old-point (point-max)))
+ (if old-mark (push-mark (min old-mark (point-max)) t))
+ (kill-buffer errbuf))
+
+ ;; gofmt failed: display the errors
+ (display-buffer errbuf)))))
+
+ ;; Collapse any window opened on outbuf if shell-command-on-region
+ ;; displayed it.
+ (delete-windows-on outbuf))))))
+
+;;;###autoload
+(defun gofmt-before-save ()
+ "Add this to .emacs to run gofmt on the current buffer when saving:
+ (add-hook 'before-save-hook #'gofmt-before-save)"
+
+ (interactive)
+ (when (eq major-mode 'go-mode) (gofmt)))
+
+(defun godoc-read-query ()
+ "Read a godoc query from the minibuffer."
+ ;; Compute the default query as the symbol under the cursor.
+ ;; TODO: This does the wrong thing for e.g. multipart.NewReader (it only grabs
+ ;; half) but I see no way to disambiguate that from e.g. foobar.SomeMethod.
+ (let* ((bounds (bounds-of-thing-at-point 'symbol))
+ (symbol (if bounds
+ (buffer-substring-no-properties (car bounds)
+ (cdr bounds)))))
+ (read-string (if symbol
+ (format "godoc (default %s): " symbol)
+ "godoc: ")
+ nil nil symbol)))
+
+(defun godoc-get-buffer (query)
+ "Get an empty buffer for a godoc query."
+ (let* ((buffer-name (concat "*godoc " query "*"))
+ (buffer (get-buffer buffer-name)))
+ ;; Kill the existing buffer if it already exists.
+ (when buffer (kill-buffer buffer))
+ (get-buffer-create buffer-name)))
+
+(defun godoc-buffer-sentinel (proc event)
+ "Sentinel function run when godoc command completes."
+ (with-current-buffer (process-buffer proc)
+ (cond ((string= event "finished\n") ;; Successful exit.
+ (goto-char (point-min))
+ (display-buffer (current-buffer) 'not-this-window))
+ ((not (= (process-exit-status proc) 0)) ;; Error exit.
+ (let ((output (buffer-string)))
+ (kill-buffer (current-buffer))
+ (message (concat "godoc: " output)))))))
+
+;;;###autoload
+(defun godoc (query)
+ "Show go documentation for a query, much like M-x man."
+ (interactive (list (godoc-read-query)))
+ (unless (string= query "")
+ (set-process-sentinel
+ (start-process-shell-command "godoc" (godoc-get-buffer query)
+ (concat "godoc " query))
+ 'godoc-buffer-sentinel)
+ nil))
+
+(provide 'go-mode)
diff -r 9a5e5e733261 -r a246dff1f055 prog-modes.texi
--- a/prog-modes.texi Fri Dec 23 11:41:10 2011 -0500
+++ b/prog-modes.texi Sun May 13 21:33:45 2012 +0200
＠＠ -3,6 +3,7 ＠＠
＠c Copyright (C) 2002, 2003 Free Software Foundation, Inc.
＠c Copyright (C) 2003 Jake Colman <jake.colman(a)xemacs.org>
＠c Copyright (C) 2004 Ville Skytt~ <scop(a)xemacs.org>
+＠c Copyright (C) 2012 Mats Lidell <matsl(a)xemacs.org>
＠c
＠c ＠setfilename prog-modes.info
＠settitle Programming Modes for XEmacs
＠＠ -67,6 +68,7 ＠＠
* cvs:: Light CVS Support
* diff-mode:: Viewing and Editing Context Diffs
* eiffel:: Editing Eiffel Code
+* go-mode:: Editing Go Code
* icon:: Editing Icon Code
* javascript-mode:: Editing JavaScript Code
* ksh-mode:: Editing Shell Script (sh, ksh, bash) Code
＠＠ -388,7 +390,7 ＠＠
M-x customize-group RET diff-mode RET
＠end example
-＠node eiffel, icon, diff-mode, Top
+＠node eiffel, go-mode, diff-mode, Top
＠chapter Editing Eiffel Code
This mode is used for editing Eiffel code. It is automatically invoked for
＠＠ -433,7 +435,61 ＠＠
＠uref{http://www.engin.umd.umich.edu/CIS/course.des/cis400/eiffel/eiffel.html,the
Eiffel Web Site}.
-＠node icon, javascript-mode, eiffel, Top
+＠node go-mode, icon, eiffel, Top
+
+＠chapter Editing Go Code
+
+This mode is used for editing Go code. It is automatically invoked for
+buffers visiting any file ending in an extension of ＠file{.go}.
+
+Turning on Go mode runs the hook ＠code{go-mode-hook} at the end of
+initialization.
+
+The mode provides the following features:
+
+＠itemize ＠bullet
+＠item Basic syntax highlighting for keywords, built-ins, functions and
+some types
+＠item Tab indents for Go code. Identation is almost identical to gofmt
+＠end itemize
+
+The following key mappings are defined:
+
+＠multitable {M-backspace } {backward-delete-char-untabify}
+＠item ＠code{)} ＠tab go-mode-insert-and-indent
+＠item ＠code{,} ＠tab go-mode-insert-and-indent
+＠item ＠code{:} ＠tab go-mode-delayed-electric
+＠item ＠code{=} ＠tab go-mode-insert-and-indent
+＠item ＠code{＠}} ＠tab go-mode-insert-and-indent
+＠end multitable
+
+Other useful functions are:
+
+＠table ＠code
+＠item gofmt
+Uses the gofmt tool to format the current buffer. The current buffer
+is replaced on success. On failure an error message is displayed.
+
+＠item godoc
+Show Go documentation for a query in a style similar to M-x man.
+
+＠end table
+
+＠menu
+* About Go: about-go.
+＠end menu
+
+＠node about-go, , go-mode, go-mode
+＠section About Go
+
+Go is a high-level, general-purpose programming language that is
+compiled, uses garbage collection and has strong support for
+concurrent programming. It is open source and developed by Google Inc.
+
+For more information on Go see
+＠uref{http://www.golang.org,The Go Programming Language}.
+
+＠node icon, javascript-mode, go-mode, Top
＠chapter Editing Icon Code
This mode is used for editing Icon code. It is automatically invoked for
Yours
--
%% Mats
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/prog-modes: matsl: Added go-mode.el
12 years, 7 months
Bitbucket
Bitbucket
1 new commit in prog-modes:
https://bitbucket.org/xemacs/prog-modes/changeset/a246dff1f055/
changeset: a246dff1f055
user: matsl
date: 2012-05-13 21:33:45
summary: Added go-mode.el
affected #: 4 files
diff -r 9a5e5e7332618c86410233a50441d7a58cc62848 -r a246dff1f05567a1054fc4d870c9f7ea6db09705 ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
＠＠ -1,3 +1,8 ＠＠
+2012-05-13 Mats Lidell <matsl(a)xemacs.org>
+
+ * prog-modes.texi (go-mode): New mode for Go source.
+ * go-mode.el: New.
+
2011-12-22 Vin Shelton <acs(a)xemacs.org>
* verilog-mode.el (verilog-mode-version):
diff -r 9a5e5e7332618c86410233a50441d7a58cc62848 -r a246dff1f05567a1054fc4d870c9f7ea6db09705 Makefile
--- a/Makefile
+++ b/Makefile
＠＠ -34,7 +34,7 ＠＠
postscript.elc prolog.elc rexx-mode.elc simula.elc \
sql.elc tcl.elc teco.elc verilog-mode.elc vrml-mode.elc p4.elc \
old-c-mode.elc php-mode.elc javascript-mode.elc \
- rpm-spec-mode.elc uil-mode.elc
+ rpm-spec-mode.elc uil-mode.elc go-mode.elc
STANDARD_DOCS = t
diff -r 9a5e5e7332618c86410233a50441d7a58cc62848 -r a246dff1f05567a1054fc4d870c9f7ea6db09705 go-mode.el
--- /dev/null
+++ b/go-mode.el
＠＠ -0,0 +1,860 ＠＠
+;;; go-mode.el --- Major mode for the Go programming language
+
+;; Copyright (c) 2012 The Go Authors. All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following disclaimer
+;; in the documentation and/or other materials provided with the
+;; distribution.
+;; * Neither the name of Google Inc. nor the names of its
+;; contributors may be used to endorse or promote products derived from
+;; this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Synced up with: upstream go-mode.el 13182:9d6693456f93
+
+;;; Commentary:
+
+;; For installation instructions, see go-mode-load.el
+
+;;; To do:
+
+;; * Indentation is *almost* identical to gofmt
+;; ** We think struct literal keys are labels and outdent them
+;; ** We disagree on the indentation of function literals in arguments
+;; ** There are bugs with the close brace of struct literals
+;; * Highlight identifiers according to their syntactic context: type,
+;; variable, function call, or tag
+;; * Command for adding an import
+;; ** Check if it's already there
+;; ** Factor/unfactor the import line
+;; ** Alphabetize
+;; * Remove unused imports
+;; ** This is hard, since I have to be aware of shadowing to do it
+;; right
+;; * Format region using gofmt
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar go-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; Add _ to :word: character class
+ (modify-syntax-entry ?_ "w" st)
+
+ ;; Operators (punctuation)
+ (modify-syntax-entry ?+ "." st)
+ (modify-syntax-entry ?- "." st)
+ (modify-syntax-entry ?* ". 23" st) ; also part of comments
+ (modify-syntax-entry ?/ (if (featurep 'xemacs) ". 1456" ". 124b") st) ; ditto
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?& "." st)
+ (modify-syntax-entry ?| "." st)
+ (modify-syntax-entry ?^ "." st)
+ (modify-syntax-entry ?! "." st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+
+ ;; Strings and comments are font-locked separately.
+ (modify-syntax-entry ?\" "." st)
+ (modify-syntax-entry ?\' "." st)
+ (modify-syntax-entry ?` "." st)
+ (modify-syntax-entry ?\\ "." st)
+
+ ;; Newline is a comment-ender.
+ (modify-syntax-entry ?\n "> b" st)
+
+ st)
+ "Syntax table for Go mode.")
+
+(defvar go-mode-keywords
+ '("break" "default" "func" "interface" "select"
+ "case" "defer" "go" "map" "struct"
+ "chan" "else" "goto" "package" "switch"
+ "const" "fallthrough" "if" "range" "type"
+ "continue" "for" "import" "return" "var")
+ "All keywords in the Go language. Used for font locking and
+some syntax analysis.")
+
+(defvar go-mode-font-lock-keywords
+ (let ((builtins '("append" "cap" "close" "complex" "copy" "delete" "imag" "len"
+ "make" "new" "panic" "print" "println" "real" "recover"))
+ (constants '("nil" "true" "false" "iota"))
+ (type-name "\\s *\\(?:[*(]\\s *\\)*\\(?:\\w+\\s *\\.\\s *\\)?\\(\\w+\\)")
+ )
+ `((go-mode-font-lock-cs-comment 0 font-lock-comment-face t)
+ (go-mode-font-lock-cs-string 0 font-lock-string-face t)
+ (,(regexp-opt go-mode-keywords 'words) . font-lock-keyword-face)
+ (,(regexp-opt builtins 'words) . font-lock-builtin-face)
+ (,(regexp-opt constants 'words) . font-lock-constant-face)
+ ;; Function names in declarations
+ ("\\<func\\>\\s *\\(\\w+\\)" 1 font-lock-function-name-face)
+ ;; Function names in methods are handled by function call pattern
+ ;; Function names in calls
+ ;; XXX Doesn't match if function name is surrounded by parens
+ ("\\(\\w+\\)\\s *(" 1 font-lock-function-name-face)
+ ;; Type names
+ ("\\<type\\>\\s *\\(\\w+\\)" 1 font-lock-type-face)
+ (,(concat "\\<type\\>\\s *\\w+\\s *" type-name) 1 font-lock-type-face)
+ ;; Arrays/slices/map value type
+ ;; XXX Wrong. Marks 0 in expression "foo[0] * x"
+ ;; (,(concat "]" type-name) 1 font-lock-type-face)
+ ;; Map key type
+ (,(concat "\\<map\\s *\\[" type-name) 1 font-lock-type-face)
+ ;; Channel value type
+ (,(concat "\\<chan\\>\\s *\\(?:<-\\)?" type-name) 1 font-lock-type-face)
+ ;; new/make type
+ (,(concat "\\<\\(?:new\\|make\\)\\>\\(?:\\s \\|)\\)*(" type-name) 1 font-lock-type-face)
+ ;; Type conversion
+ (,(concat "\\.\\s *(" type-name) 1 font-lock-type-face)
+ ;; Method receiver type
+ (,(concat "\\<func\\>\\s *(\\w+\\s +" type-name) 1 font-lock-type-face)
+ ;; Labels
+ ;; XXX Not quite right. Also marks compound literal fields.
+ ("^\\s *\\(\\w+\\)\\s *:\\(\\S.\\|$\\)" 1 font-lock-constant-face)
+ ("\\<\\(goto\\|break\\|continue\\)\\>\\s *\\(\\w+\\)" 2 font-lock-constant-face)))
+ "Basic font lock keywords for Go mode. Highlights keywords,
+built-ins, functions, and some types.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Key map
+;;
+
+(defvar go-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "}" #'go-mode-insert-and-indent)
+ (define-key m ")" #'go-mode-insert-and-indent)
+ (define-key m "," #'go-mode-insert-and-indent)
+ (define-key m ":" #'go-mode-delayed-electric)
+ ;; In case we get : indentation wrong, correct ourselves
+ (define-key m "=" #'go-mode-insert-and-indent)
+ m)
+ "Keymap used by Go mode to implement electric keys.")
+
+(defun go-mode-insert-and-indent (key)
+ "Invoke the global binding of KEY, then reindent the line."
+
+ (interactive (list (this-command-keys)))
+ (call-interactively (lookup-key (current-global-map) key))
+ (indent-according-to-mode))
+
+(defvar go-mode-delayed-point nil
+ "The point following the previous insertion if the insertion
+was a delayed electric key. Used to communicate between
+`go-mode-delayed-electric' and `go-mode-delayed-electric-hook'.")
+(make-variable-buffer-local 'go-mode-delayed-point)
+
+(defun go-mode-delayed-electric (p)
+ "Perform electric insertion, but delayed by one event.
+
+This inserts P into the buffer, as usual, then waits for another key.
+If that second key causes a buffer modification starting at the
+point after the insertion of P, reindents the line containing P."
+
+ (interactive "p")
+ (self-insert-command p)
+ (setq go-mode-delayed-point (point)))
+
+(defun go-mode-delayed-electric-hook (b e l)
+ "An after-change-function that implements `go-mode-delayed-electric'."
+
+ (when (and go-mode-delayed-point
+ (= go-mode-delayed-point b))
+ (save-excursion
+ (save-match-data
+ (goto-char go-mode-delayed-point)
+ (indent-according-to-mode))))
+ (setq go-mode-delayed-point nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parser
+;;
+
+(defvar go-mode-mark-cs-end 1
+ "The point at which the comment/string cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-cs-end)).")
+(make-variable-buffer-local 'go-mode-mark-cs-end)
+
+(defvar go-mode-mark-string-end 1
+ "The point at which the string cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-string-end)).")
+(make-variable-buffer-local 'go-mode-mark-string-end)
+
+(defvar go-mode-mark-comment-end 1
+ "The point at which the comment cache ends. The buffer
+will be marked from the beginning up to this point (that is, up
+to and including character (1- go-mode-mark-comment-end)).")
+(make-variable-buffer-local 'go-mode-mark-comment-end)
+
+(defvar go-mode-mark-nesting-end 1
+ "The point at which the nesting cache ends. The buffer will be
+marked from the beginning up to this point.")
+(make-variable-buffer-local 'go-mode-mark-nesting-end)
+
+(defun go-mode-mark-clear-cache (b e)
+ "A before-change-function that clears the comment/string and
+nesting caches from the modified point on."
+
+ (save-restriction
+ (widen)
+ (when (<= b go-mode-mark-cs-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-cs)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-cs-end (point-max)) '(go-mode-cs nil))
+ (setq go-mode-mark-cs-end b)))
+
+ (when (<= b go-mode-mark-string-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-string)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-string-end (point-max)) '(go-mode-string nil))
+ (setq go-mode-mark-string-end b)))
+ (when (<= b go-mode-mark-comment-end)
+ ;; Remove the property adjacent to the change position.
+ ;; It may contain positions pointing beyond the new end mark.
+ (let ((b (let ((cs (get-text-property (max 1 (1- b)) 'go-mode-comment)))
+ (if cs (car cs) b))))
+ (remove-text-properties
+ b (min go-mode-mark-string-end (point-max)) '(go-mode-comment nil))
+ (setq go-mode-mark-comment-end b)))
+
+ (when (< b go-mode-mark-nesting-end)
+ (remove-text-properties b (min go-mode-mark-nesting-end (point-max)) '(go-mode-nesting nil))
+ (setq go-mode-mark-nesting-end b))))
+
+(defmacro go-mode-parser (&rest body)
+ "Evaluate BODY in an environment set up for parsers that use
+text properties to mark text. This inhibits changes to the undo
+list or the buffer's modification status and inhibits calls to
+the modification hooks. It also saves the excursion and
+restriction and widens the buffer, since most parsers are
+context-sensitive."
+
+ (let ((modified-var (make-symbol "modified")))
+ `(let ((buffer-undo-list t)
+ (,modified-var (buffer-modified-p))
+ (inhibit-modification-hooks t)
+ (inhibit-read-only t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (unwind-protect
+ (progn ,＠body)
+ (set-buffer-modified-p ,modified-var)))))))
+
+(defun go-mode-cs (&optional pos)
+ "Return the comment/string state at point POS. If point is
+inside a comment or string (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-cs-end)
+ (go-mode-mark-cs pos))
+ (get-text-property pos 'go-mode-cs))
+
+(defun go-mode-mark-cs (end)
+ "Mark comments and strings up to point END. Don't call this
+directly; use `go-mode-cs'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-cs
+ (and (> go-mode-mark-cs-end 1)
+ (get-text-property (1- go-mode-mark-cs-end)
+ 'go-mode-cs))))
+ (if last-cs
+ (car last-cs)
+ (max 1 (1- go-mode-mark-cs-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((cs-end ; end of the text property
+ (cond
+ ((looking-at "//")
+ (end-of-line)
+ (1+ (point)))
+ ((looking-at "/\\*")
+ (goto-char (+ pos 2))
+ (if (search-forward "*/" (1+ end) t)
+ (point)
+ end))
+ ((looking-at "\"")
+ (goto-char (1+ pos))
+ (if (looking-at "[^\"\n\\\\]*\\(\\\\.[^\"\n\\\\]*\\)*\"")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "'")
+ (goto-char (1+ pos))
+ (if (looking-at "[^'\n\\\\]*\\(\\\\.[^'\n\\\\]*\\)*'")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "`")
+ (goto-char (1+ pos))
+ (while (if (search-forward "`" end t)
+ (if (eq (char-after) ?`)
+ (goto-char (1+ (point))))
+ (goto-char end)
+ nil))
+ (point)))))
+ (cond
+ (cs-end
+ (put-text-property pos cs-end 'go-mode-cs (cons pos cs-end))
+ (setq pos cs-end))
+ ((re-search-forward "[\"'`]\\|/[/*]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-cs-end pos)))))
+
+(defun go-mode-in-comment (&optional pos)
+ "Return the comment/string state at point POS. If point is
+inside a comment (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-comment-end)
+ (go-mode-mark-comment pos))
+ (get-text-property pos 'go-mode-comment))
+
+(defun go-mode-mark-comment (end)
+ "Mark comments up to point END. Don't call this directly; use `go-mode-in-comment'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-comment
+ (and (> go-mode-mark-comment-end 1)
+ (get-text-property (1- go-mode-mark-comment-end)
+ 'go-mode-comment))))
+ (if last-comment
+ (car last-comment)
+ (max 1 (1- go-mode-mark-comment-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((comment-end ; end of the text property
+ (cond
+ ((looking-at "//")
+ (end-of-line)
+ (1+ (point)))
+ ((looking-at "/\\*")
+ (goto-char (+ pos 2))
+ (if (search-forward "*/" (1+ end) t)
+ (point)
+ end)))))
+ (cond
+ (comment-end
+ (put-text-property pos comment-end 'go-mode-comment (cons pos comment-end))
+ (setq pos comment-end))
+ ((re-search-forward "/[/*]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-comment-end pos)))))
+
+(defun go-mode-in-string (&optional pos)
+ "Return the string state at point POS. If point is
+inside a string (including the delimiters), this
+returns a pair (START . END) indicating the extents of the
+comment or string."
+
+ (unless pos
+ (setq pos (point)))
+ (when (> pos go-mode-mark-string-end)
+ (go-mode-mark-string pos))
+ (get-text-property pos 'go-mode-string))
+
+(defun go-mode-mark-string (end)
+ "Mark strings up to point END. Don't call this
+directly; use `go-mode-in-string'."
+ (setq end (min end (point-max)))
+ (go-mode-parser
+ (save-match-data
+ (let ((pos
+ ;; Back up to the last known state.
+ (let ((last-cs
+ (and (> go-mode-mark-string-end 1)
+ (get-text-property (1- go-mode-mark-string-end)
+ 'go-mode-string))))
+ (if last-cs
+ (car last-cs)
+ (max 1 (1- go-mode-mark-string-end))))))
+ (while (< pos end)
+ (goto-char pos)
+ (let ((cs-end ; end of the text property
+ (cond
+ ((looking-at "\"")
+ (goto-char (1+ pos))
+ (if (looking-at "[^\"\n\\\\]*\\(\\\\.[^\"\n\\\\]*\\)*\"")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "'")
+ (goto-char (1+ pos))
+ (if (looking-at "[^'\n\\\\]*\\(\\\\.[^'\n\\\\]*\\)*'")
+ (match-end 0)
+ (end-of-line)
+ (point)))
+ ((looking-at "`")
+ (goto-char (1+ pos))
+ (while (if (search-forward "`" end t)
+ (if (eq (char-after) ?`)
+ (goto-char (1+ (point))))
+ (goto-char end)
+ nil))
+ (point)))))
+ (cond
+ (cs-end
+ (put-text-property pos cs-end 'go-mode-string (cons pos cs-end))
+ (setq pos cs-end))
+ ((re-search-forward "[\"'`]" end t)
+ (setq pos (match-beginning 0)))
+ (t
+ (setq pos end)))))
+ (setq go-mode-mark-string-end pos)))))
+
+(defun go-mode-font-lock-cs (limit comment)
+ "Helper function for highlighting comment/strings. If COMMENT is t,
+set match data to the next comment after point, and advance point
+after it. If COMMENT is nil, use the next string. Returns nil
+if no further tokens of the type exist."
+ ;; Ensures that `next-single-property-change' below will work properly.
+ (go-mode-cs limit)
+ (let (cs next (result 'scan))
+ (while (eq result 'scan)
+ (if (or (>= (point) limit) (eobp))
+ (setq result nil)
+ (setq cs (go-mode-cs))
+ (if cs
+ (if (eq (= (char-after (car cs)) ?/) comment)
+ ;; If inside the expected comment/string, highlight it.
+ (progn
+ ;; If the match includes a "\n", we have a
+ ;; multi-line construct. Mark it as such.
+ (goto-char (car cs))
+ (when (search-forward "\n" (cdr cs) t)
+ (put-text-property
+ (car cs) (cdr cs) 'font-lock-multline t))
+ (set-match-data (list (car cs) (copy-marker (cdr cs))))
+ (goto-char (cdr cs))
+ (setq result t))
+ ;; Wrong type. Look for next comment/string after this one.
+ (goto-char (cdr cs)))
+ ;; Not inside comment/string. Search for next comment/string.
+ (setq next (next-single-property-change
+ (point) 'go-mode-cs nil limit))
+ (if (and next (< next limit))
+ (goto-char next)
+ (setq result nil)))))
+ result))
+
+(defun go-mode-font-lock-cs-string (limit)
+ "Font-lock iterator for strings."
+ (go-mode-font-lock-cs limit nil))
+
+(defun go-mode-font-lock-cs-comment (limit)
+ "Font-lock iterator for comments."
+ (go-mode-font-lock-cs limit t))
+
+(defsubst go-mode-nesting (&optional pos)
+ "Return the nesting at point POS. The nesting is a list
+of (START . END) pairs for all braces, parens, and brackets
+surrounding POS, starting at the inner-most nesting. START is
+the location of the open character. END is the location of the
+close character or nil if the nesting scanner has not yet
+encountered the close character."
+
+ (unless pos
+ (setq pos (point)))
+ (if (= pos 1)
+ '()
+ (when (> pos go-mode-mark-nesting-end)
+ (go-mode-mark-nesting pos))
+ (get-text-property (- pos 1) 'go-mode-nesting)))
+
+(defun go-mode-mark-nesting (pos)
+ "Mark nesting up to point END. Don't call this directly; use
+`go-mode-nesting'."
+
+ (go-mode-cs pos)
+ (go-mode-parser
+ ;; Mark depth
+ (goto-char go-mode-mark-nesting-end)
+ (let ((nesting (go-mode-nesting))
+ (last (point)))
+ (while (< last pos)
+ ;; Find the next depth-changing character
+ (skip-chars-forward "^(){}[]" pos)
+ ;; Mark everything up to this character with the current
+ ;; nesting
+ (put-text-property last (point) 'go-mode-nesting nesting)
+ (when nil
+ (let ((depth (length nesting)))
+ (put-text-property last (point) 'face
+ `((:background
+ ,(format "gray%d" (* depth 10)))))))
+ (setq last (point))
+ ;; Update nesting
+ (unless (eobp)
+ (let ((ch (unless (go-mode-cs) (char-after))))
+ (forward-char 1)
+ (case ch
+ ((?\( ?\{ ?\[)
+ (setq nesting (cons (cons (- (point) 1) nil)
+ nesting)))
+ ((?\) ?\} ?\])
+ (when nesting
+ (setcdr (car nesting) (- (point) 1))
+ (setq nesting (cdr nesting))))))))
+ ;; Update state
+ (setq go-mode-mark-nesting-end last))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Indentation
+;;
+
+(defvar go-mode-non-terminating-keywords-regexp
+ (let* ((kws go-mode-keywords)
+ (kws (remove "break" kws))
+ (kws (remove "continue" kws))
+ (kws (remove "fallthrough" kws))
+ (kws (remove "return" kws)))
+ (regexp-opt kws 'words))
+ "Regular expression matching all Go keywords that *do not*
+implicitly terminate a statement.")
+
+(defun go-mode-semicolon-p ()
+ "True iff point immediately follows either an explicit or
+implicit semicolon. Point should immediately follow the last
+token on the line."
+
+ ;; #Semicolons
+ (case (char-before)
+ ((?\;) t)
+ ;; String literal
+ ((?' ?\" ?`) t)
+ ;; One of the operators and delimiters ++, --, ), ], or }
+ ((?+) (eq (char-before (1- (point))) ?+))
+ ((?-) (eq (char-before (1- (point))) ?-))
+ ((?\) ?\] ?\}) t)
+ ;; An identifier or one of the keywords break, continue,
+ ;; fallthrough, or return or a numeric literal
+ (otherwise
+ (save-excursion
+ (when (/= (skip-chars-backward "[:word:]_") 0)
+ (not (looking-at go-mode-non-terminating-keywords-regexp)))))))
+
+(defun go-mode-whitespace-p (char)
+ "Is newline, or char whitespace in the syntax table for go."
+ (or (eq char ?\n)
+ (= (char-syntax char) ?\ )))
+
+(defun go-mode-backward-skip-comments ()
+ "Skip backward over comments and whitespace."
+ ;; only proceed if point is in a comment or white space
+ (if (or (go-mode-in-comment)
+ (go-mode-whitespace-p (char-after (point))))
+ (let ((loop-guard t))
+ (while (and
+ loop-guard
+ (not (bobp)))
+
+ (cond ((go-mode-whitespace-p (char-after (point)))
+ ;; moves point back over any whitespace
+ (re-search-backward "[^[:space:]]"))
+
+ ((go-mode-in-comment)
+ ;; move point to char preceeding current comment
+ (goto-char (1- (car (go-mode-in-comment)))))
+
+ ;; not in a comment or whitespace? we must be done.
+ (t (setq loop-guard nil)
+ (forward-char 1)))))))
+
+(defun go-mode-indentation ()
+ "Compute the ideal indentation level of the current line.
+
+To the first order, this is the brace depth of the current line,
+plus parens that follow certain keywords. case, default, and
+labels are outdented one level, and continuation lines are
+indented one level."
+
+ (save-excursion
+ (back-to-indentation)
+ (let ((cs (go-mode-cs)))
+ ;; Treat comments and strings differently only if the beginning
+ ;; of the line is contained within them
+ (when (and cs (= (point) (car cs)))
+ (setq cs nil))
+ ;; What type of context am I in?
+ (cond
+ ((and cs (save-excursion
+ (goto-char (car cs))
+ (looking-at "\\s\"")))
+ ;; Inside a multi-line string. Don't mess with indentation.
+ nil)
+ (cs
+ ;; Inside a general comment
+ (goto-char (car cs))
+ (forward-char 1)
+ (current-column))
+ (t
+ ;; Not in a multi-line string or comment
+ (let ((indent 0)
+ (inside-indenting-paren nil))
+ ;; Count every enclosing brace, plus parens that follow
+ ;; import, const, var, or type and indent according to
+ ;; depth. This simple rule does quite well, but also has a
+ ;; very large extent. It would be better if we could mimic
+ ;; some nearby indentation.
+ (save-excursion
+ (skip-chars-forward "})")
+ (let ((first t))
+ (dolist (nest (go-mode-nesting))
+ (case (char-after (car nest))
+ ((?\{)
+ (incf indent tab-width))
+ ((?\()
+ (goto-char (car nest))
+ (go-mode-backward-skip-comments)
+ (backward-char)
+ ;; Really just want the token before
+ (when (looking-back "\\<import\\|const\\|var\\|type\\|package"
+ (max (- (point) 7) (point-min)))
+ (incf indent tab-width)
+ (when first
+ (setq inside-indenting-paren t)))))
+ (setq first nil))))
+
+ ;; case, default, and labels are outdented 1 level
+ (when (looking-at "\\<case\\>\\|\\<default\\>\\|\\w+\\s *:\\(\\S.\\|$\\)")
+ (decf indent tab-width))
+
+ (when (looking-at "\\w+\\s *:.+,\\s *$")
+ (incf indent tab-width))
+
+ ;; Continuation lines are indented 1 level
+ (beginning-of-line) ; back up to end of previous line
+ (backward-char)
+ (go-mode-backward-skip-comments) ; back up past any comments
+ (when (case (char-before)
+ ((nil ?\{ ?:)
+ ;; At the beginning of a block or the statement
+ ;; following a label.
+ nil)
+ ((?\()
+ ;; Usually a continuation line in an expression,
+ ;; unless this paren is part of a factored
+ ;; declaration.
+ (not inside-indenting-paren))
+ ((?,)
+ ;; Could be inside a literal. We're a little
+ ;; conservative here and consider any comma within
+ ;; curly braces (as opposed to parens) to be a
+ ;; literal separator. This will fail to recognize
+ ;; line-breaks in parallel assignments as
+ ;; continuation lines.
+ (let ((depth (go-mode-nesting)))
+ (and depth
+ (not (eq (char-after (caar depth)) ?\{)))))
+ (t
+ ;; We're in the middle of a block. Did the
+ ;; previous line end with an implicit or explicit
+ ;; semicolon?
+ (not (go-mode-semicolon-p))))
+ (incf indent tab-width))
+
+ (max indent 0)))))))
+
+(defun go-mode-indent-line ()
+ "Indent the current line according to `go-mode-indentation'."
+ (interactive)
+
+ ;; turn off case folding to distinguish keywords from identifiers
+ ;; e.g. "default" is a keyword; "Default" can be a variable name.
+ (let ((case-fold-search nil))
+ (let ((col (go-mode-indentation)))
+ (when col
+ (let ((offset (- (current-column) (current-indentation))))
+ (indent-line-to col)
+ (when (> offset 0)
+ (forward-char offset)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Go mode
+;;
+
+;;;###autoload
+(define-derived-mode go-mode nil "Go"
+ "Major mode for editing Go source text.
+
+This provides basic syntax highlighting for keywords, built-ins,
+functions, and some types. It also provides indentation that is
+\(almost) identical to gofmt."
+
+ ;; Font lock
+ (set (make-local-variable 'font-lock-defaults)
+ '(go-mode-font-lock-keywords nil nil nil nil))
+
+ ;; Remove stale text properties
+ (save-restriction
+ (widen)
+ (remove-text-properties 1 (point-max)
+ '(go-mode-cs nil go-mode-nesting nil)))
+
+ ;; Reset the syntax mark caches
+ (setq go-mode-mark-cs-end 1
+ go-mode-mark-nesting-end 1)
+ (add-hook 'before-change-functions #'go-mode-mark-clear-cache nil t)
+
+ ;; Indentation
+ (set (make-local-variable 'indent-line-function)
+ #'go-mode-indent-line)
+ (add-hook 'after-change-functions #'go-mode-delayed-electric-hook nil t)
+
+ ;; Comments
+ (set (make-local-variable 'comment-start) "// ")
+ (set (make-local-variable 'comment-end) "")
+
+ ;; Go style
+ (setq indent-tabs-mode t))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist (cons "\\.go$" #'go-mode))
+
+(defun go-mode-reload ()
+ "Reload go-mode.el and put the current buffer into Go mode.
+Useful for development work."
+
+ (interactive)
+ (unload-feature 'go-mode)
+ (require 'go-mode)
+ (go-mode))
+
+;;;###autoload
+(defun gofmt ()
+ "Pipe the current buffer through the external tool `gofmt`.
+Replace the current buffer on success; display errors on failure."
+
+ (interactive)
+ (let ((currconf (current-window-configuration)))
+ (let ((srcbuf (current-buffer)))
+ (with-temp-buffer
+ (let ((outbuf (current-buffer))
+ (errbuf (get-buffer-create "*Gofmt Errors*"))
+ (coding-system-for-read 'utf-8) ;; use utf-8 with subprocesses
+ (coding-system-for-write 'utf-8))
+ (with-current-buffer errbuf (erase-buffer))
+ (with-current-buffer srcbuf
+ (save-restriction
+ (let (deactivate-mark)
+ (widen)
+ (if (= 0 (shell-command-on-region (point-min) (point-max) "gofmt"
+ outbuf nil errbuf))
+ ;; restore window config
+ ;; gofmt succeeded: replace the current buffer with outbuf,
+ ;; restore the mark and point, and discard errbuf.
+ (let ((old-mark (mark t))
+ (old-point (point))
+ (old-start (window-start)))
+ (erase-buffer)
+ (insert-buffer-substring outbuf)
+ (set-window-configuration currconf)
+ (set-window-start (selected-window) (min old-start (point-max)))
+ (goto-char (min old-point (point-max)))
+ (if old-mark (push-mark (min old-mark (point-max)) t))
+ (kill-buffer errbuf))
+
+ ;; gofmt failed: display the errors
+ (display-buffer errbuf)))))
+
+ ;; Collapse any window opened on outbuf if shell-command-on-region
+ ;; displayed it.
+ (delete-windows-on outbuf))))))
+
+;;;###autoload
+(defun gofmt-before-save ()
+ "Add this to .emacs to run gofmt on the current buffer when saving:
+ (add-hook 'before-save-hook #'gofmt-before-save)"
+
+ (interactive)
+ (when (eq major-mode 'go-mode) (gofmt)))
+
+(defun godoc-read-query ()
+ "Read a godoc query from the minibuffer."
+ ;; Compute the default query as the symbol under the cursor.
+ ;; TODO: This does the wrong thing for e.g. multipart.NewReader (it only grabs
+ ;; half) but I see no way to disambiguate that from e.g. foobar.SomeMethod.
+ (let* ((bounds (bounds-of-thing-at-point 'symbol))
+ (symbol (if bounds
+ (buffer-substring-no-properties (car bounds)
+ (cdr bounds)))))
+ (read-string (if symbol
+ (format "godoc (default %s): " symbol)
+ "godoc: ")
+ nil nil symbol)))
+
+(defun godoc-get-buffer (query)
+ "Get an empty buffer for a godoc query."
+ (let* ((buffer-name (concat "*godoc " query "*"))
+ (buffer (get-buffer buffer-name)))
+ ;; Kill the existing buffer if it already exists.
+ (when buffer (kill-buffer buffer))
+ (get-buffer-create buffer-name)))
+
+(defun godoc-buffer-sentinel (proc event)
+ "Sentinel function run when godoc command completes."
+ (with-current-buffer (process-buffer proc)
+ (cond ((string= event "finished\n") ;; Successful exit.
+ (goto-char (point-min))
+ (display-buffer (current-buffer) 'not-this-window))
+ ((not (= (process-exit-status proc) 0)) ;; Error exit.
+ (let ((output (buffer-string)))
+ (kill-buffer (current-buffer))
+ (message (concat "godoc: " output)))))))
+
+;;;###autoload
+(defun godoc (query)
+ "Show go documentation for a query, much like M-x man."
+ (interactive (list (godoc-read-query)))
+ (unless (string= query "")
+ (set-process-sentinel
+ (start-process-shell-command "godoc" (godoc-get-buffer query)
+ (concat "godoc " query))
+ 'godoc-buffer-sentinel)
+ nil))
+
+(provide 'go-mode)
diff -r 9a5e5e7332618c86410233a50441d7a58cc62848 -r a246dff1f05567a1054fc4d870c9f7ea6db09705 prog-modes.texi
--- a/prog-modes.texi
+++ b/prog-modes.texi
＠＠ -3,6 +3,7 ＠＠
＠c Copyright (C) 2002, 2003 Free Software Foundation, Inc.
＠c Copyright (C) 2003 Jake Colman <jake.colman(a)xemacs.org>
＠c Copyright (C) 2004 Ville Skyttä <scop(a)xemacs.org>
+＠c Copyright (C) 2012 Mats Lidell <matsl(a)xemacs.org>
＠c
＠c ＠setfilename prog-modes.info
＠settitle Programming Modes for XEmacs
＠＠ -67,6 +68,7 ＠＠
* cvs:: Light CVS Support
* diff-mode:: Viewing and Editing Context Diffs
* eiffel:: Editing Eiffel Code
+* go-mode:: Editing Go Code
* icon:: Editing Icon Code
* javascript-mode:: Editing JavaScript Code
* ksh-mode:: Editing Shell Script (sh, ksh, bash) Code
＠＠ -388,7 +390,7 ＠＠
M-x customize-group RET diff-mode RET
＠end example
-＠node eiffel, icon, diff-mode, Top
+＠node eiffel, go-mode, diff-mode, Top
＠chapter Editing Eiffel Code
This mode is used for editing Eiffel code. It is automatically invoked for
＠＠ -433,7 +435,61 ＠＠
＠uref{http://www.engin.umd.umich.edu/CIS/course.des/cis400/eiffel/eiffel.html,the
Eiffel Web Site}.
-＠node icon, javascript-mode, eiffel, Top
+＠node go-mode, icon, eiffel, Top
+
+＠chapter Editing Go Code
+
+This mode is used for editing Go code. It is automatically invoked for
+buffers visiting any file ending in an extension of ＠file{.go}.
+
+Turning on Go mode runs the hook ＠code{go-mode-hook} at the end of
+initialization.
+
+The mode provides the following features:
+
+＠itemize ＠bullet
+＠item Basic syntax highlighting for keywords, built-ins, functions and
+some types
+＠item Tab indents for Go code. Identation is almost identical to gofmt
+＠end itemize
+
+The following key mappings are defined:
+
+＠multitable {M-backspace } {backward-delete-char-untabify}
+＠item ＠code{)} ＠tab go-mode-insert-and-indent
+＠item ＠code{,} ＠tab go-mode-insert-and-indent
+＠item ＠code{:} ＠tab go-mode-delayed-electric
+＠item ＠code{=} ＠tab go-mode-insert-and-indent
+＠item ＠code{＠}} ＠tab go-mode-insert-and-indent
+＠end multitable
+
+Other useful functions are:
+
+＠table ＠code
+＠item gofmt
+Uses the gofmt tool to format the current buffer. The current buffer
+is replaced on success. On failure an error message is displayed.
+
+＠item godoc
+Show Go documentation for a query in a style similar to M-x man.
+
+＠end table
+
+＠menu
+* About Go: about-go.
+＠end menu
+
+＠node about-go, , go-mode, go-mode
+＠section About Go
+
+Go is a high-level, general-purpose programming language that is
+compiled, uses garbage collection and has strong support for
+concurrent programming. It is open source and developed by Google Inc.
+
+For more information on Go see
+＠uref{http://www.golang.org,The Go Programming Language}.
+
+＠node icon, javascript-mode, go-mode, Top
＠chapter Editing Icon Code
This mode is used for editing Icon code. It is automatically invoked for
Repository URL: https://bitbucket.org/xemacs/prog-modes/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Avoid signalling args-out-of-range errors, #'truncate-string-to-width
12 years, 7 months
Aidan Kehoe
Aidan Kehoe
Ar an t-aonú lá is triochad de mí na Nollaig, scríobh Aidan Kehoe:
>
> Ar an t-ochtú lá is fiche de mí na Nollaig, scríobh Jerry James:
>
> > [...] This is causing the following practical problem. With an X11 build
> > and Debug on Signal active, clicking on the menubar causes an immediate
> > crash due to an assertion failure. A little debugger work shows the
> > following sequence. Inside of button_item_to_widget_value (src/gui-x.c),
> > the default-menubar from lisp/menubar-items.el is evaluated, down to one
> > of the calls to:
> >
> > (truncate-string-to-width (abbrev-string-to-be-defined nil) 40 nil nil t)
> >
> > The abbrev-string-to-be-defined call returns "j.\n\n" (which doesn't
> > seem right; where did that come from?).
That’s mostly OK, #'abbrev-string-to-be-defined just looks at the word at
point, and that’s the string in question. Though maybe it shouldn’t be
looking at the word at point.
> > Evaluating
> > truncate-string-to-width triggers the args_out_of_range, thereby
> > unwinding the stack up to the call_trapping_problems call in
> > menu_item_descriptor_to_widget_value (menubar-x.c). Since retval is
> > unbound, this function returns NULL, and therefore
> > compute_menubar_data also returns NULL. This triggers the assert() in
> > set_frame_menubar (menubar-x.c) just after the call to
> > compute_menubar_data and *boom* goes XEmacs.
>
> This is interesting, and what to do isn’t particularly clear.
>
> (setq debug-on-signal t) is supposed to enter the debugger even if the
> signal is caught, so in design terms nothing is wrong here. Except that we
> crash, and that’s clearly wrong ...
>
> It *is* a bit of an infelicity in the implementation of
> #'truncate-string-to-width that it signals as a matter of course, so this
> patch is probably appropriate anyway. But should call_trapping_problems()
> just bind Vdebug_on_signal to a non-nil value?
Thinking about this a bit more--
-- call_trapping_problems() shouldn’t bind debug-on-signal to a non-nil
value, that makes debug-on-signal less useful.
-- Since we’ve decided it’s the responsibility of Lisp to create menu items,
it is permitted behaviour--it shouldn’t trigger an assertion failure--for
that Lisp code to error. The C code should make sure the menu isn’t in a
wedged state, and then treat it as it does other Lisp errors.
-- Independent of this, #'truncate-string-to-width shouldn’t signal
args-out-of-range errors, as a UI thing it makes debug-on-signal much less
useful given that #'truncate-string-to-width is called so often from the
menu code (and was always intended to be called often from the menu code).
I’ve committed the below to address this.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1336842733 -3600
# Node ID 8593e614573a4a167af4d3e73201dfa46c7e30a8
# Parent 00fd55d635fb2db4fb3b4647b1380769536f921c
Avoid signalling args-out-of-range errors, #'truncate-string-to-width
lisp/ChangeLog addition:
Avoid args-out-of-range errors, this function is regularly called
from menu code and with debug-on-signal non-nil, this can be very
irritating.
Don't bind ellipsis-len, we don't use it.
diff -r 00fd55d635fb -r 8593e614573a lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 12 17:51:05 2012 +0100
+++ b/lisp/ChangeLog Sat May 12 18:12:13 2012 +0100
＠＠ -3,6 +3,10 ＠＠
* subr.el:
* subr.el (truncate-string-to-width):
Sync with GNU's version, use its test suite in mule-tests.el.
+ Avoid args-out-of-range errors, this function is regularly called
+ from menu code and with debug-on-signal non-nil, this can be very
+ irritating.
+ Don't bind ellipsis-len, we don't use it.
2012-05-12 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r 00fd55d635fb -r 8593e614573a lisp/subr.el
--- a/lisp/subr.el Sat May 12 17:51:05 2012 +0100
+++ b/lisp/subr.el Sat May 12 18:12:13 2012 +0100
＠＠ -1062,18 +1062,15 ＠＠
(setq ellipsis "..."))
(let ((str-len (length str))
(str-width (string-width str))
- (ellipsis-len (if ellipsis (length ellipsis) 0))
(ellipsis-width (if ellipsis (string-width ellipsis) 0))
(idx 0)
(column 0)
(head-padding "") (tail-padding "")
ch last-column last-idx from-idx)
- (condition-case nil
- (while (< column start-column)
- (setq ch (aref str idx)
- column (+ column (char-width ch))
- idx (1+ idx)))
- (args-out-of-range (setq idx str-len)))
+ (while (and (< column start-column) (< idx str-len))
+ (setq ch (aref str idx)
+ column (+ column (char-width ch))
+ idx (1+ idx)))
(if (< column start-column)
(if padding (make-string end-column padding) "")
(when (and padding (> column start-column))
＠＠ -1084,14 +1081,12 ＠＠
(> str-width ellipsis-width))
(setq end-column (- end-column ellipsis-width))
(setq ellipsis ""))
- (condition-case nil
- (while (< column end-column)
- (setq last-column column
- last-idx idx
- ch (aref str idx)
- column (+ column (char-width ch))
- idx (1+ idx)))
- (args-out-of-range (setq idx str-len)))
+ (while (and (< column end-column) (< idx str-len))
+ (setq last-column column
+ last-idx idx
+ ch (aref str idx)
+ column (+ column (char-width ch))
+ idx (1+ idx)))
(when (> column end-column)
(setq column last-column
idx last-idx))
--
‘Iodine deficiency was endemic in parts of the UK until, through what has been
described as “an unplanned and accidental public health triumph”, iodine was
added to cattle feed to improve milk production in the 1930s.’
(EN Pearce, Lancet, June 2011)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments