From 9414dd8d50cc49464c97a5cb81f38796ff1fbec1 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 6 Oct 2012 22:18:35 +0800 Subject: Move bovine-grammar and wisent-grammar into lisp/ directory. * lisp/files.el (auto-mode-alist): Add .by and .wy (Semantic grammars). * cedet/semantic/bovine/grammar.el: * cedet/semantic/wisent/grammar.el: Move from admin/grammars. Add autoloads for bovine-grammar-mode and wisent-grammar-mode. --- admin/ChangeLog | 5 + admin/grammars/bovine-grammar.el | 507 ------------------------------------- admin/grammars/wisent-grammar.el | 526 --------------------------------------- 3 files changed, 5 insertions(+), 1033 deletions(-) delete mode 100644 admin/grammars/bovine-grammar.el delete mode 100644 admin/grammars/wisent-grammar.el (limited to 'admin') diff --git a/admin/ChangeLog b/admin/ChangeLog index 2da65523116..8fe82ca36cb 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2012-10-01 David Engster + + * grammars/bovine-grammar.el: + * grammars/wisent-grammar.el: Move to lisp directory. + 2012-10-01 David Engster * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote): diff --git a/admin/grammars/bovine-grammar.el b/admin/grammars/bovine-grammar.el deleted file mode 100644 index a7289f6bafe..00000000000 --- a/admin/grammars/bovine-grammar.el +++ /dev/null @@ -1,507 +0,0 @@ -;;; bovine-grammar.el --- Bovine's input grammar mode -;; -;; Copyright (C) 2002-2012 Free Software Foundation, Inc. -;; -;; Author: David Ponce -;; Maintainer: David Ponce -;; Created: 26 Aug 2002 -;; Keywords: syntax - -;; 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 . - -;;; Commentary: -;; -;; Major mode for editing Bovine's input grammar (.by) files. - -;;; History: - -;;; Code: -(require 'semantic) -(require 'semantic/grammar) -(require 'semantic/find) -(require 'semantic/lex) -(require 'semantic/wisent) -(require 'semantic/bovine) - -(defun bovine-grammar-EXPAND (bounds nonterm) - "Expand call to EXPAND grammar macro. -Return the form to parse from within a nonterminal between BOUNDS. -NONTERM is the nonterminal symbol to start with." - `(semantic-bovinate-from-nonterminal - (car ,bounds) (cdr ,bounds) ',nonterm)) - -(defun bovine-grammar-EXPANDFULL (bounds nonterm) - "Expand call to EXPANDFULL grammar macro. -Return the form to recursively parse the area between BOUNDS. -NONTERM is the nonterminal symbol to start with." - `(semantic-parse-region - (car ,bounds) (cdr ,bounds) ',nonterm 1)) - -(defun bovine-grammar-TAG (name class &rest attributes) - "Expand call to TAG grammar macro. -Return the form to create a generic semantic tag. -See the function `semantic-tag' for the meaning of arguments NAME, -CLASS and ATTRIBUTES." - `(semantic-tag ,name ,class ,@attributes)) - -(defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes) - "Expand call to VARIABLE-TAG grammar macro. -Return the form to create a semantic tag of class variable. -See the function `semantic-tag-new-variable' for the meaning of -arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES." - `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes)) - -(defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes) - "Expand call to FUNCTION-TAG grammar macro. -Return the form to create a semantic tag of class function. -See the function `semantic-tag-new-function' for the meaning of -arguments NAME, TYPE, ARG-LIST and ATTRIBUTES." - `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes)) - -(defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes) - "Expand call to TYPE-TAG grammar macro. -Return the form to create a semantic tag of class type. -See the function `semantic-tag-new-type' for the meaning of arguments -NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES." - `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)) - -(defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes) - "Expand call to INCLUDE-TAG grammar macro. -Return the form to create a semantic tag of class include. -See the function `semantic-tag-new-include' for the meaning of -arguments NAME, SYSTEM-FLAG and ATTRIBUTES." - `(semantic-tag-new-include ,name ,system-flag ,@attributes)) - -(defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes) - "Expand call to PACKAGE-TAG grammar macro. -Return the form to create a semantic tag of class package. -See the function `semantic-tag-new-package' for the meaning of -arguments NAME, DETAIL and ATTRIBUTES." - `(semantic-tag-new-package ,name ,detail ,@attributes)) - -(defun bovine-grammar-CODE-TAG (name detail &rest attributes) - "Expand call to CODE-TAG grammar macro. -Return the form to create a semantic tag of class code. -See the function `semantic-tag-new-code' for the meaning of arguments -NAME, DETAIL and ATTRIBUTES." - `(semantic-tag-new-code ,name ,detail ,@attributes)) - -(defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes) - "Expand call to ALIAS-TAG grammar macro. -Return the form to create a semantic tag of class alias. -See the function `semantic-tag-new-alias' for the meaning of arguments -NAME, ALIASCLASS, DEFINITION and ATTRIBUTES." - `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)) - -;; Cache of macro definitions currently in use. -(defvar bovine--grammar-macros nil) - -(defun bovine-grammar-expand-form (form quotemode &optional inplace) - "Expand FORM into a new one suitable to the bovine parser. -FORM is a list in which we are substituting. -Argument QUOTEMODE is non-nil if we are in backquote mode. -When non-nil, optional argument INPLACE indicates that FORM is being -expanded from elsewhere." - (when (eq (car form) 'quote) - (setq form (cdr form)) - (cond - ((and (= (length form) 1) (listp (car form))) - (insert "\n(append") - (bovine-grammar-expand-form (car form) quotemode nil) - (insert ")") - (setq form nil inplace nil) - ) - ((and (= (length form) 1) (symbolp (car form))) - (insert "\n'" (symbol-name (car form))) - (setq form nil inplace nil) - ) - (t - (insert "\n(list") - (setq inplace t) - ))) - (let ((macro (assq (car form) bovine--grammar-macros)) - inlist first n q x) - (if macro - (bovine-grammar-expand-form - (apply (cdr macro) (cdr form)) - quotemode t) - (if inplace (insert "\n(")) - (while form - (setq first (car form) - form (cdr form)) - ;; Hack for dealing with new reading of unquotes outside of - ;; backquote (introduced in rev. 102591 in emacs-bzr). - (when (and (>= emacs-major-version 24) - (listp first) - (or (equal (car first) '\,) - (equal (car first) '\,@))) - (if (listp (cadr first)) - (setq form (append (cdr first) form) - first (car first)) - (setq first (intern (concat (symbol-name (car first)) - (symbol-name (cadr first))))))) - (cond - ((eq first nil) - (when (and (not inlist) (not inplace)) - (insert "\n(list") - (setq inlist t)) - (insert " nil") - ) - ((listp first) - ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form))))) - (when (and (not inlist) (not inplace)) - (insert "\n(list") - (setq inlist t)) - ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) - ;; (insert " (append")) - (bovine-grammar-expand-form - first quotemode t) ;;(and fn (not (eq fn 'quote)))) - ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) - ;; (insert ")")) - ;;) - ) - ((symbolp first) - (setq n (symbol-name first) ;the name - q quotemode ;implied quote flag - x nil) ;expand flag - (if (eq (aref n 0) ?,) - (if quotemode - ;; backquote mode needs the @ - (if (eq (aref n 1) ?@) - (setq n (substring n 2) - q nil - x t) - ;; non backquote mode behaves normally. - (setq n (substring n 1) - q nil)) - (setq n (substring n 1) - x t))) - (if (string= n "") - (progn - ;; We expand only the next item in place (a list?) - ;; A regular inline-list... - (bovine-grammar-expand-form (car form) quotemode t) - (setq form (cdr form))) - (if (and (eq (aref n 0) ?$) - ;; Don't expand $ tokens in implied quote mode. - ;; This acts like quoting in other symbols. - (not q)) - (progn - (cond - ((and (not x) (not inlist) (not inplace)) - (insert "\n(list")) - ((and x inlist (not inplace)) - (insert ")") - (setq inlist nil))) - (insert "\n(nth " (int-to-string - (1- (string-to-number - (substring n 1)))) - " vals)") - (and (not x) (not inplace) - (setq inlist t))) - - (when (and (not inlist) (not inplace)) - (insert "\n(list") - (setq inlist t)) - (or (char-equal (char-before) ?\() - (insert " ")) - (insert (if (or inplace (eq first t)) - "" "'") - n))) ;; " " - ) - (t - (when (and (not inlist) (not inplace)) - (insert "\n(list") - (setq inlist t)) - (insert (format "\n%S" first)) - ) - )) - (if inlist (insert ")")) - (if inplace (insert ")"))) - )) - -(defun bovine-grammar-expand-action (textform quotemode) - "Expand semantic action string TEXTFORM into Lisp code. -QUOTEMODE is the mode in which quoted symbols are slurred." - (if (string= "" textform) - nil - (let ((sexp (read textform))) - ;; We converted the lambda string into a list. Now write it - ;; out as the bovine lambda expression, and do macro-like - ;; conversion upon it. - (insert "\n") - (cond - ((eq (car sexp) 'EXPAND) - (insert ",(lambda (vals start end)") - ;; The EXPAND macro definition is mandatory - (bovine-grammar-expand-form - (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) - quotemode t) - ) - ((and (listp (car sexp)) (eq (caar sexp) 'EVAL)) - ;; The user wants to evaluate the following args. - ;; Use a simpler expander - ) - (t - (insert ",(semantic-lambda") - (bovine-grammar-expand-form sexp quotemode) - )) - (insert ")\n"))) -) - -(defun bovine-grammar-parsetable-builder () - "Return the parser table expression as a string value. -The format of a bovine parser table is: - - ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 ) - ( NONTERMINAL-SYMBOL2 MATCH-LIST2 ) - ... - ( NONTERMINAL-SYMBOLn MATCH-LISTn ) - -Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear -in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS -must be `bovine-toplevel'. - -A MATCH-LIST is a list of possible matches of the form: - - ( STATE-LIST1 - STATE-LIST2 - ... - STATE-LISTN ) - -where STATE-LIST is of the form: - ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA ) - -where TYPE is one of the returned types of the token stream. -VALUE is a value, or range of values to match against. For -example, a SYMBOL might need to match \"foo\". Some TYPES will not -have matching criteria. - -LAMBDA is a lambda expression which is evalled with the text of the -type when it is found. It is passed the list of all buffer text -elements found since the last lambda expression. It should return a -semantic element (see below.) - -For consistency between languages, try to use common return values -from your parser. Please reference the chapter \"Writing Parsers\" in -the \"Language Support Developer's Guide -\" in the semantic texinfo -manual." - (let* ((start (semantic-grammar-start)) - (scopestart (semantic-grammar-scopestart)) - (quotemode (semantic-grammar-quotemode)) - (tags (semantic-find-tags-by-class - 'token (current-buffer))) - (nterms (semantic-find-tags-by-class - 'nonterminal (current-buffer))) - ;; Setup the cache of macro definitions. - (bovine--grammar-macros (semantic-grammar-macros)) - nterm rules items item actn prec tag type regex) - - ;; Check some trivial things - (cond - ((null nterms) - (error "Bad input grammar")) - (start - (if (cdr start) - (message "Extra start symbols %S ignored" (cdr start))) - (setq start (symbol-name (car start))) - (unless (semantic-find-first-tag-by-name start nterms) - (error "start symbol `%s' has no rule" start))) - (t - ;; Default to the first grammar rule. - (setq start (semantic-tag-name (car nterms))))) - (when scopestart - (setq scopestart (symbol-name scopestart)) - (unless (semantic-find-first-tag-by-name scopestart nterms) - (error "scopestart symbol `%s' has no rule" scopestart))) - - ;; Generate the grammar Lisp form. - (with-temp-buffer - (erase-buffer) - (insert "`(") - ;; Insert the start/scopestart rules - (insert "\n(bovine-toplevel \n(" - start - ")\n) ;; end bovine-toplevel\n") - (when scopestart - (insert "\n(bovine-inner-scope \n(" - scopestart - ")\n) ;; end bovine-inner-scope\n")) - ;; Process each nonterminal - (while nterms - (setq nterm (car nterms) - ;; We can't use the override form because the current buffer - ;; is not the originator of the tag. - rules (semantic-tag-components-semantic-grammar-mode nterm) - nterm (semantic-tag-name nterm) - nterms (cdr nterms)) - (when (member nterm '("bovine-toplevel" "bovine-inner-scope")) - (error "`%s' is a reserved internal name" nterm)) - (insert "\n(" nterm) - ;; Process each rule - (while rules - (setq items (semantic-tag-get-attribute (car rules) :value) - prec (semantic-tag-get-attribute (car rules) :prec) - actn (semantic-tag-get-attribute (car rules) :expr) - rules (cdr rules)) - ;; Process each item - (insert "\n(") - (if (null items) - ;; EMPTY rule - (insert ";;EMPTY" (if actn "" "\n")) - ;; Expand items - (while items - (setq item (car items) - items (cdr items)) - (if (consp item) ;; mid-rule action - (message "Mid-rule action %S ignored" item) - (or (char-equal (char-before) ?\() - (insert "\n")) - (cond - ((member item '("bovine-toplevel" "bovine-inner-scope")) - (error "`%s' is a reserved internal name" item)) - ;; Replace ITEM by its %token definition. - ;; If a '%token TYPE ITEM [REGEX]' definition exists - ;; in the grammar, ITEM is replaced by TYPE [REGEX]. - ((setq tag (semantic-find-first-tag-by-name - item tags) - type (semantic-tag-get-attribute tag :type)) - (insert type) - (if (setq regex (semantic-tag-get-attribute tag :value)) - (insert (format "\n%S" regex)))) - ;; Don't change ITEM - (t - (insert (semantic-grammar-item-text item))) - )))) - (if prec - (message "%%prec %S ignored" prec)) - (if actn - (bovine-grammar-expand-action actn quotemode)) - (insert ")")) - (insert "\n) ;; end " nterm "\n")) - (insert ")\n") - (buffer-string)))) - -(defun bovine-grammar-setupcode-builder () - "Return the text of the setup code." - (format - "(setq semantic--parse-table %s\n\ - semantic-debug-parser-source %S\n\ - semantic-debug-parser-class 'semantic-bovine-debug-parser - semantic-flex-keywords-obarray %s\n\ - %s)" - (semantic-grammar-parsetable) - (buffer-name) - (semantic-grammar-keywordtable) - (let ((mode (semantic-grammar-languagemode))) - ;; Is there more than one major mode? - (if (and (listp mode) (> (length mode) 1)) - (format "semantic-equivalent-major-modes '%S\n" mode) - "")))) - -(defvar bovine-grammar-menu - '("BY Grammar" - ) - "BY mode specific grammar menu. -Menu items are appended to the common grammar menu.") - -(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY" - "Major mode for editing Bovine grammars." - (semantic-grammar-setup-menu bovine-grammar-menu) - (semantic-install-function-overrides - '((grammar-parsetable-builder . bovine-grammar-parsetable-builder) - (grammar-setupcode-builder . bovine-grammar-setupcode-builder) - ))) - -(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode)) - -(defvar-mode-local bovine-grammar-mode semantic-grammar-macros - '( - (ASSOC . semantic-grammar-ASSOC) - (EXPAND . bovine-grammar-EXPAND) - (EXPANDFULL . bovine-grammar-EXPANDFULL) - (TAG . bovine-grammar-TAG) - (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG) - (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG) - (TYPE-TAG . bovine-grammar-TYPE-TAG) - (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG) - (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG) - (CODE-TAG . bovine-grammar-CODE-TAG) - (ALIAS-TAG . bovine-grammar-ALIAS-TAG) - ) - "Semantic grammar macros used in bovine grammars.") - -(provide 'semantic/bovine/grammar) - -(defun bovine-make-parsers () - "Generate Emacs' built-in Bovine-based parser files." - (interactive) - (semantic-mode 1) - ;; Loop through each .by file in current directory, and run - ;; `semantic-grammar-batch-build-one-package' to build the grammar. - (dolist (f (directory-files default-directory nil "\\.by\\'")) - (let ((packagename - (condition-case err - (with-current-buffer (find-file-noselect f) - (semantic-grammar-create-package)) - (error (message "%s" (error-message-string err)) nil))) - lang filename) - (when (and packagename - (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) - (setq lang (match-string 1 packagename)) - (setq filename (concat lang "-by.el")) - (with-temp-buffer - (insert-file-contents filename) - (setq buffer-file-name (expand-file-name filename)) - ;; Fix copyright header: - (goto-char (point-min)) - (re-search-forward "^;; Author:") - (setq copyright-end (match-beginning 0)) - (re-search-forward "^;;; Code:\n") - (delete-region copyright-end (match-end 0)) - (goto-char copyright-end) - (insert ";; 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 . - -;;; Commentary: -;; -;; This file was generated from admin/grammars/" - lang ".by. - -;;; Code: -") - (goto-char (point-min)) - (delete-region (point-min) (line-end-position)) - (insert ";;; " packagename - " --- Generated parser support file") - (delete-trailing-whitespace) - (re-search-forward ";;; \\(.*\\) ends here") - (replace-match packagename nil nil nil 1) - (save-buffer)))))) - -;;; bovine-grammar.el ends here diff --git a/admin/grammars/wisent-grammar.el b/admin/grammars/wisent-grammar.el deleted file mode 100644 index 25dba5be2d8..00000000000 --- a/admin/grammars/wisent-grammar.el +++ /dev/null @@ -1,526 +0,0 @@ -;;; wisent-grammar.el --- Wisent's input grammar mode - -;; Copyright (C) 2002-2012 Free Software Foundation, Inc. -;; -;; Author: David Ponce -;; Maintainer: David Ponce -;; Created: 26 Aug 2002 -;; Keywords: syntax -;; 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 . - -;;; Commentary: -;; -;; Major mode for editing Wisent's input grammar (.wy) files. - -;;; Code: -(require 'semantic) -(require 'semantic/grammar) -(require 'semantic/find) -(require 'semantic/lex) -(require 'semantic/wisent) -(require 'semantic/bovine) - -(defsubst wisent-grammar-region-placeholder (symb) - "Given a $N placeholder symbol in SYMB, return a $regionN symbol. -Return nil if $N is not a valid placeholder symbol." - (let ((n (symbol-name symb))) - (if (string-match "^[$]\\([1-9][0-9]*\\)$" n) - (intern (concat "$region" (match-string 1 n)))))) - -(defun wisent-grammar-EXPAND (symb nonterm) - "Expand call to EXPAND grammar macro. -Return the form to parse from within a nonterminal. -SYMB is a $I placeholder symbol that gives the bounds of the area to -parse. -NONTERM is the nonterminal symbol to start with." - (unless (member nonterm (semantic-grammar-start)) - (error "EXPANDFULL macro called with %s, but not used with %%start" - nonterm)) - (let (($ri (wisent-grammar-region-placeholder symb))) - (if $ri - `(semantic-bovinate-from-nonterminal - (car ,$ri) (cdr ,$ri) ',nonterm) - (error "Invalid form (EXPAND %s %s)" symb nonterm)))) - -(defun wisent-grammar-EXPANDFULL (symb nonterm) - "Expand call to EXPANDFULL grammar macro. -Return the form to recursively parse an area. -SYMB is a $I placeholder symbol that gives the bounds of the area. -NONTERM is the nonterminal symbol to start with." - (unless (member nonterm (semantic-grammar-start)) - (error "EXPANDFULL macro called with %s, but not used with %%start" - nonterm)) - (let (($ri (wisent-grammar-region-placeholder symb))) - (if $ri - `(semantic-parse-region - (car ,$ri) (cdr ,$ri) ',nonterm 1) - (error "Invalid form (EXPANDFULL %s %s)" symb nonterm)))) - -(defun wisent-grammar-TAG (name class &rest attributes) - "Expand call to TAG grammar macro. -Return the form to create a generic semantic tag. -See the function `semantic-tag' for the meaning of arguments NAME, -CLASS and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag ,name ,class ,@attributes))) - -(defun wisent-grammar-VARIABLE-TAG (name type default-value &rest attributes) - "Expand call to VARIABLE-TAG grammar macro. -Return the form to create a semantic tag of class variable. -See the function `semantic-tag-new-variable' for the meaning of -arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-variable ,name ,type ,default-value ,@attributes))) - -(defun wisent-grammar-FUNCTION-TAG (name type arg-list &rest attributes) - "Expand call to FUNCTION-TAG grammar macro. -Return the form to create a semantic tag of class function. -See the function `semantic-tag-new-function' for the meaning of -arguments NAME, TYPE, ARG-LIST and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-function ,name ,type ,arg-list ,@attributes))) - -(defun wisent-grammar-TYPE-TAG (name type members parents &rest attributes) - "Expand call to TYPE-TAG grammar macro. -Return the form to create a semantic tag of class type. -See the function `semantic-tag-new-type' for the meaning of arguments -NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-type ,name ,type ,members ,parents ,@attributes))) - -(defun wisent-grammar-INCLUDE-TAG (name system-flag &rest attributes) - "Expand call to INCLUDE-TAG grammar macro. -Return the form to create a semantic tag of class include. -See the function `semantic-tag-new-include' for the meaning of -arguments NAME, SYSTEM-FLAG and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-include ,name ,system-flag ,@attributes))) - -(defun wisent-grammar-PACKAGE-TAG (name detail &rest attributes) - "Expand call to PACKAGE-TAG grammar macro. -Return the form to create a semantic tag of class package. -See the function `semantic-tag-new-package' for the meaning of -arguments NAME, DETAIL and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-package ,name ,detail ,@attributes))) - -(defun wisent-grammar-CODE-TAG (name detail &rest attributes) - "Expand call to CODE-TAG grammar macro. -Return the form to create a semantic tag of class code. -See the function `semantic-tag-new-code' for the meaning of arguments -NAME, DETAIL and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-code ,name ,detail ,@attributes))) - -(defun wisent-grammar-ALIAS-TAG (name aliasclass definition &rest attributes) - "Expand call to ALIAS-TAG grammar macro. -Return the form to create a semantic tag of class alias. -See the function `semantic-tag-new-alias' for the meaning of arguments -NAME, ALIASCLASS, DEFINITION and ATTRIBUTES." - `(wisent-raw-tag - (semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes))) - -(defun wisent-grammar-EXPANDTAG (raw-tag) - "Expand call to EXPANDTAG grammar macro. -Return the form to produce a list of cooked tags from raw form of -Semantic tag RAW-TAG." - `(wisent-cook-tag ,raw-tag)) - -(defun wisent-grammar-AST-ADD (ast &rest nodes) - "Expand call to AST-ADD grammar macro. -Return the form to update the abstract syntax tree AST with NODES. -See also the function `semantic-ast-add'." - `(semantic-ast-add ,ast ,@nodes)) - -(defun wisent-grammar-AST-PUT (ast &rest nodes) - "Expand call to AST-PUT grammar macro. -Return the form to update the abstract syntax tree AST with NODES. -See also the function `semantic-ast-put'." - `(semantic-ast-put ,ast ,@nodes)) - -(defun wisent-grammar-AST-GET (ast node) - "Expand call to AST-GET grammar macro. -Return the form to get, from the abstract syntax tree AST, the value -of NODE. -See also the function `semantic-ast-get'." - `(semantic-ast-get ,ast ,node)) - -(defun wisent-grammar-AST-GET1 (ast node) - "Expand call to AST-GET1 grammar macro. -Return the form to get, from the abstract syntax tree AST, the first -value of NODE. -See also the function `semantic-ast-get1'." - `(semantic-ast-get1 ,ast ,node)) - -(defun wisent-grammar-AST-GET-STRING (ast node) - "Expand call to AST-GET-STRING grammar macro. -Return the form to get, from the abstract syntax tree AST, the value -of NODE as a string. -See also the function `semantic-ast-get-string'." - `(semantic-ast-get-string ,ast ,node)) - -(defun wisent-grammar-AST-MERGE (ast1 ast2) - "Expand call to AST-MERGE grammar macro. -Return the form to merge the abstract syntax trees AST1 and AST2. -See also the function `semantic-ast-merge'." - `(semantic-ast-merge ,ast1 ,ast2)) - -(defun wisent-grammar-SKIP-BLOCK (&optional symb) - "Expand call to SKIP-BLOCK grammar macro. -Return the form to skip a parenthesized block. -Optional argument SYMB is a $I placeholder symbol that gives the -bounds of the block to skip. By default, skip the block at `$1'. -See also the function `wisent-skip-block'." - (let ($ri) - (when symb - (unless (setq $ri (wisent-grammar-region-placeholder symb)) - (error "Invalid form (SKIP-BLOCK %s)" symb))) - `(wisent-skip-block ,$ri))) - -(defun wisent-grammar-SKIP-TOKEN () - "Expand call to SKIP-TOKEN grammar macro. -Return the form to skip the lookahead token. -See also the function `wisent-skip-token'." - `(wisent-skip-token)) - -(defun wisent-grammar-assocs () - "Return associativity and precedence level definitions." - (mapcar - #'(lambda (tag) - (cons (intern (semantic-tag-name tag)) - (mapcar #'semantic-grammar-item-value - (semantic-tag-get-attribute tag :value)))) - (semantic-find-tags-by-class 'assoc (current-buffer)))) - -(defun wisent-grammar-terminals () - "Return the list of terminal symbols. -Keep order of declaration in the WY file without duplicates." - (let (terms) - (mapc - #'(lambda (tag) - (mapcar #'(lambda (name) - (add-to-list 'terms (intern name))) - (cons (semantic-tag-name tag) - (semantic-tag-get-attribute tag :rest)))) - (semantic--find-tags-by-function - #'(lambda (tag) - (memq (semantic-tag-class tag) '(token keyword))) - (current-buffer))) - (nreverse terms))) - -;; Cache of macro definitions currently in use. -(defvar wisent--grammar-macros nil) - -(defun wisent-grammar-expand-macros (expr) - "Expand expression EXPR into a form without grammar macros. -Return the expanded expression." - (if (or (atom expr) (semantic-grammar-quote-p (car expr))) - expr ;; Just return atom or quoted expression. - (let* ((expr (mapcar 'wisent-grammar-expand-macros expr)) - (macro (assq (car expr) wisent--grammar-macros))) - (if macro ;; Expand Semantic built-in. - (apply (cdr macro) (cdr expr)) - expr)))) - -(defun wisent-grammar-nonterminals () - "Return the list form of nonterminal definitions." - (let ((nttags (semantic-find-tags-by-class - 'nonterminal (current-buffer))) - ;; Setup the cache of macro definitions. - (wisent--grammar-macros (semantic-grammar-macros)) - rltags nterms rules rule elems elem actn sexp prec) - (while nttags - (setq rltags (semantic-tag-components (car nttags)) - rules nil) - (while rltags - (setq elems (semantic-tag-get-attribute (car rltags) :value) - prec (semantic-tag-get-attribute (car rltags) :prec) - actn (semantic-tag-get-attribute (car rltags) :expr) - rule nil) - (when elems ;; not an EMPTY rule - (while elems - (setq elem (car elems) - elems (cdr elems)) - (setq elem (if (consp elem) ;; mid-rule action - (wisent-grammar-expand-macros (read (car elem))) - (semantic-grammar-item-value elem)) ;; item - rule (cons elem rule))) - (setq rule (nreverse rule))) - (if prec - (setq prec (vector (semantic-grammar-item-value prec)))) - (if actn - (setq sexp (wisent-grammar-expand-macros (read actn)))) - (setq rule (if actn - (if prec - (list rule prec sexp) - (list rule sexp)) - (if prec - (list rule prec) - (list rule)))) - (setq rules (cons rule rules) - rltags (cdr rltags))) - (setq nterms (cons (cons (intern (semantic-tag-name (car nttags))) - (nreverse rules)) - nterms) - nttags (cdr nttags))) - (nreverse nterms))) - -(defun wisent-grammar-grammar () - "Return Elisp form of the grammar." - (let* ((terminals (wisent-grammar-terminals)) - (nonterminals (wisent-grammar-nonterminals)) - (assocs (wisent-grammar-assocs))) - (cons terminals (cons assocs nonterminals)))) - -(defun wisent-grammar-parsetable-builder () - "Return the value of the parser table." - `(progn - ;; Ensure that the grammar [byte-]compiler is available. - (eval-when-compile (require 'semantic/wisent/comp)) - (wisent-compile-grammar - ',(wisent-grammar-grammar) - ',(semantic-grammar-start)))) - -(defun wisent-grammar-setupcode-builder () - "Return the parser setup code." - (format - "(semantic-install-function-overrides\n\ - '((parse-stream . wisent-parse-stream)))\n\ - (setq semantic-parser-name \"LALR\"\n\ - semantic--parse-table %s\n\ - semantic-debug-parser-source %S\n\ - semantic-flex-keywords-obarray %s\n\ - semantic-lex-types-obarray %s)\n\ - ;; Collect unmatched syntax lexical tokens\n\ - (semantic-make-local-hook 'wisent-discarding-token-functions)\n\ - (add-hook 'wisent-discarding-token-functions\n\ - 'wisent-collect-unmatched-syntax nil t)" - (semantic-grammar-parsetable) - (buffer-name) - (semantic-grammar-keywordtable) - (semantic-grammar-tokentable))) - -(defvar wisent-grammar-menu - '("WY Grammar" - ["LALR Compiler Verbose" wisent-toggle-verbose-flag - :style toggle :active (boundp 'wisent-verbose-flag) - :selected (and (boundp 'wisent-verbose-flag) - wisent-verbose-flag)] - ) - "WY mode specific grammar menu. -Menu items are appended to the common grammar menu.") - -(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY" - "Major mode for editing Wisent grammars." - (semantic-grammar-setup-menu wisent-grammar-menu) - (semantic-install-function-overrides - '((grammar-parsetable-builder . wisent-grammar-parsetable-builder) - (grammar-setupcode-builder . wisent-grammar-setupcode-builder) - ))) - -(add-to-list 'auto-mode-alist '("\\.wy\\'" . wisent-grammar-mode)) - -(defvar-mode-local wisent-grammar-mode semantic-grammar-macros - '( - (ASSOC . semantic-grammar-ASSOC) - (EXPAND . wisent-grammar-EXPAND) - (EXPANDFULL . wisent-grammar-EXPANDFULL) - (TAG . wisent-grammar-TAG) - (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG) - (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG) - (TYPE-TAG . wisent-grammar-TYPE-TAG) - (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG) - (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG) - (EXPANDTAG . wisent-grammar-EXPANDTAG) - (CODE-TAG . wisent-grammar-CODE-TAG) - (ALIAS-TAG . wisent-grammar-ALIAS-TAG) - (AST-ADD . wisent-grammar-AST-ADD) - (AST-PUT . wisent-grammar-AST-PUT) - (AST-GET . wisent-grammar-AST-GET) - (AST-GET1 . wisent-grammar-AST-GET1) - (AST-GET-STRING . wisent-grammar-AST-GET-STRING) - (AST-MERGE . wisent-grammar-AST-MERGE) - (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK) - (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN) - ) - "Semantic grammar macros used in wisent grammars.") - -(defvar wisent-make-parsers--emacs-license - ";; 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 .") - -(defvar wisent-make-parsers--python-license - ";; It is derived in part from the Python grammar, used under the -;; following license: -;; -;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2 -;; -------------------------------------------- -;; 1. This LICENSE AGREEMENT is between the Python Software Foundation -;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing -;; and otherwise using this software (\"Python\") in source or binary -;; form and its associated documentation. -;; -;; 2. Subject to the terms and conditions of this License Agreement, -;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide -;; license to reproduce, analyze, test, perform and/or display -;; publicly, prepare derivative works, distribute, and otherwise use -;; Python alone or in any derivative version, provided, however, that -;; PSF's License Agreement and PSF's notice of copyright, i.e., -;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are -;; retained in Python alone or in any derivative version prepared by -;; Licensee. -;; -;; 3. In the event Licensee prepares a derivative work that is based -;; on or incorporates Python or any part thereof, and wants to make -;; the derivative work available to others as provided herein, then -;; Licensee hereby agrees to include in any such work a brief summary -;; of the changes made to Python. -;; -;; 4. PSF is making Python available to Licensee on an \"AS IS\" -;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR -;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND -;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS -;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT -;; INFRINGE ANY THIRD PARTY RIGHTS. -;; -;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON -;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A -;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR -;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF. -;; -;; 6. This License Agreement will automatically terminate upon a -;; material breach of its terms and conditions. -;; -;; 7. Nothing in this License Agreement shall be deemed to create any -;; relationship of agency, partnership, or joint venture between PSF -;; and Licensee. This License Agreement does not grant permission to -;; use PSF trademarks or trade name in a trademark sense to endorse or -;; promote products or services of Licensee, or any third party. -;; -;; 8. By copying, installing or otherwise using Python, Licensee -;; agrees to be bound by the terms and conditions of this License -;; Agreement.") - -(defvar wisent-make-parsers--ecmascript-license - "\n;; It is derived from the grammar in the ECMAScript Language -;; Specification published at -;; -;; http://www.ecma-international.org/publications/standards/Ecma-262.htm -;; -;; and redistributed under the following license: -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: -;; -;; 1. Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; -;; 2. 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. -;; -;; 3. Neither the name of the authors nor Ecma International may be -;; used to endorse or promote products derived from this software -;; without specific prior written permission. THIS SOFTWARE IS -;; PROVIDED BY THE ECMA INTERNATIONAL \"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 ECMA INTERNATIONAL 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.") - -(defvar wisent-make-parsers--parser-file-name - `(("semantic/grammar-wy.el") - ("srecode/srt-wy.el") - ("semantic/wisent/js-wy.el" - "Copyright (C) 1998-2011 Ecma International." - ,wisent-make-parsers--ecmascript-license) - ("semantic/wisent/javat-wy.el") - ("semantic/wisent/python-wy.el" - "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -\;; 2009, 2010 Python Software Foundation; All Rights Reserved" - ,wisent-make-parsers--python-license))) - -(defun wisent-make-parsers () - "Generate Emacs' built-in Wisent-based parser files." - (interactive) - (semantic-mode 1) - ;; Loop through each .wy file in current directory, and run - ;; `semantic-grammar-batch-build-one-package' to build the grammar. - (dolist (f (directory-files default-directory nil "\\.wy\\'")) - (let ((packagename - (condition-case err - (with-current-buffer (find-file-noselect f) - (semantic-grammar-create-package)) - (error (message "%s" (error-message-string err)) nil))) - output-data) - (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name)) - (let ((additional-copyright (nth 1 output-data)) - (additional-license (nth 2 output-data)) - (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename))) - copyright-end) - ;; Touch up the generated parsers for Emacs integration. - (with-temp-buffer - (insert-file-contents filename) - ;; Fix copyright header: - (goto-char (point-min)) - (when additional-copyright - (re-search-forward "Copyright (C).*$") - (insert "\n;; " additional-copyright)) - (re-search-forward "^;; Author:") - (setq copyright-end (match-beginning 0)) - (re-search-forward "^;;; Code:\n") - (delete-region copyright-end (match-end 0)) - (goto-char copyright-end) - (insert wisent-make-parsers--emacs-license) - (insert "\n\n;;; Commentary: -;; -;; This file was generated from admin/grammars/" - f ".") - (when additional-license - (insert "\n" additional-license)) - (insert "\n\n;;; Code:\n") - (goto-char (point-min)) - (delete-region (point-min) (line-end-position)) - (insert ";;; " packagename - " --- Generated parser support file") - (re-search-forward ";;; \\(.*\\) ends here") - (replace-match packagename nil nil nil 1) - (delete-trailing-whitespace) - (write-region nil nil (expand-file-name filename)))))))) - -;;; wisent-grammar.el ends here -- cgit v1.2.1 From 0db901c17a90b38c81b4b03e0c83c61e814a6c0b Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 6 Oct 2012 22:22:31 +0800 Subject: Update for admin/grammars/README. --- admin/grammars/README | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'admin') diff --git a/admin/grammars/README b/admin/grammars/README index 419797e0dcb..e38260952a5 100644 --- a/admin/grammars/README +++ b/admin/grammars/README @@ -3,8 +3,8 @@ generate the parser data in the lisp/semantic/bovine/ and lisp/semantic/wisent/ directories. You can run the parser generators with -emacs -batch -Q -l bovine-grammar.el -f bovine-make-parsers -emacs -batch -Q -l wisent-grammar.el -f wisent-make-parsers +emacs -batch -Q -l semantic/bovine/grammar -f bovine-make-parsers +emacs -batch -Q -l semantic/wisent/grammar -f wisent-make-parsers Currently, the parser files in lisp/ are not generated directly from these grammar files when making Emacs. This state of affairs, and the -- cgit v1.2.1 From 1a316a53933885ed963f758c6463368cfe472d8f Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 Oct 2012 14:15:03 -0700 Subject: Handle group :version in cusver-check * admin/admin.el (cusver-new-version): New variable. (cusver-scan): Check if containing group has a :version. (cusver-check): Add VERSION argument. --- admin/ChangeLog | 6 ++++++ admin/admin.el | 35 ++++++++++++++++++++++++++--------- 2 files changed, 32 insertions(+), 9 deletions(-) (limited to 'admin') diff --git a/admin/ChangeLog b/admin/ChangeLog index 8fe82ca36cb..82a01887b57 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,9 @@ +2012-10-06 Glenn Morris + + * admin.el (cusver-new-version): New variable. + (cusver-scan): Check if containing group has a :version. + (cusver-check): Add VERSION argument. + 2012-10-01 David Engster * grammars/bovine-grammar.el: diff --git a/admin/admin.el b/admin/admin.el index c71e6539413..60a09a1e2f2 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -442,8 +442,12 @@ If optional OLD is non-nil, also include defvars." )) "{}" "+")) -;; TODO if a defgroup with a version tag, apply to all customs in that -;; group (eg for new files). +; FIXME Calculate default based on running emacs-version. +(defvar cusver-new-version nil + "Version number that new defcustoms should have.") + +;; TODO do something about renamed variables with aliases to the old name? +;; Scan old cus-start.el to find variables moved from C to lisp? (defun cusver-scan (file &optional old) "Scan FILE for `defcustom' calls. Return a list with elements of the form (VAR . VER), @@ -452,8 +456,8 @@ a :version tag having value VER (may be nil). If optional argument OLD is non-nil, also scan for defvars." (let ((m (format "Scanning %s..." file)) (re (format "^[ \t]*\\((def%s\\)[ \t\n]" - (if old "\\(?:custom\\|var\\)" "custom"))) - alist var ver form) + (if old "\\(custom\\|var\\)" "\\(custom\\|group\\)"))) + alist var ver form glist grp) (message "%s" m) (with-temp-buffer (insert-file-contents file) @@ -461,11 +465,23 @@ If optional argument OLD is non-nil, also scan for defvars." (while (re-search-forward re nil t) (goto-char (match-beginning 1)) (if (and (setq form (ignore-errors (read (current-buffer)))) - (setq var (car-safe (cdr-safe form))) + (setq var (car-safe (cdr-safe form))) ;; Exclude macros, eg (defcustom ,varname ...). (symbolp var)) - (setq ver (car (cdr-safe (memq :version form))) - alist (cons (cons var ver) alist)) + (progn + (setq ver (car (cdr-safe (memq :version form)))) + (if (equal "group" (match-string 2)) + ;; Group :version could be old. + (if (equal ver cusver-new-version) + (setq glist (cons (cons var ver) glist))) + ;; If it specifies a group and the whole group has a + ;; version. use that. + (unless ver + (setq grp (car (cdr-safe (memq :group form)))) + (and grp + (setq grp (car (cdr-safe grp))) ; (quote foo) -> foo + (setq ver (assq grp glist)))) + (setq alist (cons (cons var ver) alist)))) (if form (message "Malformed defcustom: `%s'" form))))) (message "%sdone" m) alist)) @@ -490,7 +506,7 @@ If optional argument OLD is non-nil, also scan for defvars." ;; TODO handle renamed things with aliases to the old names. ;; What to do about new files? Does everything in there need a :version, ;; or eg just the defgroup? -(defun cusver-check (newdir olddir) +(defun cusver-check (newdir olddir version) "Check that defcustoms have :version tags where needed. NEWDIR is the current lisp/ directory, OLDDIR is that from the previous release. A defcustom that is only in NEWDIR should have a :version @@ -499,11 +515,12 @@ just converting a defvar to a defcustom does not require a :version bump. Note that a :version tag should also be added if the value of a defcustom changes (in a non-trivial way). This function does not check for that." - (interactive "DNew Lisp directory: \nDOld Lisp directory: ") + (interactive "DNew Lisp directory: \nDOld Lisp directory: \nsNew version number: ") (or (file-directory-p (setq newdir (expand-file-name newdir))) (error "Directory `%s' not found" newdir)) (or (file-directory-p (setq olddir (expand-file-name olddir))) (error "Directory `%s' not found" olddir)) + (setq cusver-new-version version) (let* ((newfiles (progn (message "Finding new files with defcustoms...") (cusver-find-files newdir))) (oldfiles (progn (message "Finding old files with defcustoms...") -- cgit v1.2.1 From 5407f8d23491f3e7886865facc0ae6446142ba48 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 Oct 2012 17:54:36 -0700 Subject: Improve cusver-check's handling of the version number * admin/admin.el (cusver-new-version): Set default. (cusver-check): Improve interactive argument reading. --- admin/ChangeLog | 5 +++++ admin/admin.el | 10 +++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) (limited to 'admin') diff --git a/admin/ChangeLog b/admin/ChangeLog index 82a01887b57..7d4921887ce 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2012-10-07 Glenn Morris + + * admin.el (cusver-new-version): Set default. + (cusver-check): Improve interactive argument reading. + 2012-10-06 Glenn Morris * admin.el (cusver-new-version): New variable. diff --git a/admin/admin.el b/admin/admin.el index 60a09a1e2f2..3e3fbba7202 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -442,8 +442,8 @@ If optional OLD is non-nil, also include defvars." )) "{}" "+")) -; FIXME Calculate default based on running emacs-version. -(defvar cusver-new-version nil +(defvar cusver-new-version (format "%s.%s" emacs-major-version + (1+ emacs-minor-version)) "Version number that new defcustoms should have.") ;; TODO do something about renamed variables with aliases to the old name? @@ -515,7 +515,11 @@ just converting a defvar to a defcustom does not require a :version bump. Note that a :version tag should also be added if the value of a defcustom changes (in a non-trivial way). This function does not check for that." - (interactive "DNew Lisp directory: \nDOld Lisp directory: \nsNew version number: ") + (interactive (list (read-directory-name "New Lisp directory: ") + (read-directory-name "Old Lisp directory: ") + (number-to-string + (read-number "New version number: " + (string-to-number cusver-new-version))))) (or (file-directory-p (setq newdir (expand-file-name newdir))) (error "Directory `%s' not found" newdir)) (or (file-directory-p (setq olddir (expand-file-name olddir))) -- cgit v1.2.1