summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/authors.el2
-rw-r--r--lisp/emacs-lisp/byte-opt.el2
-rw-r--r--lisp/emacs-lisp/bytecomp.el24
-rw-r--r--lisp/emacs-lisp/chart.el6
-rw-r--r--lisp/emacs-lisp/checkdoc.el7
-rw-r--r--lisp/emacs-lisp/cl-compat.el199
-rw-r--r--lisp/emacs-lisp/cl.el1
-rw-r--r--lisp/emacs-lisp/edebug.el22
-rw-r--r--lisp/emacs-lisp/lisp.el86
-rw-r--r--lisp/emacs-lisp/lmenu.el443
-rw-r--r--lisp/emacs-lisp/regexp-opt.el11
-rw-r--r--lisp/emacs-lisp/shadow.el76
-rw-r--r--lisp/emacs-lisp/smie.el93
13 files changed, 199 insertions, 773 deletions
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 3bfa076d71c..248a2cf1312 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -507,6 +507,7 @@ Changes to files in this list are not listed.")
"ymakefile"
"permute-index" "index.perm"
"ibmrs6000.inp"
+ "b2m.c"
"emacs.ico"
"emacs21.ico"
"LPF" "LEDIT" "OTHER.EMACSES"
@@ -1027,5 +1028,4 @@ the Emacs source tree, from which to build the file."
(provide 'authors)
-;; arch-tag: 659d5900-5ff2-43b0-954c-a315cc1e4dc1
;;; authors.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ac008c98cd9..4a073a8e2e9 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -385,7 +385,7 @@
(eq 'lambda (car-safe fn)))
(let ((newform (byte-compile-unfold-lambda form)))
(if (eq newform form)
- ;; Some error occured, avoid infinite recursion
+ ;; Some error occurred, avoid infinite recursion
form
(byte-optimize-form-code-walker newform for-effect))))
((memq fn '(let let*))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index bad33395e22..5e975174f01 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1816,12 +1816,15 @@ The value is non-nil if there were no errors, nil if errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
- (let ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile (make-temp-name target-file)))
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile (make-temp-name target-file))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors (delete-file tempfile)))
+ kill-emacs-hook)))
(if (memq system-type '(ms-dos 'windows-nt))
(setq buffer-file-type t))
(write-region (point-min) (point-max) tempfile nil 1)
@@ -1915,14 +1918,7 @@ With argument ARG, insert value in current buffer after the form."
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
- (setq case-fold-search nil)
- ;; This is a kludge. Some operating systems (OS/2, DOS) need to
- ;; write files containing binary information specially.
- ;; Under most circumstances, such files will be in binary
- ;; overwrite mode, so those OS's use that flag to guess how
- ;; they should write their data. Advise them that .elc files
- ;; need to be written carefully.
- (setq overwrite-mode 'overwrite-mode-binary))
+ (setq case-fold-search nil))
(displaying-byte-compile-warnings
(with-current-buffer bytecomp-inbuffer
(and bytecomp-filename
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index d2abdcffe0d..88da7aab3be 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -62,11 +62,7 @@
(require 'eieio)
;;; Code:
-(defvar chart-map nil "Keymap used in chart mode.")
-(if chart-map
- ()
- (setq chart-map (make-sparse-keymap))
- )
+(defvar chart-map (make-sparse-keymap) "Keymap used in chart mode.")
(defvar chart-local-object nil
"Local variable containing the locally displayed chart object.")
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index e7455b3fbb7..9acad6e67cb 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,7 +1,7 @@
;;; checkdoc.el --- check documentation strings for style requirements
-;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
@@ -1207,9 +1207,6 @@ generating a buffered list of errors."
map)
"Keymap used to override evaluation key-bindings for documentation checking.")
-(define-obsolete-variable-alias 'checkdoc-minor-keymap
- 'checkdoc-minor-mode-map "21.1")
-
;; Add in a menubar with easy-menu
(easy-menu-define
diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el
deleted file mode 100644
index f4923b6f8c6..00000000000
--- a/lisp/emacs-lisp/cl-compat.el
+++ /dev/null
@@ -1,199 +0,0 @@
-;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-
-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-;; Package: emacs
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains emulations of internal routines of the older
-;; CL package which users may have called directly from their code.
-;; Use (require 'cl-compat) to get these routines.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-;; This used to be:
-;; (or (featurep 'cl) (require 'cl))
-;; which just has the effect of fooling the byte-compiler into not
-;; loading cl when compiling. However, that leads to some bogus
-;; compiler warnings. Loading cl when compiling cannot do any harm,
-;; because for a long time bootstrap-emacs contained 'cl, due to being
-;; dumped from uncompiled files that eval-when-compile'd cl. So every
-;; file was compiled with 'cl loaded.
-(require 'cl)
-
-
-;;; Keyword routines not supported by new package.
-
-(defmacro defkeyword (x &optional doc)
- (list* 'defconst x (list 'quote x) (and doc (list doc))))
-
-(defun keyword-of (sym)
- (or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
-
-
-;;; Multiple values. Note that the new package uses a different
-;;; convention for multiple values. The following definitions
-;;; emulate the old convention; all function names have been changed
-;;; by capitalizing the first letter: Values, Multiple-value-*,
-;;; to avoid conflict with the new-style definitions in cl-macs.
-
-(defvar *mvalues-values* nil)
-
-(defun Values (&rest val-forms)
- (setq *mvalues-values* val-forms)
- (car val-forms))
-
-(defun Values-list (val-forms)
- (apply 'values val-forms))
-
-(defmacro Multiple-value-list (form)
- (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form))
- '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*)
- (list *mvalues-temp*))))
-
-(defmacro Multiple-value-call (function &rest args)
- (declare (indent 1))
- (list 'apply function
- (cons 'append
- (mapcar (function (lambda (x) (list 'Multiple-value-list x)))
- args))))
-
-(defmacro Multiple-value-bind (vars form &rest body)
- (declare (indent 2))
- (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
-
-(defmacro Multiple-value-setq (vars form)
- (declare (indent 2))
- (list 'multiple-value-setq vars (list 'Multiple-value-list form)))
-
-(defmacro Multiple-value-prog1 (form &rest body)
- (declare (indent 1))
- (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
-
-
-;;; Routines for parsing keyword arguments.
-
-(defun build-klist (arglist keys &optional allow-others)
- (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
- (or allow-others
- (let ((bad (set-difference (mapcar 'car res) keys)))
- (if bad (error "Bad keywords: %s not in %s" bad keys))))
- res))
-
-(defun extract-from-klist (klist key &optional def)
- (let ((res (assq key klist))) (if res (cdr res) def)))
-
-(defun keyword-argument-supplied-p (klist key)
- (assq key klist))
-
-(defun elt-satisfies-test-p (item elt klist)
- (let ((test-not (cdr (assq ':test-not klist)))
- (test (cdr (assq ':test klist)))
- (key (cdr (assq ':key klist))))
- (if key (setq elt (funcall key elt)))
- (if test-not (not (funcall test-not item elt))
- (funcall (or test 'eql) item elt))))
-
-
-;;; Rounding functions with old-style multiple value returns.
-
-(defun cl-floor (a &optional b) (Values-list (floor* a b)))
-(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b)))
-(defun cl-round (a &optional b) (Values-list (round* a b)))
-(defun cl-truncate (a &optional b) (Values-list (truncate* a b)))
-
-(defun safe-idiv (a b)
- (let* ((q (/ (abs a) (abs b)))
- (s (* (signum a) (signum b))))
- (Values q (- a (* s q b)) s)))
-
-
-;; Internal routines.
-
-(defun pair-with-newsyms (oldforms)
- (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms)))
- (Values (mapcar* 'list newsyms oldforms) newsyms)))
-
-(defun zip-lists (evens odds)
- (mapcan 'list evens odds))
-
-(defun unzip-lists (list)
- (let ((e nil) (o nil))
- (while list
- (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list)))
- (Values (nreverse e) (nreverse o))))
-
-(defun reassemble-argslists (list)
- (let ((n (apply 'min (mapcar 'length list))) (res nil))
- (while (>= (setq n (1- n)) 0)
- (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res)))
- res))
-
-(defun duplicate-symbols-p (list)
- (let ((res nil))
- (while list
- (if (memq (car list) (cdr list)) (setq res (cons (car list) res)))
- (setq list (cdr list)))
- res))
-
-
-;;; Setf internals.
-
-(defun setnth (n list x)
- (setcar (nthcdr n list) x))
-
-(defun setnthcdr (n list x)
- (setcdr (nthcdr (1- n) list) x))
-
-(defun setelt (seq n x)
- (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x)))
-
-
-;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms,
-;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms,
-;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify,
-;;; all names with embedded `$'.
-
-
-(provide 'cl-compat)
-
-;; Local variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
-;; arch-tag: 9996bb4f-aaf5-4592-b436-bf64759a3163
-;;; cl-compat.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 38ae511db78..9b275255b27 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -645,7 +645,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
(load "cl-loaddefs" nil 'quiet)
;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl-19) ; usage: (require 'cl-19 "cl")
(provide 'cl)
;; Things to do after byte-compiler is loaded.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 43fb5762647..145498b9059 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -4011,18 +4011,16 @@ May only be called from within `edebug-recursive-edit'."
-(defvar edebug-eval-mode-map nil
- "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
-
-(unless edebug-eval-mode-map
- (setq edebug-eval-mode-map (make-sparse-keymap))
- (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map)
-
- (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
- (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
- (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
- (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
- (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp))
+(defvar edebug-eval-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map lisp-interaction-mode-map)
+ (define-key map "\C-c\C-w" 'edebug-where)
+ (define-key map "\C-c\C-d" 'edebug-delete-eval-item)
+ (define-key map "\C-c\C-u" 'edebug-update-eval-list)
+ (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
+ (define-key map "\C-j" 'edebug-eval-print-last-sexp)
+ map)
+"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
(put 'edebug-eval-mode 'mode-class 'special)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index cfb56eb3232..d0d1520a677 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -646,49 +646,49 @@ considered."
(defun lisp-completion-at-point (&optional predicate)
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
;; FIXME: the `end' could be after point?
- (let* ((pos (point))
- (beg (with-syntax-table emacs-lisp-mode-syntax-table
- (condition-case nil
- (save-excursion
- (backward-sexp 1)
- (skip-syntax-forward "'")
- (point))
- (scan-error pos))))
- (predicate
- (or predicate
- (save-excursion
- (goto-char beg)
- (if (not (eq (char-before) ?\())
- (lambda (sym) ;why not just nil ? -sm
- (or (boundp sym) (fboundp sym)
- (symbol-plist sym)))
- ;; Looks like a funcall position. Let's double check.
- (if (condition-case nil
- (progn (up-list -2) (forward-char 1)
- (eq (char-after) ?\())
- (error nil))
- ;; If the first element of the parent list is an open
- ;; parenthesis we are probably not in a funcall position.
- ;; Maybe a `let' varlist or something.
- nil
- ;; Else, we assume that a function name is expected.
- 'fboundp)))))
- (end
- (unless (or (eq beg (point-max))
- (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
- (condition-case nil
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (when (>= (point) pos)
- (point)))
- (scan-error pos)))))
- (when end
- (list beg end obarray
- :predicate predicate
- :annotate-function
- (unless (eq predicate 'fboundp)
- (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))))
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (let* ((pos (point))
+ (beg (condition-case nil
+ (save-excursion
+ (backward-sexp 1)
+ (skip-syntax-forward "'")
+ (point))
+ (scan-error pos)))
+ (predicate
+ (or predicate
+ (save-excursion
+ (goto-char beg)
+ (if (not (eq (char-before) ?\())
+ (lambda (sym) ;why not just nil ? -sm
+ (or (boundp sym) (fboundp sym)
+ (symbol-plist sym)))
+ ;; Looks like a funcall position. Let's double check.
+ (if (condition-case nil
+ (progn (up-list -2) (forward-char 1)
+ (eq (char-after) ?\())
+ (error nil))
+ ;; If the first element of the parent list is an open
+ ;; paren we are probably not in a funcall position.
+ ;; Maybe a `let' varlist or something.
+ nil
+ ;; Else, we assume that a function name is expected.
+ 'fboundp)))))
+ (end
+ (unless (or (eq beg (point-max))
+ (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
+ (condition-case nil
+ (save-excursion
+ (goto-char beg)
+ (forward-sexp 1)
+ (when (>= (point) pos)
+ (point)))
+ (scan-error pos)))))
+ (when end
+ (list beg end obarray
+ :predicate predicate
+ :annotate-function
+ (unless (eq predicate 'fboundp)
+ (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))))
;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
;;; lisp.el ends here
diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el
deleted file mode 100644
index 54fb488ed59..00000000000
--- a/lisp/emacs-lisp/lmenu.el
+++ /dev/null
@@ -1,443 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992, 1993, 1994, 1997, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Keywords: emulations obsolete
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-(defvar lucid-menubar-map)
-(defvar lucid-failing-menubar)
-
-(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
- (define-key lucid-menubar-map [menu-bar]
- (condition-case nil
- (make-lucid-menu-keymap "menu-bar" current-menubar)
- (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
- (sit-for 1)
- (setq lucid-failing-menubar current-menubar
- current-menubar nil))))
- (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'current-menubar lucid-menubar-map)
- minor-mode-map-alist)))
-
-;; XEmacs compatibility
-(defun set-menubar-dirty-flag ()
- (force-mode-line-update)
- (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
- (let ((menu (make-sparse-keymap menu-name)))
- ;; Process items in reverse order,
- ;; since the define-key loop reverses them again.
- (setq menu-items (reverse menu-items))
- (while menu-items
- (let ((item (car menu-items))
- command name callback)
- (cond ((stringp item)
- (setq command nil)
- (setq name (if (string-match "^-+$" item) "" item)))
- ((consp item)
- (setq command (make-lucid-menu-keymap (car item) (cdr item)))
- (setq name (car item)))
- ((vectorp item)
- (setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count))
- add-menu-item-count (1+ add-menu-item-count)
- name (aref item 0)
- callback (aref item 1))
- (if (symbolp callback)
- (fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))
- (put command 'menu-alias t)
- (let ((i 2))
- (while (< i (length item))
- (cond
- ((eq (aref item i) ':active)
- (put command 'menu-enable
- (or (aref item (1+ i))
- 'make-lucid-menu-keymap-disable))
- (setq i (+ 2 i)))
- ((eq (aref item i) ':suffix)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':keys)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':style)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':selected)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((and (symbolp (aref item i))
- (= ?: (string-to-char (symbol-name (aref item i)))))
- (error "Unrecognized menu item keyword: %S"
- (aref item i)))
- ((= i 2)
- ;; old-style format: active-p &optional suffix
- (put command 'menu-enable
- (or (aref item i) 'make-lucid-menu-keymap-disable))
- ;; suffix is unimplemented
- (setq i (length item)))
- (t
- (error "Unexpected menu item value: %S"
- (aref item i))))))))
- (if (null command)
- ;; Handle inactive strings specially--allow any number
- ;; of identical ones.
- (setcdr menu (cons (list nil name) (cdr menu)))
- (if name
- (define-key menu (vector (intern name)) (cons name command)))))
- (setq menu-items (cdr menu-items)))
- menu))
-
-(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
-
-;; XEmacs compatibility function
-(defun popup-dialog-box (data)
- "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
- Each one is a vector of three elements:
- - The first element is the text of the button.
- - The second element is the `callback'.
- - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'. If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be nil. This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
- form := <something to pass to `eval'>
- command := <a symbol or string, to pass to `call-interactively'>
- callback := command | form
- active-p := <t, nil, or a form to evaluate to decide whether this
- button should be selectable>
- name := <string>
- partition := 'nil'
- button := '[' name callback active-p ']'
- dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'"
- (let ((name (car data))
- (tail (cdr data))
- converted
- choice meaning)
- (while tail
- (if (null (car tail))
- (setq converted (cons nil converted))
- (let ((item (aref (car tail) 0))
- (callback (aref (car tail) 1))
- (enable (aref (car tail) 2)))
- (setq converted
- (cons (if enable (cons item callback) item)
- converted))))
- (setq tail (cdr tail)))
- (setq choice (x-popup-dialog t (cons name (nreverse converted))))
- (if choice
- (if (symbolp choice)
- (call-interactively choice)
- (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-;; XEmacs compatibility
-(defun set-menubar (menubar)
- "Set the default menubar to be menubar."
- (setq-default current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-;; XEmacs compatibility
-(defun set-buffer-menubar (menubar)
- "Set the buffer-local menubar to be menubar."
- (make-local-variable 'current-menubar)
- (setq current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-;; XEmacs compatibility
-(defun find-menu-item (menubar item-path-list &optional parent)
- "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
- (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (while rest
- (if (and (car rest)
- (equal (car item-path-list)
- (downcase (if (vectorp (car rest))
- (aref (car rest) 0)
- (if (stringp (car rest))
- (car rest)
- (car (car rest)))))))
- (setq result (car rest) rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (if (consp result)
- (find-menu-item (cdr result) (cdr item-path-list) result)
- (if result
- (signal 'error (list "not a submenu" result))
- (signal 'error (list "no such submenu" (car item-path-list)))))
- (cons result parent)))))
-
-
-;; XEmacs compatibility
-(defun disable-menu-item (path)
- "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "can't disable menus, only menu items"))
- (aset item 2 nil)
- (set-menubar-dirty-flag)
- item))
-
-
-;; XEmacs compatibility
-(defun enable-menu-item (path)
- "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "%S is a menu, not a menu item" path))
- (aset item 2 t)
- (set-menubar-dirty-flag)
- item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
- (if before (setq before (downcase before)))
- (let* ((menubar current-menubar)
- (menu (condition-case ()
- (car (find-menu-item menubar menu-path))
- (error nil)))
- (item (if (listp menu)
- (car (find-menu-item (cdr menu) (list item-name)))
- (signal 'error (list "not a submenu" menu-path)))))
- (or menu
- (let ((rest menu-path)
- (so-far menubar))
- (while rest
-;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
- (setq menu
- (if (eq so-far menubar)
- (car (find-menu-item so-far (list (car rest))))
- (car (find-menu-item (cdr so-far) (list (car rest))))))
- (or menu
- (let ((rest2 so-far))
- (or rest2
- (error "Trying to modify a menu that doesn't exist"))
- (while (and (cdr rest2) (car (cdr rest2)))
- (setq rest2 (cdr rest2)))
- (setcdr rest2
- (nconc (list (setq menu (list (car rest))))
- (cdr rest2)))))
- (setq so-far menu)
- (setq rest (cdr rest)))))
- (or menu (setq menu menubar))
- (if item
- nil ; it's already there
- (if item-p
- (setq item (vector item-name item-data enabled-p))
- (setq item (cons item-name item-data)))
- ;; if BEFORE is specified, try to add it there.
- (if before
- (setq before (car (find-menu-item menu (list before)))))
- (let ((rest menu)
- (added-before nil))
- (while rest
- (if (eq before (car (cdr rest)))
- (progn
- (setcdr rest (cons item (cdr rest)))
- (setq rest nil added-before t))
- (setq rest (cdr rest))))
- (if (not added-before)
- ;; adding before the first item on the menubar itself is harder
- (if (and (eq menu menubar) (eq before (car menu)))
- (setq menu (cons item menu)
- current-menubar menu)
- ;; otherwise, add the item to the end.
- (nconc menu (list item))))))
- (if item-p
- (progn
- (aset item 1 item-data)
- (aset item 2 (not (null enabled-p))))
- (setcar item item-name)
- (setcdr item item-data))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
- "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked. If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already. If the item is already
- present, it will not be moved."
- (or menu-path (error "must specify a menu path"))
- (or item-name (error "must specify an item name"))
- (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-;; XEmacs compatibility
-(defun delete-menu-item (path)
- "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (or (cdr pair) menubar)))
- (if (not item)
- nil
- ;; the menubar is the only special case, because other menus begin
- ;; with their name.
- (if (eq menu current-menubar)
- (setq current-menubar (delq item menu))
- (delq item menu))
- (set-menubar-dirty-flag)
- item)))
-
-
-;; XEmacs compatibility
-(defun relabel-menu-item (path new-name)
- "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
- (or (stringp new-name)
- (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (and (consp item)
- (stringp (car item)))
- (setcar item new-name)
- (aset item 0 new-name))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu (menu-path menu-name menu-items &optional before)
- "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
- - a string, the name of the menu item;
- - a symbol naming a command, or a form to evaluate;
- - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already. If the menu is already
- present, it will not be moved."
- (or menu-name (error "must specify a menu name"))
- (or menu-items (error "must specify some menu items"))
- (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;; (while frames
-;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;; (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;; (setq default-frame-alist
-;; (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;; arch-tag: 7051c396-2837-435a-ae11-b2d2e2af8fc1
-;;; lmenu.el ends here
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index a1494741572..6389b62ea04 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -96,19 +96,24 @@ The returned regexp is typically more efficient than the equivalent regexp:
(concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
If PAREN is `words', then the resulting regexp is additionally surrounded
-by \\=\\< and \\>."
+by \\=\\< and \\>.
+If PAREN is `symbols', then the resulting regexp is additionally surrounded
+by \\=\\_< and \\_>."
(save-match-data
;; Recurse on the sorted list.
(let* ((max-lisp-eval-depth 10000)
(max-specpdl-size 10000)
(completion-ignore-case nil)
(completion-regexp-list nil)
- (words (eq paren 'words))
(open (cond ((stringp paren) paren) (paren "\\(")))
(sorted-strings (delete-dups
(sort (copy-sequence strings) 'string-lessp)))
(re (regexp-opt-group sorted-strings (or open t) (not open))))
- (if words (concat "\\<" re "\\>") re))))
+ (cond ((eq paren 'words)
+ (concat "\\<" re "\\>"))
+ ((eq paren 'symbols)
+ (concat "\\_<" re "\\_>"))
+ (t re)))))
;;;###autoload
(defun regexp-opt-depth (regexp)
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index a41db864a1b..e690cbaa1bc 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -24,7 +24,7 @@
;;; Commentary:
-;; The functions in this file detect (`find-emacs-lisp-shadows')
+;; The functions in this file detect (`load-path-shadows-find')
;; and display (`list-load-path-shadows') potential load-path
;; problems that arise when Emacs Lisp files "shadow" each other.
;;
@@ -53,16 +53,19 @@
(defgroup lisp-shadow nil
"Locate Emacs Lisp file shadowings."
- :prefix "shadows-"
+ :prefix "load-path-shadows-"
:group 'lisp)
-(defcustom shadows-compare-text-p nil
+(define-obsolete-variable-alias 'shadows-compare-text-p
+ 'load-path-shadows-compare-text "23.3")
+
+(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
:type 'boolean
:group 'lisp-shadow)
-(defun find-emacs-lisp-shadows (&optional path)
+(defun load-path-shadows-find (&optional path)
"Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.
@@ -124,11 +127,11 @@ See the documentation for `list-load-path-shadows' for further information."
;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" file))
(base2 (concat dir "/" file)))
- (if (not (and shadows-compare-text-p
- (shadow-same-file-or-nonexistent
+ (if (not (and load-path-shadows-compare-text
+ (load-path-shadows-same-file-or-nonexistent
(concat base1 ".el") (concat base2 ".el"))
;; This is a bit strict, but safe.
- (shadow-same-file-or-nonexistent
+ (load-path-shadows-same-file-or-nonexistent
(concat base1 ".elc") (concat base2 ".elc"))))
(setq shadows
(append shadows (list base1 base2)))))
@@ -138,9 +141,12 @@ See the documentation for `list-load-path-shadows' for further information."
;; Return the list of shadowings.
shadows))
+(define-obsolete-function-alias 'find-emacs-lisp-shadows
+ 'load-path-shadows-find "23.3")
+
;; Return true if neither file exists, or if both exist and have identical
;; contents.
-(defun shadow-same-file-or-nonexistent (f1 f2)
+(defun load-path-shadows-same-file-or-nonexistent (f1 f2)
(let ((exists1 (file-exists-p f1))
(exists2 (file-exists-p f2)))
(or (and (not exists1) (not exists2))
@@ -151,6 +157,34 @@ See the documentation for `list-load-path-shadows' for further information."
(and (= (nth 7 (file-attributes f1))
(nth 7 (file-attributes f2)))
(eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
+
+(defvar load-path-shadows-font-lock-keywords
+ `((,(format "hides \\(%s.*\\)"
+ (file-name-directory (locate-library "simple.el")))
+ . (1 font-lock-warning-face)))
+ "Keywords to highlight in `load-path-shadows-mode'.")
+
+(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
+ "Major mode for load-path shadows buffer."
+ (set (make-local-variable 'font-lock-defaults)
+ '((load-path-shadows-font-lock-keywords)))
+ (setq buffer-undo-list t
+ buffer-read-only t))
+
+;; TODO use text-properties instead, a la dired.
+(require 'button)
+(define-button-type 'load-path-shadows-find-file
+ 'follow-link t
+;; 'face 'default
+ 'action (lambda (button)
+ (let ((file (concat (button-get button 'shadow-file) ".el")))
+ (or (file-exists-p file)
+ (setq file (concat file ".gz")))
+ (if (file-readable-p file)
+ (pop-to-buffer (find-file-noselect file))
+ (error "Cannot read file"))))
+ 'help-echo "mouse-2, RET: find this file")
+
;;;###autoload
(defun list-load-path-shadows (&optional stringp)
@@ -193,7 +227,7 @@ XXX.elc in an early directory \(that does not contain XXX.el\) is
considered to shadow a later file XXX.el, and vice-versa.
Shadowings are located by calling the (non-interactive) companion
-function, `find-emacs-lisp-shadows'."
+function, `load-path-shadows-find'."
(interactive)
(let* ((path (copy-sequence load-path))
(tem path)
@@ -217,7 +251,7 @@ function, `find-emacs-lisp-shadows'."
(setq tem nil)))
(setq tem (cdr tem)))))
- (let* ((shadows (find-emacs-lisp-shadows path))
+ (let* ((shadows (load-path-shadows-find path))
(n (/ (length shadows) 2))
(msg (format "%s Emacs Lisp load-path shadowing%s found"
(if (zerop n) "No" (concat "\n" (number-to-string n)))
@@ -234,14 +268,21 @@ function, `find-emacs-lisp-shadows'."
;; Create the *Shadows* buffer and display shadowings there.
(let ((string (buffer-string)))
(with-current-buffer (get-buffer-create "*Shadows*")
- (fundamental-mode) ;run after-change-major-mode-hook.
(display-buffer (current-buffer))
- (setq buffer-undo-list t
- buffer-read-only nil)
- (erase-buffer)
- (insert string)
- (insert msg "\n")
- (setq buffer-read-only t)))
+ (load-path-shadows-mode) ; run after-change-major-mode-hook
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert string)
+ (insert msg "\n")
+ (while (re-search-backward "\\(^.*\\) hides \\(.*$\\)"
+ nil t)
+ (dotimes (i 2)
+ (make-button (match-beginning (1+ i))
+ (match-end (1+ i))
+ 'type 'load-path-shadows-find-file
+ 'shadow-file
+ (match-string (1+ i)))))
+ (goto-char (point-max)))))
;; We are non-interactive, print shadows via message.
(unless (zerop n)
(message "This site has duplicate Lisp libraries with the same name.
@@ -259,5 +300,4 @@ version unless you know what you are doing.\n")
(provide 'shadow)
-;; arch-tag: 0480e8a7-62ed-4a12-a9f6-f44ded9b0830
;;; shadow.el ends here
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 55516d276da..4f5b2046150 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -138,7 +138,12 @@ one of those elements share the same precedence level and associativity."
(let ((prec2 (make-hash-table :test 'equal)))
(dolist (table tables)
(maphash (lambda (k v)
- (smie-set-prec2tab prec2 (car k) (cdr k) v))
+ (if (consp k)
+ (smie-set-prec2tab prec2 (car k) (cdr k) v)
+ (if (and (gethash k prec2)
+ (not (equal (gethash k prec2) v)))
+ (error "Conflicting values for %s property" k)
+ (puthash k v prec2))))
table))
prec2)))
@@ -225,6 +230,9 @@ one of those elements share the same precedence level and associativity."
'= override)))
(t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override)))
(setq rhs (cdr rhs)))))
+ ;; Keep track of which tokens are openers/closer, so they can get a nil
+ ;; precedence in smie-prec2-levels.
+ (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2)
prec2))
;; (defun smie-prec2-closer-alist (prec2 include-inners)
@@ -307,6 +315,33 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\").
(pushnew (cons (car rhs) term) alist :test #'equal)))))))
(nreverse alist)))
+(defun smie-bnf-classify (bnf)
+ "Return a table classifying terminals.
+Each terminal can either be an `opener', a `closer', or neither."
+ (let ((table (make-hash-table :test #'equal))
+ (alist '()))
+ (dolist (category bnf)
+ (puthash (car category) 'neither table) ;Remove non-terminals.
+ (dolist (rhs (cdr category))
+ (if (null (cdr rhs))
+ (puthash (pop rhs) 'neither table)
+ (let ((first (pop rhs)))
+ (puthash first
+ (if (memq (gethash first table) '(nil opener))
+ 'opener 'neither)
+ table))
+ (while (cdr rhs)
+ (puthash (pop rhs) 'neither table)) ;Remove internals.
+ (let ((last (pop rhs)))
+ (puthash last
+ (if (memq (gethash last table) '(nil closer))
+ 'closer 'neither)
+ table)))))
+ (maphash (lambda (tok v)
+ (when (memq v '(closer opener))
+ (push (cons tok v) alist)))
+ table)
+ alist))
(defun smie-debug--prec2-cycle (csts)
"Return a cycle in CSTS, assuming there's one.
@@ -345,11 +380,6 @@ CSTS is a list of pairs representing arcs in a graph."
(defun smie-prec2-levels (prec2)
;; FIXME: Rather than only return an alist of precedence levels, we should
;; also extract other useful data from it:
- ;; - matching sets of block openers&closers (which can otherwise become
- ;; collapsed into a single equivalence class in smie-op-levels) for
- ;; smie-close-block as well as to detect mismatches in smie-next-sexp
- ;; or in blink-paren (as well as to do the blink-paren for inner
- ;; keywords like the "in" of "let..in..end").
;; - better default indentation rules (i.e. non-zero indentation after inner
;; keywords like the "in" of "let..in..end") for smie-indent-after-keyword.
;; Of course, maybe those things would be even better handled in the
@@ -369,18 +399,19 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
;; variables (aka "precedence levels"). These can be either
;; equality constraints (in `eqs') or `<' constraints (in `csts').
(maphash (lambda (k v)
- (if (setq tmp (assoc (car k) table))
- (setq x (cddr tmp))
- (setq x (cons nil nil))
- (push (cons (car k) (cons nil x)) table))
- (if (setq tmp (assoc (cdr k) table))
- (setq y (cdr tmp))
- (setq y (cons nil (cons nil nil)))
- (push (cons (cdr k) y) table))
- (ecase v
- (= (push (cons x y) eqs))
- (< (push (cons x y) csts))
- (> (push (cons y x) csts))))
+ (when (consp k)
+ (if (setq tmp (assoc (car k) table))
+ (setq x (cddr tmp))
+ (setq x (cons nil nil))
+ (push (cons (car k) (cons nil x)) table))
+ (if (setq tmp (assoc (cdr k) table))
+ (setq y (cdr tmp))
+ (setq y (cons nil (cons nil nil)))
+ (push (cons (cdr k) y) table))
+ (ecase v
+ (= (push (cons x y) eqs))
+ (< (push (cons x y) csts))
+ (> (push (cons y x) csts)))))
prec2)
;; First process the equality constraints.
(let ((eqs eqs))
@@ -432,16 +463,22 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
(setcar (car eq) (cadr eq)))
;; Finally, fill in the remaining vars (which only appeared on the
;; right side of the < constraints).
- (dolist (x table)
- ;; When both sides are nil, it means this operator binds very
- ;; very tight, but it's still just an operator, so we give it
- ;; the highest precedence.
- ;; OTOH if only one side is nil, it usually means it's like an
- ;; open-paren, which is very important for indentation purposes,
- ;; so we keep it nil, to make it easier to recognize.
- (unless (or (nth 1 x) (nth 2 x))
- (setf (nth 1 x) i)
- (setf (nth 2 x) i))))
+ (let ((classification-table (gethash :smie-open/close-alist prec2)))
+ (dolist (x table)
+ ;; When both sides are nil, it means this operator binds very
+ ;; very tight, but it's still just an operator, so we give it
+ ;; the highest precedence.
+ ;; OTOH if only one side is nil, it usually means it's like an
+ ;; open-paren, which is very important for indentation purposes,
+ ;; so we keep it nil if so, to make it easier to recognize.
+ (unless (or (nth 1 x)
+ (eq 'opener (cdr (assoc (car x) classification-table))))
+ (setf (nth 1 x) i)
+ (incf i)) ;See other (incf i) above.
+ (unless (or (nth 2 x)
+ (eq 'closer (cdr (assoc (car x) classification-table))))
+ (setf (nth 2 x) i)
+ (incf i))))) ;See other (incf i) above.
table))
;;; Parsing using a precedence level table.
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 08:10:06 +0000