diff --git a/ChangeLog b/ChangeLog index 97c307f3817..ce2014288e6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2013-05-16 Paul Eggert + + 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 + + * Makefile.in (install-doc): DOC file is not version specific any more. + * .bzrignore: Don't ignore DOC-* any more. + 2013-05-13 Paul Eggert * 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 + + * 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 + + * quick-install-emacs: Don't prune DOC-* files a any more. + 2013-05-14 Glenn Morris * 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 + + * search.texi (Repeat Isearch): Mention key `RET' to finish + editing the string. (Bug#13348) + 2013-05-14 Glenn Morris * 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 + + * loading.texi (Autoload): + * help.texi (Documentation Basics, Accessing Documentation) + (Accessing Documentation, Accessing Documentation): DOC-* is now DOC. + 2013-04-23 Glenn Morris * internals.texi (Writing Emacs Primitives): Remove obvious example. @@ -24,8 +30,8 @@ 2013-04-06 Chong Yidong * 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 - * 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 - * 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 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 + + * .gitignore: Don't ignore DOC-* any more. + 2013-05-07 Paul Eggert Use Gnulib ACL implementation, for benefit of Solaris etc. (Bug#14295) diff --git a/etc/NEWS b/etc/NEWS index 144adf15506..5f238988820 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 + + * makefile.w32-in ($(DOC)): Use DOC rather than DOC-X. + 2013-05-06 Paul Eggert * 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, , 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 + + * progmodes/octave.el (octave-indent-defun): Mark obsolete. + (octave-mode-menu, octave-mode-map): Remove its uses. + +2013-05-16 Reto Zimmermann + + 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 + + * simple.el (prog-indent-sexp): Indent enclosing defun. + +2013-05-15 Glenn Morris + + * 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 + + * 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 + + * loadup.el: Just use unversioned DOC. + + * nxml/nxml-mode.el: Treat unclosed <[[, - * 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 @@ -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 + + * 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 * 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 + + * 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 * 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 + + * shr-color.el (shr-color-visible-luminance-min) + (shr-color-visible-distance-min): Use shr-color group. + 2013-05-11 Glenn Morris * 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. \\ \\[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 . 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 gets added to the buffer after the unclosed ") - (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 \"" (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 " := " @@ -12410,77 +12664,6 @@ expressions (e.g. for index ranges of types and signals)." '(try-expand-list 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 @@ -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,12 +17505,20 @@ 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 + + * url-news.el (url-news): Remove empty custom group. + 2013-02-16 Glenn Morris * 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 + + * sed1x.inp: Don't rewrite DOC any more. + 2013-02-08 Paul Eggert * 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 + + * makefile.w32-in (clean, top-distclean): DOC-X doesn't exist any more. + 2013-05-08 Juanma Barranquero * 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,3 +1,31 @@ +2013-05-15 Stefan Monnier + + * 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 * regex.c (regex_compile) [\=, \>, \<]: Don't forget to set laststart. 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); - /* 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. */ + /* 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. */ #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); + /* 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); - } - - /* For speed, if a search happens within this code, - save the match data in a special nonrecursive fashion. */ - running_asynch_code = 1; - - 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); - - /* Don't call setup_coding_system for - proc_decode_coding_system[channel] here. It is done in - detect_coding called via decode_coding above. */ - - /* If a coding system for encoding is not yet decided, we set - it as the same as coding-system for decoding. - - 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 (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 (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. */ + /* 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 (); - running_asynch_code = outer_running_asynch_code; + record_unwind_save_match_data (); + Fset_match_data (tem, Qt); + } - /* 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; + /* For speed, if a search happens within this code, + save the match data in a special nonrecursive fashion. */ + running_asynch_code = 1; + + 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); + + /* Don't call setup_coding_system for + proc_decode_coding_system[channel] here. It is done in + detect_coding called via decode_coding above. */ + + /* If a coding system for encoding is not yet decided, we set + it as the same as coding-system for decoding. + + 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 (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)) + 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 (); - } + /* 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 no filter, write into buffer if it isn't dead. */ - else if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) +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; + + 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, @@ -6187,13 +6192,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) { @@ -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);