diff options
73 files changed, 1387 insertions, 1077 deletions
diff --git a/ChangeLog b/ChangeLog index 97c307f3817..ce2014288e6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2013-05-16 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib, incorporating: + 2013-05-15 manywarnings: update for GCC 4.8.0 + 2013-05-15 stdio: use __REDIRECT for fwrite, fwrite_unlocked + 2013-05-15 sig2str, stdio, warnings: port to clang + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in (install-doc): DOC file is not version specific any more. + * .bzrignore: Don't ignore DOC-* any more. + 2013-05-13 Paul Eggert <eggert@cs.ucla.edu> * configure.ac (LD_SWITCH_SYSTEM_TEMACS): OpenBSD needs -nopie. diff --git a/Makefile.in b/Makefile.in index 13b452d30d1..583aa99f83d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -608,10 +608,6 @@ install-arch-indep: lisp leim install-info install-man ${INSTALL_ARCH_INDEP_EXTR ## guaranteed to do the right thing; eg if we are root and tar is ## preserving source permissions. -## We install only the relevant DOC file if possible -## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*. -## (Note "otherwise" is inaccurate since 2009-08-23.) - ## Note that install-arch-indep deletes and recreates the entire ## installed etc/ directory, so we need it to run before this does. install-doc: src install-arch-indep @@ -619,13 +615,7 @@ install-doc: src install-arch-indep umask 022; ${MKDIR_P} $(DESTDIR)${docdir} ; \ if [ `cd ./etc; /bin/pwd` != `cd $(DESTDIR)${docdir}; /bin/pwd` ]; \ then \ - fullversion=`./src/emacs --version | sed -n '1 s/GNU Emacs *//p'`; \ - if [ -f "./etc/DOC-$${fullversion}" ]; \ - then \ - docfile="DOC-$${fullversion}"; \ - else \ - docfile="DOC"; \ - fi; \ + docfile="DOC"; \ echo "Copying etc/$${docfile} to $(DESTDIR)${docdir} ..." ; \ ${INSTALL_DATA} etc/$${docfile} $(DESTDIR)${docdir}/$${docfile}; \ $(set_installuser); \ diff --git a/admin/ChangeLog b/admin/ChangeLog index 5ae948ad192..221d5c0586c 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,13 @@ +2013-05-16 Glenn Morris <rgm@gnu.org> + + * cus-test.el (cus-test-cus-load-groups): New function. + (cus-test-get-options): Add option to return groups. + (cus-test-noloads): Also check custom groups. + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * quick-install-emacs: Don't prune DOC-* files a any more. + 2013-05-14 Glenn Morris <rgm@gnu.org> * cus-test.el (cus-test-get-lisp-files): Ignore obsolete/. diff --git a/admin/cus-test.el b/admin/cus-test.el index e68ee7744e7..6b8ec9abe02 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -232,17 +232,38 @@ The detected problematic options are stored in `cus-test-errors'." (length cus-test-tested-variables)) (cus-test-errors-display)) -(defun cus-test-get-options (regexp) - "Return a list of custom options matching REGEXP." - (let (found) +(defun cus-test-cus-load-groups (&optional cus-load) + "Return a list of current custom groups. +If CUS-LOAD is non-nil, include groups from cus-load.el." + (append (mapcar 'cdr custom-current-group-alist) + (if cus-load + (with-temp-buffer + (insert-file-contents (locate-library "cus-load.el")) + (search-forward "(put '") + (beginning-of-line) + (let (res) + (while (and (looking-at "^(put '\\(\\S-+\\)") + (zerop (forward-line 1))) + (push (intern (match-string 1)) res)) + res))))) + +(defun cus-test-get-options (regexp &optional group) + "Return a list of custom options matching REGEXP. +If GROUP is non-nil, return groups rather than options. +If GROUP is `cus-load', include groups listed in cus-loads as well as +currently defined groups." + (let ((groups (if group (cus-test-cus-load-groups (eq group 'cus-load)))) + found) (mapatoms (lambda (symbol) (and - (or - ;; (user-variable-p symbol) - (get symbol 'standard-value) - ;; (get symbol 'saved-value) - (get symbol 'custom-type)) + (if group + (memq symbol groups) + (or + ;; (user-variable-p symbol) + (get symbol 'standard-value) + ;; (get symbol 'saved-value) + (get symbol 'custom-type))) (string-match regexp (symbol-name symbol)) (not (member symbol cus-test-skip-list)) (push symbol found)))) @@ -492,17 +513,17 @@ It is suitable for batch mode. E.g., invoke in the Emacs source directory." (interactive) - (let (cus-loaded) + (let ((groups-loaded (cus-test-get-options "" 'cus-load)) + cus-loaded groups-not-loaded) (message "Running %s" 'cus-test-load-custom-loads) (cus-test-load-custom-loads) - (setq cus-loaded - (cus-test-get-options "")) + (setq cus-loaded (cus-test-get-options "")) (message "Running %s" 'cus-test-load-libs) (cus-test-load-libs "all") - (setq cus-test-vars-not-cus-loaded - (cus-test-get-options "")) + (setq cus-test-vars-not-cus-loaded (cus-test-get-options "") + groups-not-loaded (cus-test-get-options "" t)) (dolist (o cus-loaded) (setq cus-test-vars-not-cus-loaded @@ -512,7 +533,15 @@ in the Emacs source directory." (message "No options not loaded by custom-load-symbol found") (message "The following options were not loaded by custom-load-symbol:") (cus-test-message - (sort cus-test-vars-not-cus-loaded 'string<))))) + (sort cus-test-vars-not-cus-loaded 'string<))) + + (dolist (o groups-loaded) + (setq groups-not-loaded (delete o groups-not-loaded))) + + (if (not groups-not-loaded) + (message "No groups not in cus-load.el found") + (message "The following groups are not in cus-load.el:") + (cus-test-message (sort groups-not-loaded 'string<))))) (provide 'cus-test) diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index e74a2a5af49..98bd61f839d 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -105,8 +105,8 @@ and build directories reside. Optionally, $me can also remove old versions of automatically generated files that are version-specific (such as the -versioned emacs executables in the \`src' directory, and the DOC-* files -in the \`etc' directory). The latter action is called \`pruning,' and +versioned emacs executables in the \`src' directory). +The latter action is called \`pruning,' and can be enabled using the \`-p' or \`--prune' options. EOF exit 0 @@ -209,10 +209,6 @@ maybe_mkdir "$DST_INFO" PRUNED="" if test x"$PRUNE" != xno; then - for D in `ls -1t $BUILD/etc/DOC-* | sed 1d`; do - echo $REMOVE_CMD $D - PRUNED="$PRUNED $D" - done for D in `ls -1t $BUILD/src/emacs-$VERSION.* | sed 1d`; do echo $REMOVE_CMD $D PRUNED="$PRUNED $D" diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 1d72ba18860..14e9be8ba84 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2013-05-15 Juri Linkov <juri@jurta.org> + + * search.texi (Repeat Isearch): Mention key `RET' to finish + editing the string. (Bug#13348) + 2013-05-14 Glenn Morris <rgm@gnu.org> * ack.texi (Acknowledgments): Don't mention obsolete sup-mouse.el. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 377264223a5..e146177255e 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -175,7 +175,7 @@ element in the minibuffer, where you can edit it. @kindex M-e @r{(Incremental search)} To edit the current search string in the minibuffer without -replacing it with items from the search ring, type @kbd{M-e}. Type +replacing it with items from the search ring, type @kbd{M-e}. Type @key{RET}, @kbd{C-s} or @kbd{C-r} to finish editing the string and search for it. @node Error in Isearch diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 1a6fd5eca0d..249a2f21ccb 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,9 @@ +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * loading.texi (Autoload): + * help.texi (Documentation Basics, Accessing Documentation) + (Accessing Documentation, Accessing Documentation): DOC-* is now DOC. + 2013-04-23 Glenn Morris <rgm@gnu.org> * internals.texi (Writing Emacs Primitives): Remove obvious example. @@ -24,8 +30,8 @@ 2013-04-06 Chong Yidong <cyd@gnu.org> * display.texi (Faces): Minor clarifications. - (Defining Faces): Clarify default vs custom face specs. Document - face-spec-set. + (Defining Faces): Clarify default vs custom face specs. + Document face-spec-set. * display.texi (Overlay Properties): * text.texi (Special Properties): Use the "anonymous face" @@ -2050,8 +2056,8 @@ 2012-02-04 Chong Yidong <cyd@gnu.org> - * functions.texi (What Is a Function): Add closures. Mention - "return value" terminology. Add xref for command-execute. + * functions.texi (What Is a Function): Add closures. + Mention "return value" terminology. Add xref for command-execute. Remove unused "keystroke command" terminology. (Lambda Expressions): Give a different example than in the following subsection. Add xref to Anonymous Functions. @@ -11598,7 +11604,7 @@ 2002-05-13 Kim F. Storm <storm@cua.dk> - * variables.texi (Intro to Buffer-Local): Updated warning and + * variables.texi (Intro to Buffer-Local): Update warning and example relating to changing buffer inside let. 2002-03-10 Jan Djärv <jan.h.d@swipnet.se> diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 9fe069b84d0..aa77ba1f36d 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -93,13 +93,12 @@ When you define a variable with a @code{defvar} or related form (@pxref{Defining Variables}), the documentation is stored in the variable's @code{variable-documentation} property. -@cindex @file{DOC-@var{version}} (documentation) file +@cindex @file{DOC} (documentation) file @item To save memory, the documentation for preloaded functions and variables (including primitive functions and autoloaded functions) is not kept in memory, but in the file -@file{emacs/etc/DOC-@var{version}}, where @var{version} is the Emacs -version number (@pxref{Version Info}). +@file{emacs/etc/DOC}). @item When a function or variable is loaded from a byte-compiled file during @@ -126,7 +125,7 @@ customization groups (but for function documentation, use the @code{documentation} command, below). If the value recorded in the property list refers to a documentation -string stored in a @file{DOC-@var{version}} file or a byte-compiled +string stored in a @file{DOC} file or a byte-compiled file, it looks up that string and returns it. If the property value isn't @code{nil}, isn't a string, and doesn't refer to text in a file, then it is evaluated as a Lisp expression to obtain a string. @@ -296,12 +295,12 @@ memory in the function definitions and variable property lists. Emacs reads the file @var{filename} from the @file{emacs/etc} directory. When the dumped Emacs is later executed, the same file will be looked for in the directory @code{doc-directory}. Usually @var{filename} is -@code{"DOC-@var{version}"}. +@code{"DOC"}. @end defun @defvar doc-directory This variable holds the name of the directory which should contain the -file @code{"DOC-@var{version}"} that contains documentation strings for +file @code{"DOC"} that contains documentation strings for built-in and preloaded functions and variables. In most cases, this is the same as @code{data-directory}. They may be diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 51a060bc6c6..5c92307f7d5 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -483,7 +483,7 @@ For example, @noindent In this case, @code{"prolog"} is the name of the file to load, 169681 refers to the documentation string in the -@file{emacs/etc/DOC-@var{version}} file (@pxref{Documentation Basics}), +@file{emacs/etc/DOC} file (@pxref{Documentation Basics}), @code{t} means the function is interactive, and @code{nil} that it is not a macro or a keymap. @end defun diff --git a/etc/.gitignore b/etc/.gitignore index 618d09438f8..8e12acbee0c 100644 --- a/etc/.gitignore +++ b/etc/.gitignore @@ -1,3 +1,2 @@ DOC -DOC-* icons/ diff --git a/etc/ChangeLog b/etc/ChangeLog index 46564aeebcd..f4f17ac29cf 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * .gitignore: Don't ignore DOC-* any more. + 2013-05-07 Paul Eggert <eggert@cs.ucla.edu> Use Gnulib ACL implementation, for benefit of Solaris etc. (Bug#14295) @@ -282,6 +282,12 @@ when possible. *** Handlers for `file-acl' and `set-file-acl' for remote machines which support POSIX ACLs. +** VHDL mode + +*** New options: `vhdl-actual-generic-name', `vhdl-beautify-options'. + +*** New commands: `vhdl-fix-statement-region', `vhdl-fix-statement-buffer'. + ** Woman *** The commands `woman-default-faces' and `woman-monochrome-faces' @@ -327,6 +333,9 @@ It is layered as: * Incompatible Lisp Changes in Emacs 24.4 +** Default process filers and sentinels are not nil any more. +Instead they default to a function which does what the nil value used to do. + ** `read-event' does not return decoded chars in ttys any more. Just as was the case in Emacs-22 and before, decoding of tty input according to keyboard-coding-system is not performed in read-event any more. But contrary diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 0cfc0ad0c14..7556c23daee 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -551,7 +551,7 @@ with CEDET 1.0pre4) or later. *** Self-documentation messages are garbled. -This means that the file `etc/DOC-...' doesn't properly correspond +This means that the file `etc/DOC' doesn't properly correspond with the Emacs executable. Redumping Emacs and then installing the corresponding pair of files should fix the problem. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index bd7618e0a82..63108cae9a9 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,7 @@ +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * makefile.w32-in ($(DOC)): Use DOC rather than DOC-X. + 2013-05-06 Paul Eggert <eggert@cs.ucla.edu> * make-docfile.c (search_lisp_doc_at_eol) [DEBUG]: Fix typo, diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 5ec559ff985..9656a3badec 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -292,10 +292,10 @@ $(DOC): stamp_BLD $(BLD)/make-docfile.exe ../src/$(BLD)/temacs.exe $(lisp1) $(l "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(lisp1) "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(lisp2) "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(OTHER_PLATFORM_SUPPORT) - $(CP) $(DOC) ../etc/DOC-X + $(CP) $(DOC) ../etc/DOC - mkdir "../src/$(OBJDIR)" - mkdir "../src/$(OBJDIR)/etc" - $(CP) $(DOC) ../src/$(OBJDIR)/etc/DOC-X + $(CP) $(DOC) ../src/$(OBJDIR)/etc/DOC {$(BLD)}.$(O){$(BLD)}.exe: $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $*.$(O) $(LIBS) diff --git a/lib/sig2str.c b/lib/sig2str.c index 8b36e2facf0..6ead2a71d13 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -325,21 +325,25 @@ sig2str (int signum, char *signame) { int rtmin = SIGRTMIN; int rtmax = SIGRTMAX; + int base, delta; if (! (rtmin <= signum && signum <= rtmax)) return -1; if (signum <= rtmin + (rtmax - rtmin) / 2) { - int delta = signum - rtmin; - sprintf (signame, delta ? "RTMIN+%d" : "RTMIN", delta); + strcpy (signame, "RTMIN"); + base = rtmin; } else { - int delta = rtmax - signum; - sprintf (signame, delta ? "RTMAX-%d" : "RTMAX", delta); + strcpy (signame, "RTMAX"); + base = rtmax; } + delta = signum - base; + if (delta != 0) + sprintf (signame + 5, "%+d", delta); return 0; } } diff --git a/lib/stdio.in.h b/lib/stdio.in.h index d6af99ca77d..06cbad00d3d 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -579,13 +579,23 @@ _GL_CXXALIAS_SYS (fwrite, size_t, <http://sources.redhat.com/bugzilla/show_bug.cgi?id=11959>, which sometimes causes an unwanted diagnostic for fwrite calls. This affects only function declaration attributes under certain - versions of gcc, and is not needed for C++. */ + versions of gcc and clang, and is not needed for C++. */ # if (0 < __USE_FORTIFY_LEVEL \ && __GLIBC__ == 2 && 4 <= __GLIBC_MINOR__ && __GLIBC_MINOR__ <= 15 \ && 3 < __GNUC__ + (4 <= __GNUC_MINOR__) \ && !defined __cplusplus) # undef fwrite -# define fwrite(a, b, c, d) ({size_t __r = fwrite (a, b, c, d); __r; }) +# undef fwrite_unlocked +extern size_t __REDIRECT (rpl_fwrite, + (const void *__restrict, size_t, size_t, + FILE *__restrict), + fwrite); +extern size_t __REDIRECT (rpl_fwrite_unlocked, + (const void *__restrict, size_t, size_t, + FILE *__restrict), + fwrite_unlocked); +# define fwrite rpl_fwrite +# define fwrite_unlocked rpl_fwrite_unlocked # endif # endif _GL_CXXALIASWARN (fwrite); diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ffcd36f4af1..e6f56664a52 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,142 @@ +2013-05-16 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-indent-defun): Mark obsolete. + (octave-mode-menu, octave-mode-map): Remove its uses. + +2013-05-16 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.34.2. + * progmodes/vhdl-mode.el: Use `push' throughout. + (vhdl-version, vhdl-time-stamp, vhdl-doc-release-notes): Update. + (vhdl-compiler-alist): Replace "\t\n" by "\\t\\n". + Add IBM & Quartus compiler. Enhance entry for ADVance MS compiler. + (vhdl-actual-generic-name): New option to derive actual generic name. + (vhdl-port-paste-signals): Replace formal by actual generics. + (vhdl-beautify): New name for old group vhdl-align. Update users. + (vhdl-beautify-options): New option. + (vhdl-last-input-event): New compat alias. Use throughout. + (vhdl-goto-line): Replace user level function `goto-line'. + (vhdl-mode-map): Add bindings for vhdl-fix-statement-region, + vhdl-fix-statement-buffer. + (vhdl-create-mode-menu): Add some entries. + (vhdl-align-region-groups): Respect vhdl-beautify-options. + (vhdl-align-inline-comment-region-1): Handle "--" inside string. + (vhdl-fixup-whitespace-region): Handle symbols at EOL. + (vhdl-fix-statement-region, vhdl-fix-statement-buffer): New commands, + to force statements on one line. + (vhdl-remove-trailing-spaces-region): + New, split from vhdl-remove-trailing-spaces. + (vhdl-beautify-region): Fix statements, trailing spaces, ^M character. + Respect vhdl-beautify-options. + (vhdl-update-sensitivity-list-buffer): If non-interactive save buffer. + (vhdl-update-sensitivity-list): Not add with index if exists without. + Not include array index with signal. Ignore keywords in comments. + (vhdl-get-visible-signals): Regexp tweaks. + (vhdl-template-component-inst): Handle empty library. + (vhdl-template-type): Add template for 'enum' type. + (vhdl-port-paste-generic-map, vhdl-port-paste-constants): + Use vhdl-replace-string. + (vhdl-port-paste-signals): Use vhdl-prepare-search-1. + (vhdl-speedbar-mode-map): Rename from vhdl-speedbar-key-map. + (vhdl-speedbar-initialize): Update for above name change. + (vhdl-compose-wire-components): Fix in handling of constants. + (vhdl-error-regexp-emacs-alist): New variable. + (vhdl-error-regexp-add-emacs): New function; + adds support for new compile.el (Emacs 22+) + (vhdl-generate-makefile-1): Change target order for single lib. units. + Allow use of absolute file names. + +2013-05-16 Leo Liu <sdl.web@gmail.com> + + * simple.el (prog-indent-sexp): Indent enclosing defun. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * cus-start.el (show-trailing-whitespace): Move to editing basics. + * faces.el (trailing-whitespace): Don't use whitespace-faces group. + * obsolete/old-whitespace.el (whitespace-faces): Remove group. + (whitespace-highlight): Move to whitespace group. + + * comint.el (comint-source): + * pcmpl-linux.el (pcmpl-linux): + * shell.el (shell-faces): + * eshell/esh-opt.el (eshell-opt): + * international/ccl.el (ccl): Remove empty custom groups. + + * completion.el (dynamic-completion-mode): + * jit-lock.el (jit-lock-debug-mode): + * minibuffer.el (completion-in-region-mode): + * type-break.el (type-break-mode-line-message-mode) + (type-break-query-mode): + * emulation/tpu-edt.el (tpu-edt-mode): + * progmodes/subword.el (global-subword-mode, global-superword-mode): + * progmodes/vhdl-mode.el (vhdl-electric-mode, vhdl-stutter-mode): + * term/vt100.el (vt100-wide-mode): Specify explicit :group. + + * term/xterm.el (xterm): Change parent group to terminals. + + * master.el (master): Remove empty custom group. + (master-mode): Remove unused :group argument. + * textmodes/refill.el (refill): Remove empty custom group. + (refill-mode): Remove unused :group argument. + + * textmodes/rst.el (rst-compile-toolsets): Use rst-compile group. + + * cus-dep.el: Provide a feature. + (custom-make-dependencies): Ignore dotfiles (dir-locals). + Don't mistakenly ignore files whose basenames match a basename + from preloaded-file-list (eg cedet/ede/simple.el). + Add a fallback method for getting :group. + +2013-05-15 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-char-by-name): Rename from + `isearch-insert-char-by-name'. Doc fix. + (isearch-forward): Mention `isearch-char-by-name' in + the docstring. (Bug#13348) + + * isearch.el (minibuffer-local-isearch-map): Bind "\r" to + `exit-minibuffer' instead of + `isearch-nonincremental-exit-minibuffer'. + (isearch-edit-string): Remove mention of + `isearch-nonincremental-exit-minibuffer' from docstring. + (isearch-nonincremental-exit-minibuffer): Mark as obsolete. + (isearch-forward-exit-minibuffer) + (isearch-reverse-exit-minibuffer): Add docstring. (Bug#13348) + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * loadup.el: Just use unversioned DOC. + + * nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other + literals as extending to EOB. + (nxml-last-fontify-end): Remove unused variable. + (nxml-after-change1): Use with-silent-modifications. + (nxml-extend-after-change-region): Simplify. + (nxml-extend-after-change-region1): Remove function. + (nxml-after-change1): Don't adjust for dependent regions. + (nxml-fontify-matcher): Simplify. + * nxml/xmltok.el (xmltok-dependent-regions): Remove variable. + (xmltok-add-dependent): Remove function. + (xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open) + (xmltok-scan-after-comment-open, xmltok-scan-prolog-literal) + (xmltok-scan-prolog-after-processing-instruction-open): Treat + unclosed <[[, <?, comment, and other literals as extending to EOB. + * nxml/rng-valid.el (rng-mark-xmltok-dependent-regions) + (rng-mark-xmltok-dependent-region, rng-dependent-region-changed): + Remove functions. + (rng-do-some-validation-1): Don't mark dependent regions. + * nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions) + (nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region) + (nxml-clear-dependent-regions): Remove functions. + (nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward) + (nxml-ensure-scan-up-to-date): + Don't clear&mark dependent regions. + 2013-05-15 Leo Liu <sdl.web@gmail.com> - * progmodes/octave.el (octave-goto-function-definition): Improve - and fix callers. + * progmodes/octave.el (octave-goto-function-definition): + Improve and fix callers. 2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> @@ -277,7 +412,8 @@ their declaration. (vhdl-mode-syntax-table-init): Remove. - * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on last change. + * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on + last change. * progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol syntax for "_". @@ -292,7 +428,8 @@ Handle a _ with symbol syntax. (autoconf-mode): Don't change the syntax-table for imenu and font-lock. - * progmodes/ada-mode.el (ada-mode-abbrev-table): Consolidate declaration. + * progmodes/ada-mode.el (ada-mode-abbrev-table): + Consolidate declaration. (ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in the declaration. (ada-create-syntax-table): Remove. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 6d62e92bb76..0474559fe9e 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,9 @@ +2013-05-15 Glenn Morris <rgm@gnu.org> + + * semantic/symref/list.el (semantic-symref-auto-expand-results) + (semantic-symref-results-mode-hook) + (semantic-symref-results-summary-function): Fix :group. + 2013-05-14 Glenn Morris <rgm@gnu.org> * ede/simple.el, semantic/java.el: Set generated-autoload-load-name. diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 2391e59e1f4..c1f0a092afc 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -178,12 +178,12 @@ Display the references in`semantic-symref-results-mode'." (defcustom semantic-symref-auto-expand-results nil "Non-nil to expand symref results on buffer creation." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type 'boolean) (defcustom semantic-symref-results-mode-hook nil "Hook run when `semantic-symref-results-mode' starts." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type 'hook) (defvar semantic-symref-current-results nil @@ -217,7 +217,7 @@ RESULTS is an object of class `semantic-symref-results'." (defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype "*Function to use when creating items in Imenu. Some useful functions are found in `semantic-format-tag-functions'." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type semantic-format-tag-custom-list) (defun semantic-symref-results-dump (results) diff --git a/lisp/comint.el b/lisp/comint.el index c796f4fda31..956e8f86ccb 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -148,10 +148,11 @@ "Completion facilities in comint." :group 'comint) -(defgroup comint-source nil - "Source finding facilities in comint." - :prefix "comint-" - :group 'comint) +;; Unused. +;;; (defgroup comint-source nil +;;; "Source finding facilities in comint." +;;; :prefix "comint-" +;;; :group 'comint) (defvar comint-prompt-regexp "^" "Regexp to recognize prompts in the inferior process. diff --git a/lisp/completion.el b/lisp/completion.el index 974d59c9af5..3fbc3c05fb4 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -2342,6 +2342,7 @@ With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :global t + :group 'completion ;; This is always good, not specific to dynamic-completion-mode. (define-key function-key-map [C-return] [?\C-\r]) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 12a3211a0b0..4c8a9773c3a 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -61,16 +61,14 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" ;; the args as directories after we are done. (while (setq subdir (pop command-line-args-left)) (message "Directory %s" subdir) - (let ((files (directory-files subdir nil "\\`[^=].*\\.el\\'")) + (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) (default-directory (expand-file-name subdir)) - (preloaded (concat "\\`" - (regexp-opt (mapcar - 'file-name-base - preloaded-file-list) t) + (preloaded (concat "\\`\\(\\./+\\)?" + (regexp-opt preloaded-file-list t) "\\.el\\'"))) (dolist (file files) (unless (or (string-match custom-dependencies-no-scan-regexp file) - (string-match preloaded file) + (string-match preloaded (format "%s/%s" subdir file)) (not (file-exists-p file))) (erase-buffer) (kill-all-local-variables) @@ -91,13 +89,30 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (while (re-search-forward "^(def\\(custom\\|face\\|group\\)" nil t) (beginning-of-line) - (let ((expr (read (current-buffer)))) + (let ((type (match-string 1)) + (expr (read (current-buffer)))) (condition-case nil (let ((custom-dont-initialize t)) - ;; Why do we need to eval just for the name? - (eval expr) - (put (nth 1 expr) 'custom-where name)) - (error nil)))) + ;; Eval to get the 'custom-group, -tag, + ;; -version, group-documentation etc properties. + (put (nth 1 expr) 'custom-where name) + (eval expr)) + ;; Eval failed for some reason. Eg maybe the + ;; defcustom uses something defined earlier + ;; in the file (we haven't loaded the file). + ;; In most cases, we can still get the :group. + (error + (ignore-errors + (let ((group (cadr (memq :group expr)))) + (and group + (eq (car group) 'quote) + (custom-add-to-group + (cadr group) + (nth 1 expr) + (intern (format "custom-%s" + (if (equal type "custom") + "variable" + type))))))))))) (error nil))))))))) (message "Generating %s..." generated-custom-dependencies-file) (set-buffer (find-file-noselect generated-custom-dependencies-file)) @@ -187,5 +202,6 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (message "Generating %s...done" generated-custom-dependencies-file)) +(provide 'cus-dep) ;;; cus-dep.el ends here diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 43d71ceec95..cf94b6300dd 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -449,7 +449,8 @@ since it could result in memory overflow and make Emacs crash." (other :tag "Always (t)" :value t)) "24.3") ;; xdisp.c - (show-trailing-whitespace whitespace-faces boolean nil + ;; The whitespace group is for whitespace.el. + (show-trailing-whitespace editing-basics boolean nil :safe booleanp) (scroll-step windows integer) (scroll-conservatively windows integer) diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 6ec6ad810a4..1ec0ecc943c 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -983,7 +983,7 @@ and the total number of lines in the buffer." With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." - :global t + :global t :group 'tpu (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off))) (defalias 'TPU-EDT-MODE 'tpu-edt-mode) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index f2c1dbe2367..f4293c8f083 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,11 @@ +2013-05-15 Glenn Morris <rgm@gnu.org> + + * erc-list.el (erc-list): + * erc-menu.el (erc-menu): + * erc-ring.el (erc-ring): Define custom groups, for define-erc-module. + + * erc-list.el: Provide a feature. + 2013-05-09 Glenn Morris <rgm@gnu.org> * erc-desktop-notifications.el (erc-notifications-icon): diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 3d78c1b7b9f..f11dd98ca37 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -30,6 +30,10 @@ (require 'erc) +(defgroup erc-list nil + "Support for the /list command." + :group 'erc) + ;; This is implicitly the width of the channel name column. Pick ;; something small enough that the topic has a chance of being ;; readable, but long enough that most channel names won't make for @@ -214,6 +218,8 @@ to RFC and send the LIST header (#321) at start of list transmission." "")))) (put 'erc-cmd-LIST 'do-not-parse-args t) +(provide 'erc-list) + ;;; erc-list.el ends here ;; ;; Local Variables: diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 70c9ae65427..ab11df92063 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -30,6 +30,10 @@ (require 'erc) (require 'easymenu) +(defgroup erc-menu nil + "ERC menu support." + :group 'erc) + (defvar erc-menu-definition (list "ERC" ["Connect to server..." erc t] diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index ac5aaf23bc3..b4244eaa4a6 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -38,6 +38,10 @@ (require 'comint) (require 'ring) +(defgroup erc-ring nil + "An input ring for ERC." + :group 'erc) + ;;;###autoload (autoload 'erc-ring-mode "erc-ring" nil t) (define-erc-module ring nil "Stores input in a ring so that previous commands and messages can diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 6044759f8df..6a37f97bf20 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -27,11 +27,12 @@ (eval-when-compile (require 'esh-ext)) -(defgroup eshell-opt nil - "The options processing code handles command argument parsing for -Eshell commands implemented in Lisp." - :tag "Command options processing" - :group 'eshell) +;; Unused. +;;; (defgroup eshell-opt nil +;;; "The options processing code handles command argument parsing for +;;; Eshell commands implemented in Lisp." +;;; :tag "Command options processing" +;;; :group 'eshell) ;;; User Functions: diff --git a/lisp/faces.el b/lisp/faces.el index 6b4441e2814..d570140e7e6 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2292,7 +2292,6 @@ terminal type to a different value." (t :inverse-video t)) "Basic face for highlighting trailing whitespace." :version "21.1" - :group 'whitespace-faces ; like `show-trailing-whitespace' :group 'basic-faces) (defface escape-glyph diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index fba0cd8fea7..1c76a179afd 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2013-05-15 Glenn Morris <rgm@gnu.org> + + * shr-color.el (shr-color-visible-luminance-min) + (shr-color-visible-distance-min): Use shr-color group. + 2013-05-11 Glenn Morris <rgm@gnu.org> * gnus-vm.el: Make it loadable without VM. diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el index 0b320a21ad9..21f1fc4f004 100644 --- a/lisp/gnus/shr-color.el +++ b/lisp/gnus/shr-color.el @@ -36,14 +36,14 @@ (defcustom shr-color-visible-luminance-min 40 "Minimum luminance distance between two colors to be considered visible. Must be between 0 and 100." - :group 'shr + :group 'shr-color :type 'number) (defcustom shr-color-visible-distance-min 5 "Minimum color distance between two colors to be considered visible. This value is used to compare result for `ciede2000'. It's an absolute value without any unit." - :group 'shr + :group 'shr-color :type 'integer) (defconst shr-color-html-colors-alist diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 39f2b79587b..7b79a1dd1f9 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -43,10 +43,11 @@ ;;; Code: -(defgroup ccl nil - "CCL (Code Conversion Language) compiler." - :prefix "ccl-" - :group 'i18n) +;; Unused. +;;; (defgroup ccl nil +;;; "CCL (Code Conversion Language) compiler." +;;; :prefix "ccl-" +;;; :group 'i18n) (defconst ccl-command-table [if branch loop break repeat write-repeat write-read-repeat diff --git a/lisp/isearch.el b/lisp/isearch.el index 72a125fcecb..fe73bf7d6a4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -47,7 +47,7 @@ ;; modify the search string before executing the search. There are ;; three commands to terminate the editing: C-s and C-r exit the ;; minibuffer and search forward and reverse respectively, while C-m -;; exits and does a nonincremental search. +;; exits and searches in the last search direction. ;; Exiting immediately from isearch uses isearch-edit-string instead ;; of nonincremental-search, if search-nonincremental-instead is non-nil. @@ -515,12 +515,12 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-so" 'isearch-occur) (define-key map "\M-shr" 'isearch-highlight-regexp) - ;; The key translations defined in the C-x 8 prefix should insert - ;; characters into the search string. See iso-transl.el. + ;; The key translations defined in the C-x 8 prefix should add + ;; characters to the search string. See iso-transl.el. (define-key map "\C-x" nil) (define-key map [?\C-x t] 'isearch-other-control-char) (define-key map "\C-x8" nil) - (define-key map "\C-x8\r" 'isearch-insert-char-by-name) + (define-key map "\C-x8\r" 'isearch-char-by-name) map) "Keymap for `isearch-mode'.") @@ -528,7 +528,7 @@ This is like `describe-bindings', but displays only Isearch keys." (defvar minibuffer-local-isearch-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map "\r" 'isearch-nonincremental-exit-minibuffer) + (define-key map "\r" 'exit-minibuffer) (define-key map "\M-\t" 'isearch-complete-edit) (define-key map "\C-s" 'isearch-forward-exit-minibuffer) (define-key map "\C-r" 'isearch-reverse-exit-minibuffer) @@ -679,6 +679,8 @@ Type \\[isearch-yank-kill] to yank the last string of killed text. Type \\[isearch-yank-pop] to replace string just yanked into search prompt with string killed before it. Type \\[isearch-quote-char] to quote control character to search for it. +Type \\[isearch-char-by-name] to add a character to search by Unicode name,\ + with completion. \\[isearch-abort] while searching or when search has failed cancels input\ back to what has been found successfully. @@ -1273,7 +1275,6 @@ You can update the global isearch variables by setting new values to The following additional command keys are active while editing. \\<minibuffer-local-isearch-map> \\[exit-minibuffer] to resume incremental searching with the edited string. -\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. \\[isearch-forward-exit-minibuffer] to resume isearching forward. \\[isearch-reverse-exit-minibuffer] to resume isearching backward. \\[isearch-complete-edit] to complete the search string using the search ring." @@ -1307,13 +1308,18 @@ The following additional command keys are active while editing. (interactive) (setq isearch-nonincremental t) (exit-minibuffer)) +;; Changing the value of `isearch-nonincremental' has no effect here, +;; because `isearch-edit-string' ignores this change. Thus marked as obsolete. +(make-obsolete 'isearch-nonincremental-exit-minibuffer 'exit-minibuffer "24.4") (defun isearch-forward-exit-minibuffer () + "Resume isearching forward from the minibuffer that edits the search string." (interactive) (setq isearch-new-forward t) (exit-minibuffer)) (defun isearch-reverse-exit-minibuffer () + "Resume isearching backward from the minibuffer that edits the search string." (interactive) (setq isearch-new-forward nil) (exit-minibuffer)) @@ -1866,11 +1872,12 @@ Subword is used when `subword-mode' is activated. " (lambda () (let ((inhibit-field-text-motion t)) (line-end-position (if (eolp) 2 1)))))) -(defun isearch-insert-char-by-name () - "Read a character by its Unicode name and insert it into search string." +(defun isearch-char-by-name () + "Read a character by its Unicode name and add it to the search string. +Completion is available like in `read-char-by-name' used by `insert-char'." (interactive) (with-isearch-suspended - (let ((char (read-char-by-name "Insert character (Unicode name or hex): "))) + (let ((char (read-char-by-name "Add character to search (Unicode name or hex): "))) (when char (setq isearch-new-string (concat isearch-string (string char)) isearch-new-message (concat isearch-message diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 9359a65a1b8..9d700a5ed82 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -258,7 +258,7 @@ the variable `jit-lock-stealth-nice'." When this minor mode is enabled, jit-lock runs as little code as possible during redisplay and moves the rest to a timer, where things like `debug-on-error' and Edebug can be used." - :global t + :global t :group 'jit-lock (when jit-lock-defer-timer (cancel-timer jit-lock-defer-timer) (setq jit-lock-defer-timer nil)) diff --git a/lisp/loadup.el b/lisp/loadup.el index 7509689e2b7..5764cdec7eb 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -308,32 +308,10 @@ (message "Finding pointers to doc strings...") (if (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) - (let ((name emacs-version)) - (while (string-match "[^-+_.a-zA-Z0-9]+" name) - (setq name (concat (downcase (substring name 0 (match-beginning 0))) - "-" - (substring name (match-end 0))))) - (if (memq system-type '(ms-dos windows-nt)) - (let ((name1 (expand-file-name - (if (fboundp 'x-create-frame) "DOC-X" "DOC") - "../etc"))) - ;; There will be no DOC-X on MS-Windows when we build - ;; using the Posix Makefile's. In that case, we want - ;; to create DOC-XX.YY.ZZ, as on Unix. - (if (file-exists-p name1) - (setq name name1) - (setq name (concat (expand-file-name "../etc/DOC-") name)) - (if (file-exists-p name) - (delete-file name)) - (copy-file (expand-file-name "../etc/DOC") name t))) - (setq name (concat (expand-file-name "../etc/DOC-") name)) - (if (file-exists-p name) - (delete-file name)) - (copy-file (expand-file-name "../etc/DOC") name t)) - (Snarf-documentation (file-name-nondirectory name))) - (condition-case nil - (Snarf-documentation "DOC") - (error nil))) + (Snarf-documentation "DOC") + (condition-case nil + (Snarf-documentation "DOC") + (error nil))) (message "Finding pointers to doc strings...done") ;; Note: You can cause additional libraries to be preloaded diff --git a/lisp/master.el b/lisp/master.el index 368bb0d58d5..4a536ca5cda 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -53,10 +53,11 @@ ;;; Code: -(defgroup master nil - "Support for master/slave relationships between buffers." - :version "22.1" - :group 'convenience) +;; Unused. +;;; (defgroup master nil +;;; "Support for master/slave relationships between buffers." +;;; :version "22.1" +;;; :group 'convenience) ;; Variables that don't need initialization. @@ -84,7 +85,8 @@ using the following commands: The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'." - :group 'master + ;; Not global, so no effect. +;;; :group 'master :keymap '(("\C-c\C-n" . master-says-scroll-up) ("\C-c\C-p" . master-says-scroll-down) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ef949f7482e..a5d79a415f6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1856,6 +1856,7 @@ With a prefix argument ARG, enable the modemode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :global t + :group 'minibuffer (setq completion-in-region--data nil) ;; (remove-hook 'pre-command-hook #'completion-in-region--prech) (remove-hook 'post-command-hook #'completion-in-region--postch) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 44271a689cf..c45196f0316 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -352,11 +352,6 @@ Use `nxml-parent-document-set' to set it.") See the function `xmltok-forward-prolog' for more information.") (make-variable-buffer-local 'nxml-prolog-regions) -(defvar nxml-last-fontify-end nil - "Position where fontification last ended. -It is nil if the buffer changed since the last fontification.") -(make-variable-buffer-local 'nxml-last-fontify-end) - (defvar nxml-degraded nil "Non-nil if currently operating in degraded mode. Degraded mode is enabled when an internal error is encountered in the @@ -538,7 +533,6 @@ Many aspects this mode can be customized using (save-excursion (save-restriction (widen) - (nxml-clear-dependent-regions (point-min) (point-max)) (setq nxml-scan-end (copy-marker (point-min) nil)) (with-silent-modifications (nxml-clear-inside (point-min) (point-max)) @@ -583,12 +577,9 @@ Many aspects this mode can be customized using ;; Clean up fontification. (save-excursion (widen) - (let ((inhibit-read-only t) - (buffer-undo-list t) - (modified (buffer-modified-p))) + (with-silent-modifications (nxml-with-invisible-motion - (remove-text-properties (point-min) (point-max) '(face))) - (set-buffer-modified-p modified))) + (remove-text-properties (point-min) (point-max) '(face))))) (remove-hook 'change-major-mode-hook 'nxml-cleanup t)) (defun nxml-degrade (context err) @@ -638,10 +629,6 @@ the full extent of the area needing refontification. For bookkeeping, call this function even when fontification is disabled." (let ((pre-change-end (+ start pre-change-length))) - (setq start - (nxml-adjust-start-for-dependent-regions start - end - pre-change-length)) ;; If the prolog might have changed, rescan the prolog (when (<= start ;; Add 2 so as to include the < and following char that @@ -902,26 +889,16 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound." (defun nxml-extend-after-change-region (start end pre-change-length) (unless nxml-degraded - (setq nxml-last-fontify-end nil) - (let ((region (nxml-with-degradation-on-error - 'nxml-extend-after-change-region - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (with-silent-modifications - (nxml-extend-after-change-region1 - start end pre-change-length))))))))) - (if (consp region) region)))) - -(defun nxml-extend-after-change-region1 (start end pre-change-length) - (let* ((region (nxml-after-change1 start end pre-change-length)) - (font-lock-beg (car region)) - (font-lock-end (cdr region))) - - (nxml-extend-region) - (cons font-lock-beg font-lock-end))) + (nxml-with-degradation-on-error + 'nxml-extend-after-change-region + (save-excursion + (save-restriction + (widen) + (save-match-data + (nxml-with-invisible-motion + (with-silent-modifications + (nxml-after-change1 + start end pre-change-length))))))))) (defun nxml-fontify-matcher (bound) "Called as font-lock keyword matcher." @@ -936,13 +913,12 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound." (nxml-fontify-prolog) (goto-char nxml-prolog-end)) - (let (xmltok-dependent-regions - xmltok-errors) + (let (xmltok-errors) (while (and (nxml-tokenize-forward) (<= (point) bound)) ; Intervals are open-ended. (nxml-apply-fontify-rule))) - (setq nxml-last-fontify-end (point))) + ) ;; Since we did the fontification internally, tell font-lock to not ;; do anything itself. diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index 5bc4d74456b..ac4e9ac4cd9 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -69,18 +69,6 @@ ;; typical proportion of comments, CDATA sections and processing ;; instructions is small relative to other things. Secondly, to scan ;; we just search for the regexp <[!?]. -;; -;; One problem is unclosed comments, processing instructions and CDATA -;; sections. Suppose, for example, we encounter a <!-- but there's no -;; matching -->. This is not an unexpected situation if the user is -;; creating a comment. It is not helpful to treat the whole of the -;; file starting from the <!-- onwards as a single unclosed comment -;; token. Instead we treat just the <!-- as a piece of not well-formed -;; markup and continue. The problem is that if at some later stage a -;; --> gets added to the buffer after the unclosed <!--, we will need -;; to reparse the buffer starting from the <!--. We need to keep -;; track of these reparse dependencies; they are called dependent -;; regions in the code. ;;; Code: @@ -144,8 +132,7 @@ any 'inside' regions and at the beginning of a token." (if (>= start nxml-scan-end) nxml-scan-end (let ((inside-remove-start start) - xmltok-errors - xmltok-dependent-regions) + xmltok-errors) (while (or (when (xmltok-forward-special (min end nxml-scan-end)) (when (memq xmltok-type '(comment @@ -169,9 +156,7 @@ any 'inside' regions and at the beginning of a token." (when inside-end (setq end inside-end) t)))) - (nxml-clear-inside inside-remove-start end) - (nxml-clear-dependent-regions start end) - (nxml-mark-parse-dependent-regions)) + (nxml-clear-inside inside-remove-start end)) (when (> end nxml-scan-end) (set-marker nxml-scan-end end)) end)) @@ -182,63 +167,14 @@ any 'inside' regions and at the beginning of a token." (defun nxml-scan-prolog () (goto-char (point-min)) (let (xmltok-dtd - xmltok-errors - xmltok-dependent-regions) + xmltok-errors) (setq nxml-prolog-regions (xmltok-forward-prolog)) (setq nxml-prolog-end (point)) - (nxml-clear-inside (point-min) nxml-prolog-end) - (nxml-clear-dependent-regions (point-min) nxml-prolog-end) - (nxml-mark-parse-dependent-regions)) + (nxml-clear-inside (point-min) nxml-prolog-end)) (when (< nxml-scan-end nxml-prolog-end) (set-marker nxml-scan-end nxml-prolog-end))) -;;; Dependent regions - -(defun nxml-adjust-start-for-dependent-regions (start end pre-change-length) - (let ((overlays (overlays-in (1- start) start)) - (adjusted-start start)) - (while overlays - (let* ((overlay (car overlays)) - (ostart (overlay-start overlay))) - (when (and (eq (overlay-get overlay 'category) 'nxml-dependent) - (< ostart adjusted-start)) - (let ((funargs (overlay-get overlay 'nxml-funargs))) - (when (apply (car funargs) - (append (list start - end - pre-change-length - ostart - (overlay-end overlay)) - (cdr funargs))) - (setq adjusted-start ostart))))) - (setq overlays (cdr overlays))) - adjusted-start)) - -(defun nxml-mark-parse-dependent-regions () - (while xmltok-dependent-regions - (apply 'nxml-mark-parse-dependent-region - (car xmltok-dependent-regions)) - (setq xmltok-dependent-regions - (cdr xmltok-dependent-regions)))) - -(defun nxml-mark-parse-dependent-region (fun start end &rest args) - (let ((overlay (make-overlay start end nil t t))) - (overlay-put overlay 'category 'nxml-dependent) - (overlay-put overlay 'nxml-funargs (cons fun args)))) - -(put 'nxml-dependent 'evaporate t) - -(defun nxml-clear-dependent-regions (start end) - (let ((overlays (overlays-in start end))) - (while overlays - (let* ((overlay (car overlays)) - (category (overlay-get overlay 'category))) - (when (and (eq category 'nxml-dependent) - (<= start (overlay-start overlay))) - (delete-overlay overlay))) - (setq overlays (cdr overlays))))) - ;;; Random access parsing (defun nxml-token-after () @@ -286,17 +222,14 @@ Sets variables like `nxml-token-after'." (point))) (defun nxml-tokenize-forward () - (let (xmltok-dependent-regions - xmltok-errors) + (let (xmltok-errors) (when (and (xmltok-forward) (> (point) nxml-scan-end)) (cond ((memq xmltok-type '(comment cdata-section processing-instruction)) (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) - (xmltok-dependent-regions - (nxml-mark-parse-dependent-regions))) + (nxml-set-inside (1+ xmltok-start) (point) xmltok-type)))) (set-marker nxml-scan-end (point))) xmltok-type)) @@ -304,7 +237,7 @@ Sets variables like `nxml-token-after'." "Move point backwards outside any 'inside' regions or tags. Point will not move past `nxml-prolog-end'. Point will either be at BOUND or a '<' character starting a tag -outside any 'inside' regions. Ignores dependent regions. +outside any 'inside' regions. As a precondition, point must be >= BOUND." (nxml-move-outside-backwards) (when (not (equal (char-after) ?<)) @@ -331,8 +264,7 @@ Leave point unmoved if it is not inside anything special." (when (< nxml-scan-end pos) (save-excursion (goto-char nxml-scan-end) - (let (xmltok-errors - xmltok-dependent-regions) + (let (xmltok-errors) (while (when (xmltok-forward-special pos) (when (memq xmltok-type '(comment @@ -346,8 +278,6 @@ Leave point unmoved if it is not inside anything special." t (setq pos (point)) nil))) - (nxml-clear-dependent-regions nxml-scan-end pos) - (nxml-mark-parse-dependent-regions) (set-marker nxml-scan-end pos)))))) ;;; Element scanning diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index e1140980813..fb8bd037bdc 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -530,7 +530,6 @@ Return t if there is work to do, nil otherwise." xmltok-replacement xmltok-attributes xmltok-namespace-attributes - xmltok-dependent-regions xmltok-errors) (when (= (point) 1) (let ((regions (xmltok-forward-prolog))) @@ -566,7 +565,6 @@ Return t if there is work to do, nil otherwise." ;; do this before setting rng-validate-up-to-date-end ;; in case we get a quit (rng-mark-xmltok-errors) - (rng-mark-xmltok-dependent-regions) (setq rng-validate-up-to-date-end (marker-position rng-conditional-up-to-date-end)) (rng-clear-conditional-region) @@ -591,7 +589,6 @@ Return t if there is work to do, nil otherwise." (when (not have-remaining-chars) (rng-process-end-document)) (rng-mark-xmltok-errors) - (rng-mark-xmltok-dependent-regions) (setq rng-validate-up-to-date-end pos) (when rng-conditional-up-to-date-end (cond ((<= rng-conditional-up-to-date-end pos) @@ -661,57 +658,9 @@ Return t if there is work to do, nil otherwise." ;; if overlays left over from a previous use ;; of rng-validate-mode that ended with a change of mode (when rng-error-count - (setq rng-error-count (1- rng-error-count))))) - ((and (eq category 'rng-dependent) - (<= beg (overlay-start overlay))) - (delete-overlay overlay)))) + (setq rng-error-count (1- rng-error-count))))))) (setq overlays (cdr overlays)))))) -;;; Dependent regions - -(defun rng-mark-xmltok-dependent-regions () - (while xmltok-dependent-regions - (apply 'rng-mark-xmltok-dependent-region - (car xmltok-dependent-regions)) - (setq xmltok-dependent-regions - (cdr xmltok-dependent-regions)))) - -(defun rng-mark-xmltok-dependent-region (fun start end &rest args) - (let ((overlay (make-overlay start end nil t t))) - (overlay-put overlay 'category 'rng-dependent) - (overlay-put overlay 'rng-funargs (cons fun args)))) - -(put 'rng-dependent 'evaporate t) -(put 'rng-dependent 'modification-hooks '(rng-dependent-region-changed)) -(put 'rng-dependent 'insert-behind-hooks '(rng-dependent-region-changed)) - -(defun rng-dependent-region-changed (overlay - after-p - change-start - change-end - &optional pre-change-length) - (when (and after-p - ;; Emacs sometimes appears to call deleted overlays - (overlay-start overlay) - (let ((funargs (overlay-get overlay 'rng-funargs))) - (save-match-data - (save-excursion - (save-restriction - (widen) - (apply (car funargs) - (append (list change-start - change-end - pre-change-length - (overlay-start overlay) - (overlay-end overlay)) - (cdr funargs)))))))) - (rng-after-change-function (overlay-start overlay) - change-end - (+ pre-change-length - (- (overlay-start overlay) - change-start))) - (delete-overlay overlay))) - ;;; Error state (defun rng-mark-xmltok-errors () diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 03f05abac43..b80335362a1 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -132,33 +132,6 @@ from referencing the entity in element content and AR is either nil, meaning the replacement text included a <, or a string which is the normalized attribute value.") -(defvar xmltok-dependent-regions nil - "List of descriptors of regions that a parsed token depends on. - -A token depends on a region if the region occurs after the token and a -change in the region may require the token to be reparsed. This only -happens with markup that is not well-formed. For example, if a <? -occurs without a matching ?>, then the <? is returned as a -not-well-formed token. However, this token is dependent on region -from the end of the token to the end of the buffer: if this ever -contains ?> then the buffer must be reparsed from the <?. - -A region descriptor is a list (FUN START END ARG ...), where FUN is a -function to be called when the region changes, START and END are -integers giving the start and end of the region, and ARG... are -additional arguments to be passed to FUN. FUN will be called with 5 -arguments followed by the additional arguments if any: the position of -the start of the changed area in the region, the position of the end -of the changed area in the region, the length of the changed area -before the change, the position of the start of the region, the -position of the end of the region. FUN must return non-nil if the -region needs reparsing. FUN will be called in a `save-excursion' -with match-data saved. - -`xmltok-forward', `xmltok-forward-special' and `xmltok-forward-prolog' -may add entries to the beginning of this list, but will not clear it. -`xmltok-forward' and `xmltok-forward-special' will only add entries -when returning tokens of type not-well-formed.") (defvar xmltok-errors nil "List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'. @@ -176,7 +149,6 @@ indicating the position of the error.") xmltok-replacement xmltok-attributes xmltok-namespace-attributes - xmltok-dependent-regions xmltok-errors) ,@body)) @@ -298,14 +270,6 @@ and VALUE-END, otherwise a STRING giving the value." (or end (point))) xmltok-errors))) -(defun xmltok-add-dependent (fun &optional start end &rest args) - (setq xmltok-dependent-regions - (cons (cons fun - (cons (or start xmltok-start) - (cons (or end (point-max)) - args))) - xmltok-dependent-regions))) - (defun xmltok-forward () (setq xmltok-start (point)) (let* ((case-fold-search nil) @@ -684,14 +648,8 @@ Return the type of the token." (setq xmltok-type 'empty-element)) ((xmltok-after-lt start cdata-section-open) (setq xmltok-type - (if (search-forward "]]>" nil t) - 'cdata-section - (xmltok-add-error "No closing ]]>") - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "]]>") - 'not-well-formed))) + (progn (search-forward "]]>" nil 'move) + 'cdata-section))) ((xmltok-after-lt start processing-instruction-question) (xmltok-scan-after-processing-instruction-open)) ((xmltok-after-lt start comment-open) @@ -758,68 +716,44 @@ Return the type of the token." ;; xmltok-scan-prolog-after-processing-instruction-open ;; XXX maybe should include rest of line (up to any <,>) in unclosed PI (defun xmltok-scan-after-processing-instruction-open () - (cond ((not (search-forward "?>" nil t)) - (xmltok-add-error "No closing ?>" - xmltok-start - (+ xmltok-start 2)) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "?>") - (setq xmltok-type 'not-well-formed)) - (t - (cond ((not (save-excursion - (goto-char (+ 2 xmltok-start)) - (and (looking-at (xmltok-ncname regexp)) - (setq xmltok-name-end (match-end 0))))) - (setq xmltok-name-end (+ xmltok-start 2)) - (xmltok-add-error "<? not followed by name" - (+ xmltok-start 2) - (+ xmltok-start 3))) - ((not (or (memq (char-after xmltok-name-end) - '(?\n ?\t ?\r ? )) - (= xmltok-name-end (- (point) 2)))) - (xmltok-add-error "Target not followed by whitespace" - xmltok-name-end - (1+ xmltok-name-end))) - ((and (= xmltok-name-end (+ xmltok-start 5)) - (save-excursion - (goto-char (+ xmltok-start 2)) - (let ((case-fold-search t)) - (looking-at "xml")))) - (xmltok-add-error "Processing instruction target is xml" - (+ xmltok-start 2) - (+ xmltok-start 5)))) - (setq xmltok-type 'processing-instruction)))) + (search-forward "?>" nil 'move) + (cond ((not (save-excursion + (goto-char (+ 2 xmltok-start)) + (and (looking-at (xmltok-ncname regexp)) + (setq xmltok-name-end (match-end 0))))) + (setq xmltok-name-end (+ xmltok-start 2)) + (xmltok-add-error "<? not followed by name" + (+ xmltok-start 2) + (+ xmltok-start 3))) + ((not (or (memq (char-after xmltok-name-end) + '(?\n ?\t ?\r ? )) + (= xmltok-name-end (- (point) 2)))) + (xmltok-add-error "Target not followed by whitespace" + xmltok-name-end + (1+ xmltok-name-end))) + ((and (= xmltok-name-end (+ xmltok-start 5)) + (save-excursion + (goto-char (+ xmltok-start 2)) + (let ((case-fold-search t)) + (looking-at "xml")))) + (xmltok-add-error "Processing instruction target is xml" + (+ xmltok-start 2) + (+ xmltok-start 5)))) + (setq xmltok-type 'processing-instruction)) (defun xmltok-scan-after-comment-open () - (setq xmltok-type - (cond ((not (search-forward "--" nil t)) - (xmltok-add-error "No closing -->") - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - ;; not --> because - ;; -- is not allowed - ;; in comments in XML - "--") - 'not-well-formed) - ((eq (char-after) ?>) - (goto-char (1+ (point))) - 'comment) - (t - (xmltok-add-dependent - 'xmltok-semi-closed-reparse-p - nil - (point) - "--" - 2) - ;; just include the <!-- in the token - (goto-char (+ xmltok-start 4)) - ;; Need do this after the goto-char because - ;; marked error should just apply to <!-- - (xmltok-add-error "First following `--' not followed by `>'") - 'not-well-formed)))) + (let ((found-- (search-forward "--" nil 'move))) + (setq xmltok-type + (cond ((or (eq (char-after) ?>) (not found--)) + (goto-char (1+ (point))) + 'comment) + (t + ;; just include the <!-- in the token + (goto-char (+ xmltok-start 4)) + ;; Need do this after the goto-char because + ;; marked error should just apply to <!-- + (xmltok-add-error "First following `--' not followed by `>'") + 'not-well-formed))))) (defun xmltok-scan-attributes () (let ((recovering nil) @@ -1124,7 +1058,7 @@ comment, processing-instruction-left, processing-instruction-right, markup-declaration-open, markup-declaration-close, internal-subset-open, internal-subset-close, hash-name, keyword, literal, encoding-name. -Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate." +Adds to `xmltok-errors' as appropriate." (let ((case-fold-search nil) xmltok-start xmltok-type @@ -1148,7 +1082,6 @@ Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate." (1- xmltok-internal-subset-start) xmltok-internal-subset-start)) (xmltok-parse-entities) - ;; XXX prune dependent-regions for those entirely in prolog (nreverse xmltok-prolog-regions))) (defconst xmltok-bad-xml-decl-regexp @@ -1648,95 +1581,68 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT." (end (save-excursion (goto-char safe-end) (search-forward delim nil t)))) - (or (cond ((not end) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - delim) - nil) - ((save-excursion - (goto-char end) - (looking-at "[ \t\r\n>%[]")) - (goto-char end) - (setq xmltok-type 'literal)) - ((eq (1+ safe-end) end) - (goto-char end) - (xmltok-add-error (format "Missing space after %s" delim) - safe-end) - (setq xmltok-type 'literal)) - (t - (xmltok-add-dependent 'xmltok-semi-closed-reparse-p - xmltok-start - (1+ end) - delim - 1) - nil)) - (progn - (xmltok-add-error (format "Missing closing %s" delim)) - (goto-char safe-end) - (skip-chars-backward " \t\r\n") - (setq xmltok-type 'not-well-formed))))) + (cond ((or (not end) + (save-excursion + (goto-char end) + (looking-at "[ \t\r\n>%[]"))) + (goto-char end)) + ((eq (1+ safe-end) end) + (goto-char end) + (xmltok-add-error (format "Missing space after %s" delim) + safe-end))) + (setq xmltok-type 'literal))) (defun xmltok-scan-prolog-after-processing-instruction-open () - (cond ((not (search-forward "?>" nil t)) - (xmltok-add-error "No closing ?>" - xmltok-start - (+ xmltok-start 2)) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "?>") - (setq xmltok-type 'not-well-formed)) - (t - (let* ((end (point)) - (target - (save-excursion - (goto-char (+ xmltok-start 2)) - (and (looking-at (xmltok-ncname regexp)) - (or (memq (char-after (match-end 0)) - '(?\n ?\t ?\r ? )) - (= (match-end 0) (- end 2))) - (match-string-no-properties 0))))) - (cond ((not target) - (xmltok-add-error "\ + (search-forward "?>" nil 'move) + (let* ((end (point)) + (target + (save-excursion + (goto-char (+ xmltok-start 2)) + (and (looking-at (xmltok-ncname regexp)) + (or (memq (char-after (match-end 0)) + '(?\n ?\t ?\r ? )) + (= (match-end 0) (- end 2))) + (match-string-no-properties 0))))) + (cond ((not target) + (xmltok-add-error "\ Processing instruction does not start with a name" - (+ xmltok-start 2) - (+ xmltok-start 3))) - ((not (and (= (length target) 3) - (let ((case-fold-search t)) - (string-match "xml" target))))) - ((= xmltok-start 1) - (xmltok-add-error "Invalid XML declaration" - xmltok-start - (point))) - ((save-excursion - (goto-char xmltok-start) - (looking-at (xmltok-xml-declaration regexp))) - (xmltok-add-error "XML declaration not at beginning of file" - xmltok-start - (point))) - (t - (xmltok-add-error "Processing instruction has target of xml" - (+ xmltok-start 2) - (+ xmltok-start 5)))) - (xmltok-add-prolog-region 'processing-instruction-left - xmltok-start - (+ xmltok-start - 2 - (if target - (length target) - 0))) - (xmltok-add-prolog-region 'processing-instruction-right - (if target - (save-excursion - (goto-char (+ xmltok-start - (length target) - 2)) - (skip-chars-forward " \t\r\n") - (point)) - (+ xmltok-start 2)) - (point))) - (setq xmltok-type 'processing-instruction)))) + (+ xmltok-start 2) + (+ xmltok-start 3))) + ((not (and (= (length target) 3) + (let ((case-fold-search t)) + (string-match "xml" target))))) + ((= xmltok-start 1) + (xmltok-add-error "Invalid XML declaration" + xmltok-start + (point))) + ((save-excursion + (goto-char xmltok-start) + (looking-at (xmltok-xml-declaration regexp))) + (xmltok-add-error "XML declaration not at beginning of file" + xmltok-start + (point))) + (t + (xmltok-add-error "Processing instruction has target of xml" + (+ xmltok-start 2) + (+ xmltok-start 5)))) + (xmltok-add-prolog-region 'processing-instruction-left + xmltok-start + (+ xmltok-start + 2 + (if target + (length target) + 0))) + (xmltok-add-prolog-region 'processing-instruction-right + (if target + (save-excursion + (goto-char (+ xmltok-start + (length target) + 2)) + (skip-chars-forward " \t\r\n") + (point)) + (+ xmltok-start 2)) + (point))) + (setq xmltok-type 'processing-instruction)) (defun xmltok-parse-entities () (let ((todo xmltok-dtd)) diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index c421836dd84..359c22c50ea 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -288,12 +288,6 @@ To disable timer scans, set this to zero." :type 'boolean :group 'whitespace) -(defgroup whitespace-faces nil - "Faces used in whitespace." - :prefix "whitespace-" - :group 'whitespace - :group 'faces) - (defface whitespace-highlight '((((class color) (background light)) (:background "green1")) (((class color) (background dark)) @@ -305,7 +299,7 @@ To disable timer scans, set this to zero." (background dark)) (:background "white"))) "Face used for highlighting the bogus whitespaces that exist in the buffer." - :group 'whitespace-faces) + :group 'whitespace) (define-obsolete-face-alias 'whitespace-highlight-face 'whitespace-highlight "22.1") diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index e2b5dd9fb3b..7ae80b02e2f 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -46,6 +46,7 @@ ;;;; Customization variables +;; Unused. Cf org-completion. (defgroup org-complete nil "Outline-based notes management and organizer." :tag "Org" diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 7e7bfe28713..a946f0885ac 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -31,9 +31,10 @@ (require 'pcomplete) -(defgroup pcmpl-linux nil - "Functions for dealing with GNU/Linux completions." - :group 'pcomplete) +;; Unused. +;;; (defgroup pcmpl-linux nil +;;; "Functions for dealing with GNU/Linux completions." +;;; :group 'pcomplete) ;; Functions: diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 49c9c30d313..ab2f570cccb 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -98,8 +98,6 @@ parenthetical grouping.") (let ((map (make-sparse-keymap))) (define-key map "\M-." 'octave-find-definition) (define-key map "\M-\C-j" 'octave-indent-new-comment-line) - ;; C-c C-q is also used by cc modes for similar command - (define-key map "\C-c\C-q" 'octave-indent-defun) (define-key map "\C-c\C-p" 'octave-previous-code-line) (define-key map "\C-c\C-n" 'octave-next-code-line) (define-key map "\C-c\C-a" 'octave-beginning-of-line) @@ -134,27 +132,26 @@ parenthetical grouping.") "Menu for Octave mode." '("Octave" ("Lines" - ["Previous Code Line" octave-previous-code-line t] - ["Next Code Line" octave-next-code-line t] - ["Begin of Continuation" octave-beginning-of-line t] - ["End of Continuation" octave-end-of-line t] - ["Split Line at Point" octave-indent-new-comment-line t]) + ["Previous Code Line" octave-previous-code-line t] + ["Next Code Line" octave-next-code-line t] + ["Begin of Continuation" octave-beginning-of-line t] + ["End of Continuation" octave-end-of-line t] + ["Split Line at Point" octave-indent-new-comment-line t]) ("Blocks" - ["Mark Block" octave-mark-block t] - ["Close Block" smie-close-block t]) + ["Mark Block" octave-mark-block t] + ["Close Block" smie-close-block t]) ("Functions" - ["Indent Function" octave-indent-defun t] - ["Insert Function" octave-insert-defun t] - ["Update function file comment" octave-update-function-file-comment t]) + ["Insert Function" octave-insert-defun t] + ["Update function file comment" octave-update-function-file-comment t]) "-" ("Debug" - ["Send Current Line" octave-send-line t] - ["Send Current Block" octave-send-block t] - ["Send Current Function" octave-send-defun t] - ["Send Region" octave-send-region t] - ["Show Process Buffer" octave-show-process-buffer t] - ["Hide Process Buffer" octave-hide-process-buffer t] - ["Kill Process" octave-kill-process t]) + ["Send Current Line" octave-send-line t] + ["Send Current Block" octave-send-block t] + ["Send Current Function" octave-send-defun t] + ["Send Region" octave-send-region t] + ["Show Process Buffer" octave-show-process-buffer t] + ["Hide Process Buffer" octave-hide-process-buffer t] + ["Kill Process" octave-kill-process t]) "-" ["Indent Line" indent-according-to-mode t] ["Complete Symbol" completion-at-point t] @@ -1111,14 +1108,8 @@ The new line is properly indented." (insert (concat " " octave-continuation-string)) (reindent-then-newline-and-indent)))) -(defun octave-indent-defun () - "Properly indent the Octave function which contains point." - (interactive) - (save-excursion - (mark-defun) - (message "Indenting function...") - (indent-region (point) (mark) nil)) - (message "Indenting function...done.")) +(define-obsolete-function-alias + 'octave-indent-defun 'prog-indent-sexp "24.4") ;;; Motion diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 6cb4713885e..256695acc9f 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -148,6 +148,7 @@ as words. ;;;###autoload (define-global-minor-mode global-subword-mode subword-mode + :group 'convenience (lambda () (subword-mode 1))) (defun subword-forward (&optional arg) @@ -301,6 +302,7 @@ edit them as words. ;;;###autoload (define-global-minor-mode global-superword-mode superword-mode + :group 'convenience (lambda () (superword-mode 1))) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 1a7ecb5ef87..8b61ae400d2 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -13,10 +13,10 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst vhdl-version "3.33.28" +(defconst vhdl-version "3.34.2" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2010-09-22" +(defconst vhdl-time-stamp "2012-11-21" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -72,8 +72,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Emacs Versions -;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X -;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally) +;; this updated version was only tested on: GNU Emacs 20.4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation @@ -84,7 +83,7 @@ ;; or into an arbitrary directory that is added to the load path by the ;; following line in your Emacs start-up file `.emacs': -;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) +;; (push (expand-file-name "<directory-name>") load-path) ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same ;; directory. Otherwise, byte-compile the source file: @@ -96,7 +95,7 @@ ;; (not required in Emacs 20 and higher): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) -;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)) +;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) ;; More detailed installation instructions are included in the official ;; VHDL Mode distribution. @@ -130,6 +129,7 @@ ;; Emacs 21+ handling (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 21, 22, ... is used.") +;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 22, ... is used.") @@ -210,22 +210,25 @@ Overrides local variable `indent-tabs-mode'." (defcustom vhdl-compiler-alist '( + ;; 60: docal <= false; + ;; ^^^^^ + ;; [Error] Assignment error: variable is illegal target of signal assignment ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1" nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms" - ("\\s-\\([0-9]+\\):" 0 1 0) ("Compiling file \\(.+\\)" 1) + ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/\\1.vif" upcase)) ;; Aldec - ;; COMP96 ERROR COMP96_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30 - ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1" + ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 + ("Aldec" "vcom" "-work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" - (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 0) + (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) nil) ;; Cadence Leapfrog: cv -file test.vhd ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" - ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0) + ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) ;; Cadence Affirma NC vhdl: ncvhdl test.vhd @@ -233,21 +236,27 @@ Overrides local variable `indent-tabs-mode'." ;; (PLL_400X_TOP) is not declared [10.3]. ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" - ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" "\\1/package/pc.db" "\\1/body/pc.db" downcase)) ;; ghdl vhdl: ghdl test.vhd ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" - ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) + ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) ("\\1/entity" "\\2/\\1" "\\1/configuration" "\\1/package" "\\1/body" downcase)) + ;; IBM Compiler + ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6 + ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1" + nil "mkdir \\1" "./" "work/" "Makefile" "ibm" + ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) + nil) ;; Ikos Voyager: analyze test.vhd ;; analyze test.vhd ;; E L4/C5: this library unit is inaccessible ("Ikos" "analyze" "-l \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ikos" - ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2) + ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) nil) ;; ModelSim, Model Technology: vcom test.vhd @@ -257,29 +266,39 @@ Overrides local variable `indent-tabs-mode'." ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" - ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 0) + ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd ;; test.vhd:34: error message ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" - ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) + ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) + ;; Quartus compiler + ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used + ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text + ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal + ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library + ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ... + ("Quartus" "make" "-work \\1" "make" "-f \\1" + nil "mkdir \\1" "./" "work/" "Makefile" "quartus" + ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) + nil) ;; QuickHDL, Mentor Graphics: qvhcom test.vhd ;; ERROR: test.vhd(24): near "dnd": expecting: END ;; WARNING[4]: test.vhd(30): A space is required between ... ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" - ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) + ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" "\\1/_primary.dat" "\\1/body.dat" downcase)) ;; Savant: scram -publish-cc test.vhd ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" - ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) + ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" "\\1_config.vhdl" "\\1_package.vhdl" "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) @@ -287,39 +306,39 @@ Overrides local variable `indent-tabs-mode'." ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "simili" - ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0) + ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" "\\1/prim.var" "\\1/_body.var" downcase)) ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" - ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0) + ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) nil) ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" - ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) + ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" - ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) + ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) ;; Synplify: ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 ("Synplify" "n/a" "n/a" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "synplify" - ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) + ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) nil) ;; Vantage: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "vantage" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; VeriBest: vc vhdl test.vhd @@ -329,21 +348,21 @@ Overrides local variable `indent-tabs-mode'." ;; [Error] Name BITA is unknown ("VeriBest" "vc" "vhdl" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "veribest" - ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0) + ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0) nil) ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **Error: LINE 49 *** No aggregate value is valid in this context. ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" - ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; Xilinx XST: ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error ("Xilinx XST" "xflow" "" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" - ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0) + ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) nil) ) "List of available VHDL compilers and their properties. @@ -429,9 +448,13 @@ NOTE: Activate new error and file message regexps and reflect the new setting (string :tag "ID string ") (list :tag "Error message" :indent 4 (regexp :tag "Regexp ") - (integer :tag "File subexp index") + (choice :tag "File subexp " + (integer :tag "Index") + (const :tag "No file name" nil)) (integer :tag "Line subexp index") - (integer :tag "Column subexp idx")) + (choice :tag "Column subexp " + (integer :tag "Index") + (const :tag "No column number" nil))) (list :tag "File message" :indent 4 (regexp :tag "Regexp ") (integer :tag "File subexp index")) @@ -450,6 +473,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Downcase" downcase)))))) :set (lambda (variable value) (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + :version "24.4" :group 'vhdl-compile) (defcustom vhdl-compiler "GHDL" @@ -457,7 +481,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting Select a compiler name from the ones defined in option `vhdl-compiler-alist'." :type (let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice) (nreverse list))) :group 'vhdl-compile) @@ -602,7 +626,7 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' (list :tag "Compiler" :indent 6 ,(let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice :tag "Compiler name") (nreverse list))) @@ -637,7 +661,7 @@ headers and the source files/directories to be scanned in the hierarchy browser. The current project can also be changed temporarily in the menu." :type (let ((alist vhdl-project-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice (const :tag "None" nil) (const :tag "--")) (nreverse list))) @@ -1268,6 +1292,18 @@ The comments and empty lines between groups of ports are pasted: (const :tag "Always" always)) :group 'vhdl-port) +(defcustom vhdl-actual-generic-name '(".*" . "\\&") + (concat + "Specifies how actual generic names are obtained from formal generic names. +In a component instantiation, an actual generic name can be +obtained by modifying the formal generic name (e.g. attaching or stripping +off a substring)." + vhdl-name-doc-string) + :type '(cons (regexp :tag "From regexp") + (string :tag "To string ")) + :group 'vhdl-port + :version "24.4") + (defcustom vhdl-actual-port-name '(".*" . "\\&") (concat "Specifies how actual port names are obtained from formal port names. @@ -1469,21 +1505,21 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (defvar end-comment-column) -(defgroup vhdl-align nil - "Customizations for alignment." +(defgroup vhdl-beautify nil + "Customizations for beautification." :group 'vhdl) (defcustom vhdl-auto-align t "Non-nil means align some templates automatically after generation." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-groups t "Non-nil means align groups of code lines separately. A group of code lines is a region of consecutive lines between two lines that match the regexp in option `vhdl-align-group-separate'." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-group-separate "^\\s-*$" "Regexp for matching a line that separates groups of lines for alignment. @@ -1491,7 +1527,7 @@ Examples: \"^\\s-*$\": matches an empty line \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" :type 'regexp - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-same-indent t "Non-nil means align blocks with same indent separately. @@ -1500,7 +1536,18 @@ blocks of same indent which are aligned separately (except for argument/port lists). This gives nicer alignment in most cases. Option `vhdl-align-groups' still applies within these blocks." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) + +(defcustom vhdl-beautify-options '(t t t t t) + "List of options for beautifying code. Allows to disable individual +features of code beautification." + :type '(list (boolean :tag "Whitespace cleanup ") + (boolean :tag "Single statement per line") + (boolean :tag "Indentation ") + (boolean :tag "Alignment ") + (boolean :tag "Case fixing ")) + :group 'vhdl-beautify + :version "24.4") (defgroup vhdl-highlight nil @@ -1846,7 +1893,7 @@ useful in large files where syntax-based indentation gets very slow." :group 'vhdl-misc) (defcustom vhdl-indent-comment-like-next-code-line t - "*Non-nil means comment lines are indented like the following code line. + "Non-nil means comment lines are indented like the following code line. Otherwise, comment lines are indented like the preceding code line. Indenting comment lines like the following code line gives nicer indentation when comments precede the code that they refer to." @@ -2067,7 +2114,7 @@ your style, only those that are different from the default.") (lambda (var) (cons var (symbol-value var)))) varlist)))) - (setq vhdl-style-alist (cons default vhdl-style-alist)))) + (push default vhdl-style-alist))) (defvar vhdl-mode-hook nil "Hook called by `vhdl-mode'.") @@ -2084,10 +2131,11 @@ your style, only those that are different from the default.") (require 'hippie-exp) ;; optional (minimize warning messages during compile) +(unless (featurep 'xemacs) (eval-when-compile (require 'font-lock) (require 'ps-print) - (require 'speedbar)) + (require 'speedbar))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2187,6 +2235,17 @@ Ignore byte-compiler warnings you might see." (unless (fboundp 'member-ignore-case) (defalias 'member-ignore-case 'member)) +;; `last-input-char' obsolete in Emacs 24, `last-input-event' different +;; behavior in XEmacs +(defvar vhdl-last-input-event) +(if (featurep 'xemacs) + (defvaralias 'vhdl-last-input-event 'last-input-char) + (defvaralias 'vhdl-last-input-event 'last-input-event)) + +;; `help-print-return-message' changed to `print-help-return-message' in Emacs +;;;(unless (fboundp 'help-print-return-message) +;;; (defalias 'help-print-return-message 'print-help-return-message)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Compatibility with older VHDL Mode versions @@ -2207,7 +2266,7 @@ Ignore byte-compiler warnings you might see." (vhdl-warning (apply 'format args) t) (unless vhdl-warnings (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) - (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings)))) + (push (apply 'format args) vhdl-warnings))) (defun vhdl-warning (string &optional nobeep) "Print out warning STRING and beep." @@ -2241,7 +2300,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-model-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-model-alist (nreverse new-alist))) (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) @@ -2251,7 +2310,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-project-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-project-alist (nreverse new-alist))) (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) @@ -2339,7 +2398,6 @@ Ignore byte-compiler warnings you might see." (unless (get 'speedbar-indentation-width 'saved-value) (setq speedbar-indentation-width 2))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Help functions / inline substitutions / macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2487,7 +2545,7 @@ conversion." (defun vhdl-delete (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." - (setq list (cons nil list)) + (push nil list) (let ((list1 list)) (while (and (cdr list1) (not (equal elt (cadr list1)))) (setq list1 (cdr list1))) @@ -2535,6 +2593,11 @@ conversion." (set-buffer (marker-buffer marker))) (goto-char marker)) +(defun vhdl-goto-line (line) + "Use this instead of calling user level function `goto-line'." + (goto-char (point-min)) + (forward-line (1- line))) + (defun vhdl-menu-split (list title) "Split menu LIST into several submenus, if number of elements > `vhdl-menu-max-size'." @@ -2545,19 +2608,19 @@ elements > `vhdl-menu-max-size'." (menuno 1) (i 0)) (while remain - (setq sublist (cons (car remain) sublist)) + (push (car remain) sublist) (setq remain (cdr remain)) (setq i (+ i 1)) (if (= i vhdl-menu-max-size) (progn - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result)) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result) (setq i 0) (setq menuno (+ menuno 1)) (setq sublist '())))) (and sublist - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result))) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result)) (nreverse result)) list)) @@ -2792,6 +2855,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) @@ -3499,6 +3564,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] "--" + ["Statement Region" vhdl-fix-statement-region (mark)] + ["Statement Buffer" vhdl-fix-statement-buffer t] + "--" ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) ("Update" ["Sensitivity List" vhdl-update-sensitivity-list-process t] @@ -3807,6 +3875,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Always" (customize-set-variable 'vhdl-include-group-comments 'always) :style radio :selected (eq 'always vhdl-include-group-comments)]) + ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] ["Instance Name..." (customize-option 'vhdl-instance-name) t] ("Testbench" @@ -3903,7 +3972,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] "--" ["Customize Group..." (customize-group 'vhdl-comment) t]) - ("Align" + ("Beautify" ["Auto Align Templates" (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) :style toggle :selected vhdl-auto-align] @@ -3911,13 +3980,14 @@ STRING are replaced by `-' and substrings are converted to lower case." (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) :style toggle :selected vhdl-align-groups] ["Group Separation String..." - (customize-set-variable 'vhdl-align-group-separate) t] + (customize-option 'vhdl-align-group-separate) t] ["Align Lines with Same Indent" (customize-set-variable 'vhdl-align-same-indent (not vhdl-align-same-indent)) :style toggle :selected vhdl-align-same-indent] + ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] "--" - ["Customize Group..." (customize-group 'vhdl-align) t]) + ["Customize Group..." (customize-group 'vhdl-beautify) t]) ("Highlight" ["Highlighting On/Off..." (customize-option @@ -4181,14 +4251,13 @@ The directory of the current source file is scanned." (setq found nil) (while file-list (setq found t) - (setq menu-list (cons (vector (car file-list) - (list 'find-file (car file-list)) t) - menu-list)) + (push (vector (car file-list) (list 'find-file (car file-list)) t) + menu-list) (setq file-list (cdr file-list))) (setq menu-list (vhdl-menu-split menu-list "Sources")) - (when found (setq menu-list (cons "--" menu-list))) - (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list)) - (setq menu-list (cons "Sources" menu-list)) + (when found (push "--" menu-list)) + (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) + (push "Sources" menu-list) ;; Create menu (easy-menu-add menu-list) (easy-menu-define vhdl-sources-menu newmap @@ -4572,7 +4641,7 @@ Usage: option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is - larger than `font-lock-maximum-size'). Also, a source file menu can be + larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the current directory for VHDL source files. @@ -4699,7 +4768,7 @@ Usage: automatically recognized as VHDL source files. To add an extension \".xxx\", add the following line to your Emacs start-up file (`.emacs'): - \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) + \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist) HINTS: @@ -7270,7 +7339,7 @@ indentation change." (beginning-of-line 2) (setq syntax (vhdl-get-syntactic-context))))) (when is-comment - (setq syntax (cons (cons 'comment nil) syntax))) + (push (cons 'comment nil) syntax)) (apply '+ (mapcar 'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) @@ -7381,7 +7450,7 @@ ENDPOS is encountered." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Alignment, whitespace fixup, beautifying +;;; Alignment, beautifying ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst vhdl-align-alist @@ -7597,7 +7666,8 @@ the token in MATCH." (when vhdl-progress-interval (setq vhdl-progress-info (vector (count-lines (point-min) beg) (count-lines (point-min) end) 0)))) - (vhdl-fixup-whitespace-region beg end t) + (when (nth 0 vhdl-beautify-options) + (vhdl-fixup-whitespace-region beg end t)) (goto-char beg) (if (not vhdl-align-groups) ;; align entire region @@ -7721,14 +7791,14 @@ the token in MATCH." ;; search for comment start positions and lengths (while (< (point) end) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") + (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 2)) (vhdl-in-literal)))) (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) (setq length (- (match-end 2) (match-beginning 2))) (setq start-max (max start start-max)) (setq length-max (max length length-max)) - (setq comment-list (cons (cons start length) comment-list))) + (push (cons start length) comment-list)) (beginning-of-line 2)) (setq comment-list (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) @@ -7739,14 +7809,14 @@ the token in MATCH." (unless (or (= (caar comment-list) (car start-list)) (<= (+ (car start-list) (cdar comment-list)) end-comment-column)) - (setq start-list (cons (caar comment-list) start-list))) + (push (caar comment-list) start-list)) (setq comment-list (cdr comment-list))) ;; align lines as nicely as possible (goto-char beg) (while (< (point) end) (setq cur-start nil) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") + (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 3)) (vhdl-in-literal)))) @@ -7872,7 +7942,7 @@ end of line, do nothing in comments and strings." (replace-match "\\2"))) ;; surround operator symbols by one space (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t) + (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) (if (or (match-string 1) (<= (match-beginning 0) ; not if at boi (save-excursion (back-to-indentation) (point)))) @@ -7906,6 +7976,154 @@ end of line, do nothing in comments." (vhdl-fixup-whitespace-region (point-min) (point-max))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Case fixing + +(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) + "Convert all words matching WORD-REGEXP in region to lower or upper case, +depending on parameter UPPER-CASE." + (let ((case-replace nil) + (last-update 0)) + (vhdl-prepare-search-2 + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward word-regexp end t) + (or (vhdl-in-literal) + (if upper-case + (upcase-word -1) + (downcase-word -1))) + (when (and count vhdl-progress-interval (not noninteractive) + (< vhdl-progress-interval + (- (nth 1 (current-time)) last-update))) + (message "Fixing case... (%2d%s)" + (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) + "%") + (setq last-update (nth 1 (current-time))))) + (goto-char end))))) + +(defun vhdl-fix-case-region (beg end &optional arg) + "Convert all VHDL words in region to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive "r\nP") + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-types vhdl-types-regexp 1) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-constants vhdl-constants-regexp 4) + (when vhdl-progress-interval (message "Fixing case...done"))) + +(defun vhdl-fix-case-buffer () + "Convert all VHDL words in buffer to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive) + (vhdl-fix-case-region (point-min) (point-max))) + +(defun vhdl-fix-case-word (&optional arg) + "Convert word after cursor to upper case if necessary." + (interactive "p") + (save-excursion + (when arg (backward-word 1)) + (vhdl-prepare-search-1 + (when (and vhdl-upper-case-keywords + (looking-at vhdl-keywords-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-types + (looking-at vhdl-types-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-attributes + (looking-at vhdl-attributes-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-enum-values + (looking-at vhdl-enum-values-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-constants + (looking-at vhdl-constants-regexp)) + (upcase-word 1))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Fix statements +;; - force each statement to be on a separate line except when on same line +;; with 'end' keyword + +(defun vhdl-fix-statement-region (beg end &optional arg) + "Force statements in region on separate line except when on same line +with 'end' keyword (necessary for correct indentation). +Currently supported keywords: 'begin', 'if'." + (interactive "r\nP") + (vhdl-prepare-search-2 + (let (point) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + ;; `begin' keyword + (while (re-search-forward + "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t) + (goto-char (match-end 0)) + (setq point (point-marker)) + (when (and (match-string 1) + (or (not (match-string 2)) + (save-excursion (goto-char (match-end 2)) + (vhdl-in-literal))) + (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal)))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)) + (goto-char beg) + ;; `for', `if' keywords + (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) + (goto-char (match-end 1)) + (setq point (point-marker)) + ;; exception: in literal or preceded by `end' or label + (when (and (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal))) + (save-excursion + (beginning-of-line 1) + (save-match-data + (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" + (match-beginning 1) t) + (not (string-match + "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$" + (match-string 1))))))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)))))) + +(defun vhdl-fix-statement-buffer () + "Force statements in buffer on separate line except when on same line +with 'end' keyword (necessary for correct indentation)." + (interactive) + (vhdl-fix-statement-region (point-min) (point-max))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Trailing spaces + +(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) + "Remove trailing spaces in region." + (interactive "r\nP") + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward "[ \t]+$" end t) + (unless (vhdl-in-literal) + (replace-match "" nil nil))))) + +(defun vhdl-remove-trailing-spaces () + "Remove trailing spaces in buffer." + (interactive) + (vhdl-remove-trailing-spaces-region (point-min) (point-max))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Beautify (defun vhdl-beautify-region (beg end) @@ -7915,10 +8133,17 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', `vhdl-fix-case-buffer'." (interactive "r") (setq end (save-excursion (goto-char end) (point-marker))) - (vhdl-indent-region beg end) + (save-excursion ; remove DOS EOL characters in UNIX file + (goto-char beg) + (while (search-forward "
" nil t) + (replace-match "" nil t))) + (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) + (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) + (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) (let ((vhdl-align-groups t)) - (vhdl-align-region beg end)) - (vhdl-fix-case-region beg end)) + (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end))) + (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) + (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end))) (defun vhdl-beautify-buffer () "Beautify buffer by applying indentation, whitespace fixup, alignment, and @@ -8014,7 +8239,8 @@ buffer." (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) (goto-char (match-beginning 0)) (condition-case nil (vhdl-update-sensitivity-list) (error ""))) - (message "Updating sensitivity lists...done")))) + (message "Updating sensitivity lists...done"))) + (when noninteractive (save-buffer))) (defun vhdl-update-sensitivity-list () "Update sensitivity list." @@ -8040,57 +8266,57 @@ buffer." (scan-regions-list '(;; right-hand side of signal/variable assignment ;; (special case: "<=" is relational operator in a condition) - ((re-search-forward "[<:]=" proc-end t) - (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) + ((vhdl-re-search-forward "[<:]=" proc-end t) + (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) ;; if condition - ((re-search-forward "^\\s-*if\\>" proc-end t) - (re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) + (vhdl-re-search-forward "\\<then\\>" proc-end t)) ;; elsif condition - ((re-search-forward "\\<elsif\\>" proc-end t) - (re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) + (vhdl-re-search-forward "\\<then\\>" proc-end t)) ;; while loop condition - ((re-search-forward "^\\s-*while\\>" proc-end t) - (re-search-forward "\\<loop\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) + (vhdl-re-search-forward "\\<loop\\>" proc-end t)) ;; exit/next condition - ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) - (re-search-forward ";" proc-end t)) + ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) + (vhdl-re-search-forward ";" proc-end t)) ;; assert condition - ((re-search-forward "\\<assert\\>" proc-end t) - (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) + ((vhdl-re-search-forward "\\<assert\\>" proc-end t) + (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) ;; case expression - ((re-search-forward "^\\s-*case\\>" proc-end t) - (re-search-forward "\\<is\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) + (vhdl-re-search-forward "\\<is\\>" proc-end t)) ;; parameter list of procedure call, array index ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) (1- (point))) (progn (backward-char) (forward-sexp) (while (looking-at "(") (forward-sexp)) (point))))) - name field read-list sens-list signal-list + name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list (goto-char proc-beg) - (re-search-forward "\\<process\\>" proc-mid t) + (vhdl-re-search-forward "\\<process\\>" proc-mid t) (if (not (looking-at "[ \t\n\r\f]*(")) (setq sens-beg (point)) - (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) + (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) (goto-char (match-end 1)) (forward-sexp) (setq sens-end (1- (point))) (goto-char sens-beg) - (while (and (re-search-forward "\\(\\w+\\)" sens-end t) + (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) (setq sens-list (cons (downcase (match-string 0)) sens-list)) - (re-search-forward "\\s-*,\\s-*" sens-end t)))) + (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) (setq signal-list (append visible-list sens-list)) ;; search for sequential parts (goto-char proc-mid) (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) - (setq end (re-search-forward "\\<then\\>" proc-end t)) - (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) + (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) + (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) (goto-char end) (backward-word 1) (vhdl-forward-sexp) - (setq seq-region-list (cons (cons end (point)) seq-region-list)) + (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process (while scan-regions-list @@ -8107,15 +8333,35 @@ buffer." (and tmp-list (< (point) (cdar tmp-list)))))) (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) (setq name (match-string 1)) + ;; get array index range (when vhdl-array-index-record-field-in-sensitivity-list - (setq field (match-string 2))) + (setq field (match-string 2)) + ;; not use if it includes a variable name + (save-match-data + (setq tmp-list visible-list) + (while (and field tmp-list) + (when (string-match + (concat "\\<" (car tmp-list) "\\>") field) + (setq field nil)) + (setq tmp-list (cdr tmp-list))))) (when (and (not (match-string 6)) ; not when formal parameter (not (and (match-string 5) ; not event attribute (not (member (downcase (match-string 5)) '("event" "last_event" "transaction"))))) (member (downcase name) signal-list)) - (unless (member-ignore-case (concat name field) read-list) - (setq read-list (cons (concat name field) read-list)))) + ;; not add if name or name+field already exists + (unless + (or (member-ignore-case name read-list) + (member-ignore-case (concat name field) read-list)) + (push (concat name field) read-list)) + (setq tmp-list read-list) + ;; remove existing name+field if name is added + (save-match-data + (while tmp-list + (when (string-match (concat "^" name field "[(.]") + (car tmp-list)) + (setq read-list (delete (car tmp-list) read-list))) + (setq tmp-list (cdr tmp-list))))) (goto-char (match-end 1))))) (setq scan-regions-list (cdr scan-regions-list))) ;; update sensitivity list @@ -8171,7 +8417,7 @@ buffer." (while (< (point) end) (when (looking-at "signal[ \t\n\r\f]+") (goto-char (match-end 0))) - (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+") + (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0)) @@ -8190,12 +8436,12 @@ buffer." (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) (if (match-string 2) ;; scan signal name - (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)") + (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0))) ;; scan alias name, check is alias of (declared) signal - (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\<is[ \t\n\r\f]+\\(\\w+\\)") + (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)") (member (downcase (match-string 2)) signal-list)) (setq signal-list (cons (downcase (match-string 1)) signal-list)) @@ -8283,19 +8529,6 @@ buffer." (goto-char end) (insert ")"))))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous - -(defun vhdl-remove-trailing-spaces () - "Remove trailing spaces in the whole buffer." - (interactive) - (save-match-data - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" (point-max) t) - (unless (vhdl-in-literal) - (replace-match "" nil nil)))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Electrification @@ -8327,14 +8560,14 @@ project is defined." With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable it if ARG is omitted or nil." - :global t) + :global t :group 'vhdl-mode) (define-minor-mode vhdl-stutter-mode "Toggle VHDL stuttering mode. With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable it if ARG is omitted or nil." - :global t) + :global t :group 'vhdl-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuttering @@ -8391,7 +8624,7 @@ is omitted or nil." (defun vhdl-electric-quote (count) "'' --> \"" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) last-input-event) + (if (= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (insert-char ?\" 1)) (insert-char ?\' 1)) (self-insert-command count))) @@ -8399,7 +8632,7 @@ is omitted or nil." (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert ": ") @@ -8413,7 +8646,7 @@ is omitted or nil." (defun vhdl-electric-comma (count) "',,' --> ' <= '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "<= "))) @@ -8423,7 +8656,7 @@ is omitted or nil." (defun vhdl-electric-period (count) "'..' --> ' => '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "=> "))) @@ -8433,7 +8666,7 @@ is omitted or nil." (defun vhdl-electric-equal (count) "'==' --> ' == '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "== "))) @@ -8704,12 +8937,13 @@ since these are almost equivalent)." "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) (setq unit (upcase (or unit ""))) (cond ((equal unit "ENTITY") - (vhdl-template-field "library name" "." nil nil nil nil + (let ((begin (point))) + (vhdl-template-field "library name" "." t begin (point) nil (vhdl-work-library)) (vhdl-template-field "entity name" "(") (if (vhdl-template-field "[architecture name]" nil t) (insert ")") - (delete-char -1))) + (delete-char -1)))) ((equal unit "CONFIGURATION") (vhdl-template-field "library name" "." nil nil nil nil (vhdl-work-library)) @@ -9845,7 +10079,7 @@ otherwise." (let ((definition (upcase (or (vhdl-template-field - "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t) + "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) "")))) (cond ((equal definition "") (delete-char -4) @@ -9863,6 +10097,11 @@ otherwise." ((equal definition "FILE") (vhdl-insert-keyword " OF ") (vhdl-template-field "type" ";")) + ((equal definition "ENUM") + (kill-word -1) + (insert "(") + (setq end-pos (point-marker)) + (insert ");")) (t (insert ";"))) (when mid-pos (setq end-pos (point-marker)) @@ -10909,7 +11148,7 @@ but not if inside a comment or quote." (backward-word 1) (vhdl-case-word 1) (delete-char 1)) - (let ((invoke-char last-command-event) + (let ((invoke-char vhdl-last-input-event) (abbrev-mode -1) (vhdl-template-invoked-by-hook t)) (let ((caught (catch 'abort @@ -11633,7 +11872,8 @@ reflected in a subsequent paste operation." ;; paste formal and actual generic (insert (car (nth 0 generic)) " => " (if no-constants - (car (nth 0 generic)) + (vhdl-replace-string vhdl-actual-generic-name + (car (nth 0 generic))) (or (nth 2 generic) ""))) (setq generic-list (cdr generic-list)) (insert (if generic-list "," ")")) @@ -11776,7 +12016,7 @@ reflected in a subsequent paste operation." ;; paste generic constants (setq name (nth 0 generic)) (when name - (insert (car name)) + (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) ;; paste type (insert " : " (nth 1 generic)) ;; paste initialization @@ -11802,7 +12042,7 @@ reflected in a subsequent paste operation." (message "Pasting port as signals...") (unless no-indent (indent-according-to-mode)) (let ((margin (current-indentation)) - start port names + start port names type generic-list port-name constant-name pos (port-list (nth 2 vhdl-port-list))) (when port-list (setq start (point)) @@ -11822,7 +12062,21 @@ reflected in a subsequent paste operation." (setq names (cdr names)) (when names (insert ", "))) ;; paste type - (insert " : " (nth 3 port)) + (setq type (nth 3 port)) + (setq generic-list (nth 1 vhdl-port-list)) + (vhdl-prepare-search-1 + (setq pos 0) + ;; replace formal by actual generics + (while generic-list + (setq port-name (car (nth 0 (car generic-list)))) + (while (string-match (concat "\\<" port-name "\\>") type pos) + (setq constant-name + (save-match-data (vhdl-replace-string + vhdl-actual-generic-name port-name))) + (setq type (replace-match constant-name t nil type)) + (setq pos (match-end 0))) + (setq generic-list (cdr generic-list)))) + (insert " : " type) ;; paste initialization (inputs only) (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) (insert " := " @@ -12411,77 +12665,6 @@ expressions (e.g. for index ranges of types and signals)." try-expand-list-all-buffers))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Case fixing - -(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) - "Convert all words matching WORD-REGEXP in region to lower or upper case, -depending on parameter UPPER-CASE." - (let ((case-replace nil) - (last-update 0)) - (vhdl-prepare-search-2 - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char beg) - (while (re-search-forward word-regexp end t) - (or (vhdl-in-literal) - (if upper-case - (upcase-word -1) - (downcase-word -1))) - (when (and count vhdl-progress-interval (not noninteractive) - (< vhdl-progress-interval - (- (nth 1 (current-time)) last-update))) - (message "Fixing case... (%2d%s)" - (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) - "%") - (setq last-update (nth 1 (current-time))))) - (goto-char end))))) - -(defun vhdl-fix-case-region (beg end &optional arg) - "Convert all VHDL words in region to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-types vhdl-types-regexp 1) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-constants vhdl-constants-regexp 4) - (when vhdl-progress-interval (message "Fixing case...done"))) - -(defun vhdl-fix-case-buffer () - "Convert all VHDL words in buffer to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive) - (vhdl-fix-case-region (point-min) (point-max))) - -(defun vhdl-fix-case-word (&optional arg) - "Convert word after cursor to upper case if necessary." - (interactive "p") - (save-excursion - (when arg (backward-word 1)) - (vhdl-prepare-search-1 - (when (and vhdl-upper-case-keywords - (looking-at vhdl-keywords-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-types - (looking-at vhdl-types-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-attributes - (looking-at vhdl-attributes-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-enum-values - (looking-at vhdl-enum-values-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-constants - (looking-at vhdl-constants-regexp)) - (upcase-word 1))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Line handling functions (defun vhdl-current-line () @@ -12635,7 +12818,7 @@ it works within comments too." ;; print results (message "\n\ File statistics: \"%s\"\n\ ----------------------\n\ +-----------------------\n\ # statements : %5d\n\ # code lines : %5d\n\ # empty lines : %5d\n\ @@ -13486,9 +13669,9 @@ hierarchy otherwise.") (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) (equal "USE" (upcase (match-string 1)))) (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") - (setq lib-alist (cons (cons (match-string-no-properties 1) + (push (cons (match-string-no-properties 1) (vhdl-match-string-downcase 2)) - lib-alist)))))) + lib-alist))))) lib-alist)) (defun vhdl-scan-directory-contents (name &optional project update num-string @@ -13534,7 +13717,7 @@ hierarchy otherwise.") file-tmp-list) (while file-list (unless (string-match file-exclude-regexp (car file-list)) - (setq file-tmp-list (cons (car file-list) file-tmp-list))) + (push (car file-list) file-tmp-list)) (setq file-list (cdr file-list))) (setq file-list (nreverse file-tmp-list)))) ;; do for all files @@ -13569,7 +13752,7 @@ hierarchy otherwise.") "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" ent-name (nth 1 ent-entry) (nth 2 ent-entry) file-name (vhdl-current-line)) - (setq ent-list (cons ent-key ent-list)) + (push ent-key ent-list) (aput 'ent-alist ent-key (list ent-name file-name (vhdl-current-line) (nth 3 ent-entry) (nth 4 ent-entry) @@ -13621,7 +13804,7 @@ hierarchy otherwise.") "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" conf-name ent-name (nth 1 conf-entry) (nth 2 conf-entry) file-name conf-line) - (setq conf-list (cons conf-key conf-list)) + (push conf-key conf-list) ;; scan for subconfigurations and subentities (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t) (setq inst-comp-key (vhdl-match-string-downcase 3) @@ -13684,8 +13867,8 @@ hierarchy otherwise.") (setq func-alist (nreverse func-alist)) (setq comp-alist (nreverse comp-alist)) (if is-body - (setq pack-body-list (cons pack-key pack-body-list)) - (setq pack-list (cons pack-key pack-list))) + (push pack-key pack-body-list) + (push pack-key pack-list)) (aput 'pack-alist pack-key (if is-body @@ -13939,7 +14122,7 @@ of PROJECT." (let ((case-fold-search nil)) (while dir-list (unless (string-match file-exclude-regexp (car dir-list)) - (setq dir-list-tmp (cons (car dir-list) dir-list-tmp))) + (push (car dir-list) dir-list-tmp)) (setq dir-list (cdr dir-list))) (setq dir-list (nreverse dir-list-tmp)))) (message "Collecting source files...done") @@ -14331,7 +14514,7 @@ if required." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Add hierarchy browser functionality to speedbar -(defvar vhdl-speedbar-key-map nil +(defvar vhdl-speedbar-mode-map nil "Keymap used when in the VHDL hierarchy browser mode.") (defvar vhdl-speedbar-menu-items nil @@ -14359,24 +14542,24 @@ if required." (speedbar-item-info . vhdl-speedbar-item-info) (speedbar-line-directory . vhdl-speedbar-line-project))) ;; keymap - (unless vhdl-speedbar-key-map - (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches) + (unless vhdl-speedbar-mode-map + (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) + (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) (let ((key 0)) (while (<= key 9) - (define-key vhdl-speedbar-key-map (int-to-string key) + (define-key vhdl-speedbar-mode-map (int-to-string key) `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) (setq key (1+ key))))) (define-key speedbar-mode-map "h" @@ -14429,10 +14612,10 @@ if required." ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) ;; hook-ups (speedbar-add-expansion-list - '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-directory)) (speedbar-add-expansion-list - '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-projects)) (setq speedbar-stealthy-function-list (append @@ -14719,15 +14902,15 @@ otherwise use cached data." (setq arch-alist (nth 4 (car ent-alist))) (setq subunit-alist nil) (while arch-alist - (setq subunit-alist (cons (caar arch-alist) subunit-alist)) + (push (caar arch-alist) subunit-alist) (setq arch-alist (cdr arch-alist))) - (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist)) + (push (list (caar ent-alist) subunit-alist) unit-alist) (setq ent-alist (cdr ent-alist))) (while conf-alist - (setq unit-alist (cons (list (caar conf-alist)) unit-alist)) + (push (list (caar conf-alist)) unit-alist) (setq conf-alist (cdr conf-alist))) (while pack-alist - (setq unit-alist (cons (list (caar pack-alist)) unit-alist)) + (push (list (caar pack-alist)) unit-alist) (setq pack-alist (cdr pack-alist))) (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (vhdl-speedbar-refresh) @@ -15367,7 +15550,7 @@ NO-POSITION non-nil means do not re-position cursor." (concat (speedbar-line-directory indent) token)))) (while oldl (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) - (setq newl (cons (car oldl) newl))) + (push (car oldl) newl)) (setq oldl (cdr oldl))) (setq speedbar-shown-directories (nreverse newl))) (speedbar-change-expand-button-char ?+) @@ -15474,7 +15657,7 @@ NO-POSITION non-nil means do not re-position cursor." (setq dir (car path-list)) (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) (if (file-directory-p (match-string 2 dir)) - (setq path-list-1 (cons dir path-list-1)) + (push dir path-list-1) (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) (setq path-list (cdr path-list))) ;; resolve path wildcards @@ -15496,13 +15679,13 @@ NO-POSITION non-nil means do not re-position cursor." dir-list) (while all-list (when (file-directory-p (car all-list)) - (setq dir-list (cons (car all-list) dir-list))) + (push (car all-list) dir-list)) (setq all-list (cdr all-list))) dir-list)) (cdr path-list-1)))) (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) (when (file-directory-p (match-string 2 dir)) - (setq path-list-2 (cons dir path-list-2))) + (push dir path-list-2)) (setq path-list-1 (cdr path-list-1)))) (nreverse path-list-2))) @@ -15527,8 +15710,7 @@ is already shown in a buffer." (let ((buffer (get-file-buffer (car token)))) (speedbar-find-file-in-frame (car token)) (when (or vhdl-speedbar-jump-to-unit buffer) - (goto-char (point-min)) - (forward-line (1- (cdr token))) + (vhdl-goto-line (cdr token)) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) @@ -15546,8 +15728,7 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) + (progn (vhdl-goto-line (cdr token)) (end-of-line) (if is-entity (vhdl-port-copy) @@ -16000,7 +16181,7 @@ component instantiation." (or (aget generic-alist (match-string 2) t) (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar generic-alist)))) - (setq constant-alist (cons constant-entry constant-alist)) + (push constant-entry constant-alist) (setq constant-name (downcase constant-name)) (if (or (member constant-name single-list) (member constant-name multi-list)) @@ -16020,7 +16201,7 @@ component instantiation." (or (aget port-alist (match-string 2) t) (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar port-alist)))) - (setq signal-alist (cons signal-entry signal-alist)) + (push signal-entry signal-alist) (setq signal-name (downcase signal-name)) (if (equal (upcase (nth 2 signal-entry)) "IN") ;; input signal @@ -16054,8 +16235,8 @@ component instantiation." (unless (match-string 1) (setq port-alist (cdr port-alist))) (vhdl-forward-syntactic-ws)) - (setq inst-alist (cons (list inst-name (nreverse constant-alist) - (nreverse signal-alist)) inst-alist))) + (push (list inst-name (nreverse constant-alist) + (nreverse signal-alist)) inst-alist)) ;; prepare signal insertion (vhdl-goto-marker arch-decl-pos) (forward-line 1) @@ -16122,6 +16303,7 @@ component instantiation." (while constant-alist (setq constant-name (downcase (caar constant-alist)) constant-entry (car constant-alist)) + (unless (string-match "^[0-9]+" constant-name) (cond ((member constant-name written-list) nil) ((member constant-name multi-list) @@ -16138,7 +16320,7 @@ component instantiation." (setq generic-end-pos (vhdl-compose-insert-generic constant-entry)) (setq generic-inst-pos (point-marker)) - (add-to-list 'written-list constant-name))) + (add-to-list 'written-list constant-name)))) (setq constant-alist (cdr constant-alist))) (when (/= constant-temp-pos generic-inst-pos) (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) @@ -16298,8 +16480,7 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) + (progn (vhdl-goto-line (nth 3 (car ent-alist))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) @@ -16555,12 +16736,12 @@ no project is defined." (setq sublist (nth 11 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons (list (nth 0 sublist) - (if (= 0 (nth 1 sublist)) - (if (featurep 'xemacs) 9 nil) + (push (list (nth 0 sublist) + (if (and (featurep 'xemacs) (not (nth 1 sublist))) + 9 (nth 1 sublist)) (nth 2 sublist) (nth 3 sublist)) - regexp-alist))) + regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-error-regexp-alist (append compilation-error-regexp-alist (nreverse regexp-alist)))) @@ -16573,7 +16754,7 @@ no project is defined." (setq sublist (nth 12 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons sublist regexp-alist))) + (push sublist regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-file-regexp-alist (append compilation-file-regexp-alist (nreverse regexp-alist)))))) @@ -16702,6 +16883,42 @@ specified by a target." (compile (concat (if (equal command "") "make" command) " " options " " vhdl-make-target)))) +;; Emacs 22+ setup +(defvar vhdl-error-regexp-emacs-alist + ;; Get regexps from `vhdl-compiler-alist' + (let ((compiler-alist vhdl-compiler-alist) + (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) + (while compiler-alist + ;; add error message regexps + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) + (nth 11 (car compiler-alist))) + error-regexp-alist)) + ;; add filename regexps + (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) + (nth 12 (car compiler-alist))) + error-regexp-alist))) + (setq compiler-alist (cdr compiler-alist))) + error-regexp-alist) + "List of regexps for VHDL compilers. For Emacs 22+.") + +;; Add error regexps using compilation-mode-hook. +(defun vhdl-error-regexp-add-emacs () + "Set up Emacs compile for VHDL." + (interactive) + (when (and (boundp 'compilation-error-regexp-alist-alist) + (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) + (mapcar + (lambda (item) + (push (car item) compilation-error-regexp-alist) + (push item compilation-error-regexp-alist-alist)) + vhdl-error-regexp-emacs-alist))) + +(when vhdl-emacs-22 + (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -16724,7 +16941,7 @@ specified by a target." (let (pack-list) (while lib-alist (when (equal (downcase (caar lib-alist)) (downcase work-library)) - (setq pack-list (cons (cdar lib-alist) pack-list))) + (push (cdar lib-alist) pack-list)) (setq lib-alist (cdr lib-alist))) pack-list)) @@ -16776,8 +16993,10 @@ specified by a target." (setq ent-entry (car ent-alist) ent-key (nth 0 ent-entry)) (when (nth 2 ent-entry) - (setq ent-file-name (file-relative-name - (nth 2 ent-entry) compile-directory) + (setq ent-file-name (if vhdl-compile-absolute-path + (nth 2 ent-entry) + (file-relative-name (nth 2 ent-entry) + compile-directory)) arch-alist (nth 4 ent-entry) lib-alist (nth 6 ent-entry) rule (aget rule-alist ent-file-name) @@ -16787,9 +17006,9 @@ specified by a target." subcomp-list nil) (setq tmp-key (vhdl-replace-string ent-regexp (funcall adjust-case ent-key))) - (setq unit-list (cons (cons ent-key tmp-key) unit-list)) + (push (cons ent-key tmp-key) unit-list) ;; rule target for this entity - (setq target-list (cons ent-key target-list)) + (push ent-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16801,8 +17020,10 @@ specified by a target." (setq arch-entry (car arch-alist) arch-key (nth 0 arch-entry) ent-arch-key (concat ent-key "-" arch-key) - arch-file-name (file-relative-name (nth 2 arch-entry) - compile-directory) + arch-file-name (if vhdl-compile-absolute-path + (nth 2 arch-entry) + (file-relative-name (nth 2 arch-entry) + compile-directory)) inst-alist (nth 4 arch-entry) lib-alist (nth 5 arch-entry) rule (aget rule-alist arch-file-name) @@ -16813,11 +17034,11 @@ specified by a target." (funcall adjust-case (concat arch-key " " ent-key)))) (setq unit-list (cons (cons ent-arch-key tmp-key) unit-list)) - (setq second-list (cons ent-arch-key second-list)) + (push ent-arch-key second-list) ;; rule target for this architecture - (setq target-list (cons ent-arch-key target-list)) + (push ent-arch-key target-list) ;; rule dependency for corresponding entity - (setq depend-list (cons ent-key depend-list)) + (push ent-key depend-list) ;; rule dependencies for contained component instantiations (while inst-alist (setq inst-entry (car inst-alist)) @@ -16835,9 +17056,8 @@ specified by a target." ;; add rule (aput 'rule-alist arch-file-name (list target-list depend-list)) (setq arch-alist (cdr arch-alist))) - (setq prim-list (cons (list ent-key second-list - (append subcomp-list all-pack-list)) - prim-list))) + (push (list ent-key second-list (append subcomp-list all-pack-list)) + prim-list)) (setq ent-alist (cdr ent-alist))) (setq ent-alist tmp-list) ;; rules for all configurations @@ -16845,8 +17065,10 @@ specified by a target." (while conf-alist (setq conf-entry (car conf-alist) conf-key (nth 0 conf-entry) - conf-file-name (file-relative-name - (nth 2 conf-entry) compile-directory) + conf-file-name (if vhdl-compile-absolute-path + (nth 2 conf-entry) + (file-relative-name (nth 2 conf-entry) + compile-directory)) ent-key (nth 4 conf-entry) arch-key (nth 5 conf-entry) inst-alist (nth 6 conf-entry) @@ -16857,9 +17079,9 @@ specified by a target." subcomp-list (list ent-key)) (setq tmp-key (vhdl-replace-string conf-regexp (funcall adjust-case conf-key))) - (setq unit-list (cons (cons conf-key tmp-key) unit-list)) + (push (cons conf-key tmp-key) unit-list) ;; rule target for this configuration - (setq target-list (cons conf-key target-list)) + (push conf-key target-list) ;; rule dependency for corresponding entity and architecture (setq depend-list (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) @@ -16877,16 +17099,14 @@ specified by a target." (setq depend-list (cons inst-ent-key depend-list) subcomp-list (cons inst-ent-key subcomp-list))) ; (when comp-arch-key -; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key) -; depend-list))) +; (push (concat comp-ent-key "-" comp-arch-key) depend-list)) (when inst-conf-key (setq depend-list (cons inst-conf-key depend-list) subcomp-list (cons inst-conf-key subcomp-list)))) (setq inst-alist (cdr inst-alist))) ;; add rule (aput 'rule-alist conf-file-name (list target-list depend-list)) - (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list)) - prim-list)) + (push (list conf-key nil (append subcomp-list pack-list)) prim-list) (setq conf-alist (cdr conf-alist))) (setq conf-alist tmp-list) ;; rules for all packages @@ -16896,16 +17116,18 @@ specified by a target." pack-key (nth 0 pack-entry) pack-body-key nil) (when (nth 2 pack-entry) - (setq pack-file-name (file-relative-name (nth 2 pack-entry) - compile-directory) + (setq pack-file-name (if vhdl-compile-absolute-path + (nth 2 pack-entry) + (file-relative-name (nth 2 pack-entry) + compile-directory)) lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) rule (aget rule-alist pack-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string pack-regexp (funcall adjust-case pack-key))) - (setq unit-list (cons (cons pack-key tmp-key) unit-list)) + (push (cons pack-key tmp-key) unit-list) ;; rule target for this package - (setq target-list (cons pack-key target-list)) + (push pack-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16915,8 +17137,10 @@ specified by a target." ;; rules for this package's body (when (nth 7 pack-entry) (setq pack-body-key (concat pack-key "-body") - pack-body-file-name (file-relative-name (nth 7 pack-entry) - compile-directory) + pack-body-file-name (if vhdl-compile-absolute-path + (nth 7 pack-entry) + (file-relative-name (nth 7 pack-entry) + compile-directory)) rule (aget rule-alist pack-body-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) @@ -16925,9 +17149,9 @@ specified by a target." (setq unit-list (cons (cons pack-body-key tmp-key) unit-list)) ;; rule target for this package's body - (setq target-list (cons pack-body-key target-list)) + (push pack-body-key target-list) ;; rule dependency for corresponding package declaration - (setq depend-list (cons pack-key depend-list)) + (push pack-key depend-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-body-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -17050,16 +17274,16 @@ specified by a target." (unless (equal unit-key unit-name) (insert " \\\n" unit-name)) (insert " :" - " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) - " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") - (while second-list - (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") - (setq second-list (cdr second-list))) + " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) (while subcomp-list (when (and (assoc (car subcomp-list) unit-list) (not (equal unit-key (car subcomp-list)))) (insert " \\\n\t\t" (car subcomp-list))) (setq subcomp-list (cdr subcomp-list))) + (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") + (while second-list + (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") + (setq second-list (cdr second-list))) (insert "\n") (setq prim-list (cdr prim-list))) ;; insert rule for each library unit file @@ -17198,6 +17422,7 @@ specified by a target." 'vhdl-include-direction-comments 'vhdl-include-type-comments 'vhdl-include-group-comments + 'vhdl-actual-generic-name 'vhdl-actual-port-name 'vhdl-instance-name 'vhdl-testbench-entity-name @@ -17280,13 +17505,21 @@ specified by a target." (defconst vhdl-doc-release-notes nil "\ -Release Notes for VHDL Mode 3.33 +Release Notes for VHDL Mode 3.34 ================================ - - New Features - - User Options +- Added support for GNU Emacs 22/23/24: + - Compilation error parsing fixed for new `compile.el' package. + +- Port translation: Derive actual generic name from formal generic name. + +- New user options: + `vhdl-actual-generic-name': Specify how actual generic names are obtained. +Release Notes for VHDL Mode 3.33 +================================ + New Features ------------ diff --git a/lisp/shell.el b/lisp/shell.el index d09d7aee43f..51a0ffc4fe8 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -111,9 +111,10 @@ "Directory support in shell mode." :group 'shell) -(defgroup shell-faces nil - "Faces in shell buffers." - :group 'shell) +;; Unused. +;;; (defgroup shell-faces nil +;;; "Faces in shell buffers." +;;; :group 'shell) ;;;###autoload (defcustom shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") diff --git a/lisp/simple.el b/lisp/simple.el index e4bde7c358c..f81b02b0acf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -380,12 +380,18 @@ Other major modes are defined by comparison with this one." map) "Keymap used for programming modes.") -(defun prog-indent-sexp () - "Indent the expression after point." - (interactive) - (let ((start (point)) - (end (save-excursion (forward-sexp 1) (point)))) - (indent-region start end nil))) +(defun prog-indent-sexp (&optional defun) + "Indent the expression after point. +When interactively called with prefix, indent the enclosing defun +instead." + (interactive "P") + (save-excursion + (when defun + (end-of-line) + (beginning-of-defun)) + (let ((start (point)) + (end (progn (forward-sexp 1) (point)))) + (indent-region start end nil)))) (define-derived-mode prog-mode fundamental-mode "Prog" "Major mode for editing programming language source code." diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 782924086df..2453f479eda 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -46,6 +46,7 @@ With a prefix argument ARG, switch to 132-column mode if ARG is positive, and 80-column mode otherwise. If called from Lisp, switch to 132-column mode if ARG is omitted or nil." :global t :init-value (= (frame-width) 132) + :group 'terminals (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index da437c178b6..05a129225ee 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -27,7 +27,7 @@ (defgroup xterm nil "XTerm support." :version "24.1" - :group 'environment) + :group 'terminals) (defcustom xterm-extra-capabilities 'check "Whether Xterm supports some additional, more modern, features. diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index f6a2c7eca05..ebbc6ee0afb 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -83,9 +83,10 @@ ;;; Code: -(defgroup refill nil - "Refilling paragraphs on changes." - :group 'fill) +;; Unused. +;;; (defgroup refill nil +;;; "Refilling paragraphs on changes." +;;; :group 'fill) (defvar refill-ignorable-overlay nil "Portion of the most recently filled paragraph not needing filling. @@ -222,7 +223,8 @@ characters only cause refilling if they would cause auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead." - :group 'refill + ;; Not global, so no effect. +;;; :group 'refill :lighter " Refill" :keymap '(("\177" . backward-delete-char-untabify)) ;; Remove old state if necessary diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index b3503c6c982..01981175e1d 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3932,7 +3932,7 @@ string)) to be used for converting the document." (choice :tag "Command options" (const :tag "No options" nil) (string :tag "Options")))) - :group 'rst + :group 'rst-compile :package-version "1.2.0") (rst-testcover-defcustom) diff --git a/lisp/type-break.el b/lisp/type-break.el index e4fa02f9fe6..b4e4be31955 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -418,7 +418,7 @@ Variables controlling the display of messages in the mode line include: `global-mode-string' `type-break-mode-line-break-message' `type-break-mode-line-warning'" - :global t) + :global t :group 'type-break) (define-minor-mode type-break-query-mode "Toggle typing break queries. @@ -428,7 +428,7 @@ enable them if ARG is omitted or nil. The user may also enable or disable this mode simply by setting the variable of the same name." - :global t) + :global t :group 'type-break) ;;; session file functions diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f8f24de6b68..4c63c548f79 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,7 @@ +2013-05-15 Glenn Morris <rgm@gnu.org> + + * url-news.el (url-news): Remove empty custom group. + 2013-02-16 Glenn Morris <rgm@gnu.org> * url-http.el (url-http-wait-for-headers-change-function): diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 391974d79f8..d4532626183 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -28,9 +28,10 @@ (autoload 'url-warn "url") (autoload 'gnus-group-read-ephemeral-group "gnus-group") -(defgroup url-news nil - "News related options." - :group 'url) +;; Unused. +;;; (defgroup url-news nil +;;; "News related options." +;;; :group 'url) (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 45a30afda70..be6d4c91c50 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -98,6 +98,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], -W \ -Wabi \ -Waddress \ + -Waggressive-loop-optimizations \ -Wall \ -Warray-bounds \ -Wattributes \ @@ -125,7 +126,6 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], -Wformat-security \ -Wformat-y2k \ -Wformat-zero-length \ - -Wformat=2 \ -Wfree-nonheap-object \ -Wignored-qualifiers \ -Wimplicit \ @@ -143,9 +143,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], -Wmissing-braces \ -Wmissing-declarations \ -Wmissing-field-initializers \ - -Wmissing-format-attribute \ -Wmissing-include-dirs \ - -Wmissing-noreturn \ -Wmissing-parameter-type \ -Wmissing-prototypes \ -Wmudflap \ @@ -166,6 +164,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], -Wpointer-sign \ -Wpointer-to-int-cast \ -Wpragmas \ + -Wreturn-local-addr \ -Wreturn-type \ -Wsequence-point \ -Wshadow \ @@ -187,7 +186,6 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], -Wtype-limits \ -Wuninitialized \ -Wunknown-pragmas \ - -Wunreachable-code \ -Wunsafe-loop-optimizations \ -Wunused \ -Wunused-but-set-parameter \ diff --git a/m4/warnings.m4 b/m4/warnings.m4 index 4b2ac385019..184873283bb 100644 --- a/m4/warnings.m4 +++ b/m4/warnings.m4 @@ -1,4 +1,4 @@ -# warnings.m4 serial 7 +# warnings.m4 serial 8 dnl Copyright (C) 2008-2013 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -27,7 +27,7 @@ AC_DEFUN([gl_COMPILER_OPTION_IF], AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [ gl_save_compiler_FLAGS="$gl_Flags" - gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $1"]) + gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $gl_unknown_warnings_are_errors $1"]) AC_COMPILE_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])], [AS_VAR_SET(gl_Warn, [yes])], [AS_VAR_SET(gl_Warn, [no])]) @@ -38,6 +38,14 @@ AS_VAR_POPDEF([gl_Flags])dnl AS_VAR_POPDEF([gl_Warn])dnl ]) +# gl_UNKNOWN_WARNINGS_ARE_ERRORS +# ------------------------------ +# Clang doesn't complain about unknown warning options unless one also +# specifies -Wunknown-warning-option -Werror. Detect this. +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS], +[gl_COMPILER_OPTION_IF([-Werror -Wunknown-warning-option], + [gl_unknown_warnings_are_errors='-Wunknown-warning-option -Werror'], + [gl_unknown_warnings_are_errors=])]) # gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS], # [PROGRAM = AC_LANG_PROGRAM()]) @@ -47,7 +55,8 @@ AS_VAR_POPDEF([gl_Warn])dnl # # If VARIABLE is a variable name, AC_SUBST it. AC_DEFUN([gl_WARN_ADD], -[gl_COMPILER_OPTION_IF([$1], +[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS]) +gl_COMPILER_OPTION_IF([$1], [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])], [], [$3]) diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 87a135cad2d..0214b6bc98b 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,7 @@ +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * sed1x.inp: Don't rewrite DOC any more. + 2013-02-08 Paul Eggert <eggert@cs.ucla.edu> * sedlibmk.inp: Sync with changes in lib/Makefile.in. diff --git a/msdos/sed1x.inp b/msdos/sed1x.inp index 9134bc73d28..dacfee6d385 100644 --- a/msdos/sed1x.inp +++ b/msdos/sed1x.inp @@ -17,7 +17,7 @@ # ---------------------------------------------------------------------- s!^ cd \${oldXMenudir}; \${MAKE}.*$! ${MAKE} -C ${oldXMenudir}.! s!^ @true *$! @rem! -s/DOC/DOC-X/g +#s/DOC/DOC-X/g /^OLDXMENU *=/s!=.*!= ${oldXMenudir}libXMenu11.a! /^LIBXMENU *=/s!= *!= ${OLDXMENU}! /^LIBX_OTHER *=/s!= *!= ${LIBXT} ${LIBX_EXTRA}! diff --git a/nt/ChangeLog b/nt/ChangeLog index 2a602be59c9..b66871e319b 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * makefile.w32-in (clean, top-distclean): DOC-X doesn't exist any more. + 2013-05-08 Juanma Barranquero <lekktu@gmail.com> * config.nt: Sync with autogen/config.in. diff --git a/nt/README.W32 b/nt/README.W32 index 19c148bbf0b..a2881ce1914 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -29,7 +29,7 @@ See the end of the file for license conditions. Along with this file should be six subdirectories (bin, etc, info, lisp, leim, site-lisp). If you have downloaded the barebin distribution, then it will contain only the bin directory and the - built in documentation in etc/DOC-X, the rest of the subdirectories + built in documentation in etc/DOC, the rest of the subdirectories are in the src distribution, which the barebin distribution is designed to be used with. diff --git a/nt/makefile.w32-in b/nt/makefile.w32-in index 0c2f6324188..79ca22bf44e 100644 --- a/nt/makefile.w32-in +++ b/nt/makefile.w32-in @@ -315,7 +315,7 @@ clean: clean-other-dirs-$(MAKETYPE) - $(DEL) $(COMPILER_TEMP_FILES) - $(DEL_TREE) $(OBJDIR) - $(DEL) stamp_BLD - - $(DEL) ../etc/DOC ../etc/DOC-X + - $(DEL) ../etc/DOC clean-other-dirs-nmake: cd ..\lib @@ -375,7 +375,7 @@ top-distclean: - $(DEL_TREE) oo - $(DEL_TREE) oo-spd - $(DEL) stamp_BLD - - $(DEL) ../etc/DOC ../etc/DOC-X + - $(DEL) ../etc/DOC - $(DEL) config.log Makefile - $(DEL) ../README.W32 diff --git a/src/ChangeLog b/src/ChangeLog index 0b4ccb0708a..c45ec824919 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,33 @@ 2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + * makefile.w32-in (DOC): Use just "DOC". + + * Makefile.in (bootstrap-clean): DOC-* doesn't exist any more. + + * process.c: Export default filters and sentinels to Elisp. + (Qinternal_default_process_sentinel, Qinternal_default_process_filter): + New constants. + (pset_filter, pset_sentinel, make_process, Fset_process_filter) + (Fset_process_sentinel, Fformat_network_address): + Default to them instead of nil. + (server_accept_connection): Sentinels can't be nil any more. + (read_and_dispose_of_process_output): New function, extracted from + read_process_output. + (read_process_output): Use it; filters can't be nil. + (Finternal_default_process_filter): New function, extracted from + read_process_output. + (exec_sentinel_unwind): Remove function. + (exec_sentinel): Don't zilch sentinel while running. + (status_notify): Sentinels can't be nil. + (Finternal_default_process_sentinel): New function extracted from + status_notify. + (setup_process_coding_systems): Default filter is not nil any more. + (syms_of_process): Export new Elisp functions and initialize + new constants. + * lisp.h (make_lisp_proc): New function. + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + * regex.c (regex_compile) [\=, \>, \<]: Don't forget to set laststart. 2013-05-14 Eli Zaretskii <eliz@gnu.org> diff --git a/src/Makefile.in b/src/Makefile.in index 2e1764723ec..c7a18363a5a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -555,7 +555,7 @@ clean: mostlyclean ## It should remove all files generated during a compilation/bootstrap, ## but not things like config.status or TAGS. bootstrap-clean: clean - rm -f epaths.h config.h config.stamp stamp-h1 stamp-oldxmenu ../etc/DOC-* + rm -f epaths.h config.h config.stamp stamp-h1 stamp-oldxmenu if test -f ./.gdbinit; then \ mv ./.gdbinit ./.gdbinit.save; \ if test -f "$(srcdir)/.gdbinit"; then rm -f ./.gdbinit.save; \ diff --git a/src/doc.c b/src/doc.c index 770cb1eb646..e45481944f0 100644 --- a/src/doc.c +++ b/src/doc.c @@ -58,7 +58,7 @@ read_bytecode_char (bool unreadflag) } /* Extract a doc string from a file. FILEPOS says where to get it. - If it is an integer, use that position in the standard DOC-... file. + If it is an integer, use that position in the standard DOC file. If it is (FILE . INTEGER), use FILE as the file name and INTEGER as the position in that file. But if INTEGER is negative, make it positive. @@ -608,7 +608,7 @@ the same file name is found in the `doc-directory'. */) while (*beg && c_isspace (*beg)) ++beg; for (end = beg; *end && ! c_isspace (*end); ++end) - if (*end == '/') beg = end+1; /* skip directory part */ + if (*end == '/') beg = end + 1; /* Skip directory part. */ len = end - beg; if (len > 4 && end[-4] == '.' && end[-3] == 'o') diff --git a/src/lisp.h b/src/lisp.h index e2c24eed352..79d32c90f73 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -585,10 +585,12 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) /* Pseudovector types. */ - +struct Lisp_Process; +LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p) +{ return make_lisp_ptr (p, Lisp_Vectorlike); } #define XPROCESS(a) (eassert (PROCESSP (a)), \ (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) -#define XWINDOW(a) (eassert (WINDOWP (a)), \ +#define XWINDOW(a) (eassert (WINDOWP (a)), \ (struct window *) XUNTAG (a, Lisp_Vectorlike)) #define XTERMINAL(a) (eassert (TERMINALP (a)), \ (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) diff --git a/src/lread.c b/src/lread.c index 15821662fc8..3ca644bb45b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3557,7 +3557,7 @@ read_list (bool flag, Lisp_Object readcharfun) { if (NILP (Vdoc_file_name)) /* We have not yet called Snarf-documentation, so assume - this file is described in the DOC-MM.NN file + this file is described in the DOC file and Snarf-documentation will fill in the right value later. For now, replace the whole list with 0. */ doc_reference = 1; diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 3484d6c70c8..272b053ed12 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -41,7 +41,7 @@ TRES = $(BLD)/emacs.res TLASTLIB = $(BLD)/lastfile.$(A) GNULIB = ../lib/$(BLD)/libgnu.$(A) -DOC = $(OBJDIR)/etc/DOC-X +DOC = $(OBJDIR)/etc/DOC FULL_LINK_FLAGS = $(LINK_FLAGS) $(TEMACS_EXTRA_LINK) diff --git a/src/process.c b/src/process.c index 911a30bc808..46385fa096b 100644 --- a/src/process.c +++ b/src/process.c @@ -174,6 +174,8 @@ static Lisp_Object QClocal, QCremote, QCcoding; static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; static Lisp_Object QCsentinel, QClog, QCoptions, QCplist; static Lisp_Object Qlast_nonmenu_event; +static Lisp_Object Qinternal_default_process_sentinel; +static Lisp_Object Qinternal_default_process_filter; #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork)) #define NETCONN1_P(p) (EQ (p->type, Qnetwork)) @@ -359,7 +361,7 @@ pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val) static void pset_filter (struct Lisp_Process *p, Lisp_Object val) { - p->filter = val; + p->filter = NILP (val) ? Qinternal_default_process_filter : val; } static void pset_log (struct Lisp_Process *p, Lisp_Object val) @@ -384,7 +386,7 @@ pset_plist (struct Lisp_Process *p, Lisp_Object val) static void pset_sentinel (struct Lisp_Process *p, Lisp_Object val) { - p->sentinel = val; + p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val; } static void pset_status (struct Lisp_Process *p, Lisp_Object val) @@ -700,6 +702,8 @@ make_process (Lisp_Object name) } name = name1; pset_name (p, name); + pset_sentinel (p, Qinternal_default_process_sentinel); + pset_filter (p, Qinternal_default_process_filter); XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; @@ -979,10 +983,10 @@ DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 2, 2, 0, - doc: /* Give PROCESS the filter function FILTER; nil means no filter. + doc: /* Give PROCESS the filter function FILTER; nil means default. A value of t means stop accepting output from the process. -When a process has a filter, its buffer is not used for output. +When a process has a non-default filter, its buffer is not used for output. Instead, each time it does output, the entire string of output is passed to the filter. @@ -1008,6 +1012,9 @@ The string argument is normally a multibyte string, except: (debug) (set-process-filter process ...) */ + if (NILP (filter)) + filter = Qinternal_default_process_filter; + if (p->infd >= 0) { if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) @@ -1033,7 +1040,7 @@ The string argument is normally a multibyte string, except: DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, 1, 1, 0, - doc: /* Returns the filter function of PROCESS; nil if none. + doc: /* Return the filter function of PROCESS. See `set-process-filter' for more info on filter functions. */) (register Lisp_Object process) { @@ -1043,7 +1050,7 @@ See `set-process-filter' for more info on filter functions. */) DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, 2, 2, 0, - doc: /* Give PROCESS the sentinel SENTINEL; nil for none. + doc: /* Give PROCESS the sentinel SENTINEL; nil for default. The sentinel is called as a function when the process changes state. It gets two arguments: the process, and a string describing the change. */) (register Lisp_Object process, Lisp_Object sentinel) @@ -1053,6 +1060,9 @@ It gets two arguments: the process, and a string describing the change. */) CHECK_PROCESS (process); p = XPROCESS (process); + if (NILP (sentinel)) + sentinel = Qinternal_default_process_sentinel; + pset_sentinel (p, sentinel); if (NETCONN1_P (p) || SERIALCONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel)); @@ -1061,7 +1071,7 @@ It gets two arguments: the process, and a string describing the change. */) DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, 1, 1, 0, - doc: /* Return the sentinel of PROCESS; nil if none. + doc: /* Return the sentinel of PROCESS. See `set-process-sentinel' for more info on sentinels. */) (register Lisp_Object process) { @@ -1378,8 +1388,8 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) pset_plist (XPROCESS (proc), Qnil); pset_type (XPROCESS (proc), Qreal); pset_buffer (XPROCESS (proc), buffer); - pset_sentinel (XPROCESS (proc), Qnil); - pset_filter (XPROCESS (proc), Qnil); + pset_sentinel (XPROCESS (proc), Qinternal_default_process_sentinel); + pset_filter (XPROCESS (proc), Qinternal_default_process_filter); pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2)); #ifdef HAVE_GNUTLS @@ -4039,7 +4049,8 @@ server_accept_connection (Lisp_Object server, int channel) process name of the server process concatenated with the caller identification. */ - if (!NILP (ps->filter) && !EQ (ps->filter, Qt)) + if (!(EQ (ps->filter, Qinternal_default_process_filter) + || EQ (ps->filter, Qt))) buffer = Qnil; else { @@ -4108,7 +4119,7 @@ server_accept_connection (Lisp_Object server, int channel) /* Setup coding system for new process based on server process. This seems to be the proper thing to do, as the coding system of the new process should reflect the settings at the time the - server socket was opened; not the current settings. */ + server socket was opened; not the current settings. */ pset_decode_coding_system (p, ps->decode_coding_system); pset_encode_coding_system (p, ps->encode_coding_system); @@ -4127,11 +4138,10 @@ server_accept_connection (Lisp_Object server, int channel) (STRINGP (host) ? host : build_string ("-")), build_string ("\n"))); - if (!NILP (p->sentinel)) - exec_sentinel (proc, - concat3 (build_string ("open from "), - (STRINGP (host) ? host : build_string ("-")), - build_string ("\n"))); + exec_sentinel (proc, + concat3 (build_string ("open from "), + (STRINGP (host) ? host : build_string ("-")), + build_string ("\n"))); } /* This variable is different from waiting_for_input in keyboard.c. @@ -4263,8 +4273,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; - /* Compute time from now till when time limit is up */ - /* Exit if already run out */ + /* Compute time from now till when time limit is up. */ + /* Exit if already run out. */ if (nsecs < 0) { /* A negative timeout means @@ -4871,8 +4881,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, } } #endif /* NON_BLOCKING_CONNECT */ - } /* end for each file descriptor */ - } /* end while exit conditions not met */ + } /* End for each file descriptor. */ + } /* End while exit conditions not met. */ unbind_to (count, Qnil); @@ -4907,6 +4917,11 @@ read_process_output_error_handler (Lisp_Object error_val) return Qt; } +static void +read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, + ssize_t nbytes, + struct coding_system *coding); + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of decoded characters read. @@ -4923,9 +4938,7 @@ read_process_output (Lisp_Object proc, register int channel) { register ssize_t nbytes; char *chars; - register Lisp_Object outstream; register struct Lisp_Process *p = XPROCESS (proc); - register ptrdiff_t opoint; struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; int readmax = 4096; @@ -5013,122 +5026,144 @@ read_process_output (Lisp_Object proc, register int channel) friends don't expect current-buffer to be changed from under them. */ record_unwind_current_buffer (); - /* Read and dispose of the process output. */ - outstream = p->filter; - if (!NILP (outstream)) - { - Lisp_Object text; - bool outer_running_asynch_code = running_asynch_code; - int waiting = waiting_for_user_input_p; + read_and_dispose_of_process_output (p, chars, nbytes, coding); + + /* Handling the process output should not deactivate the mark. */ + Vdeactivate_mark = odeactivate; + + unbind_to (count, Qnil); + return nbytes; +} + +static void +read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, + ssize_t nbytes, + struct coding_system *coding) +{ + Lisp_Object outstream = p->filter; + Lisp_Object text; + bool outer_running_asynch_code = running_asynch_code; + int waiting = waiting_for_user_input_p; - /* No need to gcpro these, because all we do with them later - is test them for EQness, and none of them should be a string. */ + /* No need to gcpro these, because all we do with them later + is test them for EQness, and none of them should be a string. */ #if 0 - Lisp_Object obuffer, okeymap; - XSETBUFFER (obuffer, current_buffer); - okeymap = BVAR (current_buffer, keymap); + Lisp_Object obuffer, okeymap; + XSETBUFFER (obuffer, current_buffer); + okeymap = BVAR (current_buffer, keymap); #endif - /* We inhibit quit here instead of just catching it so that - hitting ^G when a filter happens to be running won't screw - it up. */ - specbind (Qinhibit_quit, Qt); - specbind (Qlast_nonmenu_event, Qt); - - /* In case we get recursively called, - and we already saved the match data nonrecursively, - save the same match data in safely recursive fashion. */ - if (outer_running_asynch_code) - { - Lisp_Object tem; - /* Don't clobber the CURRENT match data, either! */ - tem = Fmatch_data (Qnil, Qnil, Qnil); - restore_search_regs (); - record_unwind_save_match_data (); - Fset_match_data (tem, Qt); - } + /* We inhibit quit here instead of just catching it so that + hitting ^G when a filter happens to be running won't screw + it up. */ + specbind (Qinhibit_quit, Qt); + specbind (Qlast_nonmenu_event, Qt); - /* For speed, if a search happens within this code, - save the match data in a special nonrecursive fashion. */ - running_asynch_code = 1; + /* In case we get recursively called, + and we already saved the match data nonrecursively, + save the same match data in safely recursive fashion. */ + if (outer_running_asynch_code) + { + Lisp_Object tem; + /* Don't clobber the CURRENT match data, either! */ + tem = Fmatch_data (Qnil, Qnil, Qnil); + restore_search_regs (); + record_unwind_save_match_data (); + Fset_match_data (tem, Qt); + } - decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); - text = coding->dst_object; - Vlast_coding_system_used = CODING_ID_NAME (coding->id); - /* A new coding system might be found. */ - if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) - { - pset_decode_coding_system (p, Vlast_coding_system_used); + /* For speed, if a search happens within this code, + save the match data in a special nonrecursive fashion. */ + running_asynch_code = 1; - /* Don't call setup_coding_system for - proc_decode_coding_system[channel] here. It is done in - detect_coding called via decode_coding above. */ + decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); + text = coding->dst_object; + Vlast_coding_system_used = CODING_ID_NAME (coding->id); + /* A new coding system might be found. */ + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) + { + pset_decode_coding_system (p, Vlast_coding_system_used); - /* If a coding system for encoding is not yet decided, we set - it as the same as coding-system for decoding. + /* Don't call setup_coding_system for + proc_decode_coding_system[channel] here. It is done in + detect_coding called via decode_coding above. */ - But, before doing that we must check if - proc_encode_coding_system[p->outfd] surely points to a - valid memory because p->outfd will be changed once EOF is - sent to the process. */ - if (NILP (p->encode_coding_system) - && proc_encode_coding_system[p->outfd]) - { - pset_encode_coding_system - (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); - setup_coding_system (p->encode_coding_system, - proc_encode_coding_system[p->outfd]); - } - } + /* If a coding system for encoding is not yet decided, we set + it as the same as coding-system for decoding. - if (coding->carryover_bytes > 0) + But, before doing that we must check if + proc_encode_coding_system[p->outfd] surely points to a + valid memory because p->outfd will be changed once EOF is + sent to the process. */ + if (NILP (p->encode_coding_system) + && proc_encode_coding_system[p->outfd]) { - if (SCHARS (p->decoding_buf) < coding->carryover_bytes) - pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); - memcpy (SDATA (p->decoding_buf), coding->carryover, - coding->carryover_bytes); - p->decoding_carryover = coding->carryover_bytes; + pset_encode_coding_system + (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); + setup_coding_system (p->encode_coding_system, + proc_encode_coding_system[p->outfd]); } - if (SBYTES (text) > 0) - /* FIXME: It's wrong to wrap or not based on debug-on-error, and - sometimes it's simply wrong to wrap (e.g. when called from - accept-process-output). */ - internal_condition_case_1 (read_process_output_call, - Fcons (outstream, - Fcons (proc, Fcons (text, Qnil))), - !NILP (Vdebug_on_error) ? Qnil : Qerror, - read_process_output_error_handler); - - /* If we saved the match data nonrecursively, restore it now. */ - restore_search_regs (); - running_asynch_code = outer_running_asynch_code; + } - /* Restore waiting_for_user_input_p as it was - when we were called, in case the filter clobbered it. */ - waiting_for_user_input_p = waiting; + if (coding->carryover_bytes > 0) + { + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); + memcpy (SDATA (p->decoding_buf), coding->carryover, + coding->carryover_bytes); + p->decoding_carryover = coding->carryover_bytes; + } + if (SBYTES (text) > 0) + /* FIXME: It's wrong to wrap or not based on debug-on-error, and + sometimes it's simply wrong to wrap (e.g. when called from + accept-process-output). */ + internal_condition_case_1 (read_process_output_call, + Fcons (outstream, + Fcons (make_lisp_proc (p), + Fcons (text, Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + read_process_output_error_handler); + + /* If we saved the match data nonrecursively, restore it now. */ + restore_search_regs (); + running_asynch_code = outer_running_asynch_code; + + /* Restore waiting_for_user_input_p as it was + when we were called, in case the filter clobbered it. */ + waiting_for_user_input_p = waiting; #if 0 /* Call record_asynch_buffer_change unconditionally, because we might have changed minor modes or other things that affect key bindings. */ - if (! EQ (Fcurrent_buffer (), obuffer) - || ! EQ (current_buffer->keymap, okeymap)) -#endif - /* But do it only if the caller is actually going to read events. - Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make sit_for return). */ - if (waiting_for_user_input_p == -1) - record_asynch_buffer_change (); - } + if (! EQ (Fcurrent_buffer (), obuffer) + || ! EQ (current_buffer->keymap, okeymap)) +#endif + /* But do it only if the caller is actually going to read events. + Otherwise there's no need to make him wake up, and it could + cause trouble (for example it would make sit_for return). */ + if (waiting_for_user_input_p == -1) + record_asynch_buffer_change (); +} + +DEFUN ("internal-default-process-filter", Finternal_default_process_filter, + Sinternal_default_process_filter, 2, 2, 0, + doc: /* Function used as default process filter. */) + (Lisp_Object proc, Lisp_Object text) +{ + struct Lisp_Process *p; + ptrdiff_t opoint; - /* If no filter, write into buffer if it isn't dead. */ - else if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) + CHECK_PROCESS (proc); + p = XPROCESS (proc); + CHECK_STRING (text); + + if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) { Lisp_Object old_read_only; ptrdiff_t old_begv, old_zv; ptrdiff_t old_begv_byte, old_zv_byte; ptrdiff_t before, before_byte; ptrdiff_t opoint_byte; - Lisp_Object text; struct buffer *b; Fset_buffer (p->buffer); @@ -5161,31 +5196,6 @@ read_process_output (Lisp_Object proc, register int channel) if (! (BEGV <= PT && PT <= ZV)) Fwiden (); - decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt); - text = coding->dst_object; - Vlast_coding_system_used = CODING_ID_NAME (coding->id); - /* A new coding system might be found. See the comment in the - similar code in the previous `if' block. */ - if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) - { - pset_decode_coding_system (p, Vlast_coding_system_used); - if (NILP (p->encode_coding_system) - && proc_encode_coding_system[p->outfd]) - { - pset_encode_coding_system - (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); - setup_coding_system (p->encode_coding_system, - proc_encode_coding_system[p->outfd]); - } - } - if (coding->carryover_bytes > 0) - { - if (SCHARS (p->decoding_buf) < coding->carryover_bytes) - pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes)); - memcpy (SDATA (p->decoding_buf), coding->carryover, - coding->carryover_bytes); - p->decoding_carryover = coding->carryover_bytes; - } /* Adjust the multibyteness of TEXT to that of the buffer. */ if (NILP (BVAR (current_buffer, enable_multibyte_characters)) != ! STRING_MULTIBYTE (text)) @@ -5230,18 +5240,13 @@ read_process_output (Lisp_Object proc, register int channel) if (old_begv != BEGV || old_zv != ZV) Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - bset_read_only (current_buffer, old_read_only); SET_PT_BOTH (opoint, opoint_byte); } - /* Handling the process output should not deactivate the mark. */ - Vdeactivate_mark = odeactivate; - - unbind_to (count, Qnil); - return nbytes; + return Qnil; } -/* Sending data to subprocess */ +/* Sending data to subprocess. */ /* In send_process, when a write fails temporarily, wait_reading_process_output is called. It may execute user code, @@ -6188,13 +6193,6 @@ deliver_child_signal (int sig) static Lisp_Object -exec_sentinel_unwind (Lisp_Object data) -{ - pset_sentinel (XPROCESS (XCAR (data)), XCDR (data)); - return Qnil; -} - -static Lisp_Object exec_sentinel_error_handler (Lisp_Object error_val) { cmd_error_internal (error_val, "error in process sentinel: "); @@ -6231,13 +6229,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) record_unwind_current_buffer (); sentinel = p->sentinel; - if (NILP (sentinel)) - return; - /* Zilch the sentinel while it's running, to avoid recursive invocations; - assure that it gets restored no matter how the sentinel exits. */ - pset_sentinel (p, Qnil); - record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel)); /* Inhibit quit so that random quits don't screw up a running filter. */ specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */ @@ -6295,7 +6287,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) static void status_notify (struct Lisp_Process *deleting_process) { - register Lisp_Object proc, buffer; + register Lisp_Object proc; Lisp_Object tail, msg; struct gcpro gcpro1, gcpro2; @@ -6333,8 +6325,6 @@ status_notify (struct Lisp_Process *deleting_process) && p != deleting_process && read_process_output (proc, p->infd) > 0); - buffer = p->buffer; - /* Get the text to use for the message. */ if (p->raw_status_new) update_status (p); @@ -6355,66 +6345,83 @@ status_notify (struct Lisp_Process *deleting_process) } /* The actions above may have further incremented p->tick. - So set p->update_tick again - so that an error in the sentinel will not cause - this code to be run again. */ + So set p->update_tick again so that an error in the sentinel will + not cause this code to be run again. */ p->update_tick = p->tick; /* Now output the message suitably. */ - if (!NILP (p->sentinel)) - exec_sentinel (proc, msg); - /* Don't bother with a message in the buffer - when a process becomes runnable. */ - else if (!EQ (symbol, Qrun) && !NILP (buffer)) - { - Lisp_Object tem; - struct buffer *old = current_buffer; - ptrdiff_t opoint, opoint_byte; - ptrdiff_t before, before_byte; - - /* Avoid error if buffer is deleted - (probably that's why the process is dead, too) */ - if (!BUFFER_LIVE_P (XBUFFER (buffer))) - continue; - Fset_buffer (buffer); - - opoint = PT; - opoint_byte = PT_BYTE; - /* Insert new output into buffer - at the current end-of-output marker, - thus preserving logical ordering of input and output. */ - if (XMARKER (p->mark)->buffer) - Fgoto_char (p->mark); - else - SET_PT_BOTH (ZV, ZV_BYTE); - - before = PT; - before_byte = PT_BYTE; - - tem = BVAR (current_buffer, read_only); - bset_read_only (current_buffer, Qnil); - insert_string ("\nProcess "); - { /* FIXME: temporary kludge */ - Lisp_Object tem2 = p->name; Finsert (1, &tem2); } - insert_string (" "); - Finsert (1, &msg); - bset_read_only (current_buffer, tem); - set_marker_both (p->mark, p->buffer, PT, PT_BYTE); - - if (opoint >= before) - SET_PT_BOTH (opoint + (PT - before), - opoint_byte + (PT_BYTE - before_byte)); - else - SET_PT_BOTH (opoint, opoint_byte); - - set_buffer_internal (old); - } + exec_sentinel (proc, msg); } } /* end for */ - update_mode_lines++; /* in case buffers use %s in mode-line-format */ + update_mode_lines++; /* In case buffers use %s in mode-line-format. */ UNGCPRO; } +DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel, + Sinternal_default_process_sentinel, 2, 2, 0, + doc: /* Function used as default sentinel for processes. */) + (Lisp_Object proc, Lisp_Object msg) +{ + Lisp_Object buffer, symbol; + struct Lisp_Process *p; + CHECK_PROCESS (proc); + p = XPROCESS (proc); + buffer = p->buffer; + symbol = p->status; + if (CONSP (symbol)) + symbol = XCAR (symbol); + + if (!EQ (symbol, Qrun) && !NILP (buffer)) + { + Lisp_Object tem; + struct buffer *old = current_buffer; + ptrdiff_t opoint, opoint_byte; + ptrdiff_t before, before_byte; + + /* Avoid error if buffer is deleted + (probably that's why the process is dead, too). */ + if (!BUFFER_LIVE_P (XBUFFER (buffer))) + return Qnil; + Fset_buffer (buffer); + + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) + msg = (code_convert_string_norecord + (msg, Vlocale_coding_system, 1)); + + opoint = PT; + opoint_byte = PT_BYTE; + /* Insert new output into buffer + at the current end-of-output marker, + thus preserving logical ordering of input and output. */ + if (XMARKER (p->mark)->buffer) + Fgoto_char (p->mark); + else + SET_PT_BOTH (ZV, ZV_BYTE); + + before = PT; + before_byte = PT_BYTE; + + tem = BVAR (current_buffer, read_only); + bset_read_only (current_buffer, Qnil); + insert_string ("\nProcess "); + { /* FIXME: temporary kludge. */ + Lisp_Object tem2 = p->name; Finsert (1, &tem2); } + insert_string (" "); + Finsert (1, &msg); + bset_read_only (current_buffer, tem); + set_marker_both (p->mark, p->buffer, PT, PT_BYTE); + + if (opoint >= before) + SET_PT_BOTH (opoint + (PT - before), + opoint_byte + (PT_BYTE - before_byte)); + else + SET_PT_BOTH (opoint, opoint_byte); + + set_buffer_internal (old); + } + return Qnil; +} + DEFUN ("set-process-coding-system", Fset_process_coding_system, Sset_process_coding_system, 1, 3, 0, @@ -6606,13 +6613,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; - /* Compute time from now till when time limit is up */ - /* Exit if already run out */ + /* Compute time from now till when time limit is up. */ + /* Exit if already run out. */ if (nsecs < 0) { /* A negative timeout means gobble output available now - but don't wait at all. */ + but don't wait at all. */ timeout = make_emacs_time (0, 0); } @@ -6805,9 +6812,8 @@ setup_process_coding_systems (Lisp_Object process) if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system)); coding_system = p->decode_coding_system; - if (! NILP (p->filter)) - ; - else if (BUFFERP (p->buffer)) + if (EQ (p->filter, Qinternal_default_process_filter) + && BUFFERP (p->buffer)) { if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) coding_system = raw_text_coding_system (coding_system); @@ -6916,7 +6922,7 @@ kill_buffer_processes (Lisp_Object buffer) DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 0, 0, 0, - doc: /* Returns non-nil if Emacs is waiting for input from the user. + doc: /* Return non-nil if Emacs is waiting for input from the user. This is intended for use by asynchronous process output filters and sentinels. */) (void) { @@ -7222,6 +7228,10 @@ syms_of_process (void) DEFSYM (Qcutime, "cutime"); DEFSYM (Qcstime, "cstime"); DEFSYM (Qctime, "ctime"); + DEFSYM (Qinternal_default_process_sentinel, + "internal-default-process-sentinel"); + DEFSYM (Qinternal_default_process_filter, + "internal-default-process-filter"); DEFSYM (Qpri, "pri"); DEFSYM (Qnice, "nice"); DEFSYM (Qthcount, "thcount"); @@ -7317,6 +7327,8 @@ The variable takes effect when `start-process' is called. */); defsubr (&Ssignal_process); defsubr (&Swaiting_for_user_input_p); defsubr (&Sprocess_type); + defsubr (&Sinternal_default_process_sentinel); + defsubr (&Sinternal_default_process_filter); defsubr (&Sset_process_coding_system); defsubr (&Sprocess_coding_system); defsubr (&Sset_process_filter_multibyte); |