commit 526ffbad14265addd63db19903a24a9a6073cea6 (HEAD, refs/remotes/origin/master) Author: Jackson Ray Hamilton Date: Tue Apr 9 19:53:37 2019 -0700 * etc/NEWS: Document js-jsx-align->-with-< diff --git a/etc/NEWS b/etc/NEWS index 81b7d26dc3..fbde6e0b66 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1289,8 +1289,20 @@ wrapped in parenthesis (e.g. in a 'return' statement or a function call). It would also fail in many intricate cases. Now, indentation should work anywhere without parenthesis; many more intricacies are supported; and, indentation conventions align more closely with those -of the React developer community, otherwise still adhering to SGML -conventions. +of the React developer community (see 'js-jsx-align->-with-<'), +otherwise still adhering to SGML conventions. + +--- +*** New defcustom 'js-jsx-align->-with-<' controls '>' indents. +Commonly in JSX code, a '>' on its own line is indented at the same +level as its opening '<'. This is the new default for JSX. This +behavior is slightly different than that used by SGML in Emacs, where +'>' is indented at the same level as attributes, which was also the +old default for JSX. + +This is turned on by default. To get back the old default indentation +behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<' +to nil. --- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. commit f29010729f85434ee24efd0d7ed29b7e24cf8be6 Author: Jackson Ray Hamilton Date: Tue Apr 9 19:42:49 2019 -0700 Add new defcustom js-jsx-align->-with-< * lisp/progmodes/js.el (js-jsx-align->-with-<): New variable for users to control one opinionated aspect of JSX indentation. It defaults to the style seen in the React docs, which many users expected as the “correct” indentation. Still, the old SGML-style of indentation could be desirable too, especially since it was the old default. This ensures users have a way of getting back the old behavior. (js-jsx--contextual-indentation): Respect js-jsx-align->-with-<. * test/manual/indent/jsx-align-gt-with-lt.jsx: New test for js-jsx-align->-with-<. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 90f857c96f..afdc28e53b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -600,6 +600,31 @@ It is set to be buffer-local (and t) when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-align->-with-< t + "When non-nil, “>” will be indented to the opening “<” in JSX. + +When this is enabled, JSX indentation looks like this: + + + + + +When this is disabled, JSX indentation looks like this: + + + + " + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + (defcustom js-jsx-indent-level nil "When non-nil, indent JSX by this value, instead of like JS. @@ -2725,10 +2750,12 @@ The column calculation is based off of `sgml-calculate-indent'." ;; bracket on its own line is indented at the same level as the ;; opening angle bracket of the JSXElement. Otherwise, indent ;; JSXAttribute space like SGML. - (if (progn - (goto-char (nth 2 context)) - (and (= line (line-number-at-pos)) - (looking-back "^\\s-*/?>" (line-beginning-position)))) + (if (and + js-jsx-align->-with-< + (progn + (goto-char (nth 2 context)) + (and (= line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position))))) (progn (goto-char (nth 1 context)) (current-column)) diff --git a/test/manual/indent/jsx-align-gt-with-lt.jsx b/test/manual/indent/jsx-align-gt-with-lt.jsx new file mode 100644 index 0000000000..8eb1d6d718 --- /dev/null +++ b/test/manual/indent/jsx-align-gt-with-lt.jsx @@ -0,0 +1,12 @@ + + + + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// js-jsx-align->-with-<: nil +// End: commit c0b09f42f5107dc009629ee73a790ca1d62d290a Author: Jackson Ray Hamilton Date: Tue Apr 9 18:50:28 2019 -0700 * etc/NEWS: Document way to revert to old JSX indentation behavior diff --git a/etc/NEWS b/etc/NEWS index 620d88c32a..81b7d26dc3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1294,12 +1294,19 @@ conventions. --- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. -It was never really intuitive that JSX indentation would be controlled -by an SGML variable. JSX is a syntax extension of JavaScript, so it -should be indented just like any other expression in JavaScript. This -is technically a breaking change, but it will probably align with how -you would normally expect for this indentation to be controlled, and -you probably won't need to change your config. +Since JSX is a syntax extension of JavaScript, it makes the most sense +for JSX expressions to be indented the same number of spaces as other +JS expressions. This is a breaking change, but it probably aligns +with how you'd expect this indentation to behave. If you want JSX to +be indented like JS, you won't need to change your config. + +The old behavior can be emulated by controlling JSX indentation +independently of JS, by setting 'js-jsx-indent-level'. + +--- +*** New defcustom 'js-jsx-indent-level' for different JSX indentation. +If you wish to indent JSX by a different number of spaces than JS, set +this variable to the desired number. --- *** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. commit 5772971f255c7031753e02492ae979c501018a50 Author: Jackson Ray Hamilton Date: Tue Apr 9 18:44:36 2019 -0700 Add new defcustom js-jsx-indent-level * lisp/progmodes/js.el (js-jsx-indent-level): New variable for users to set JSX indentation differently than JS, like before. (js-jsx--contextual-indentation): Respect js-jsx-indent-level when it’s set. * test/manual/indent/jsx-indent-level.jsx: New test for js-jsx-indent-level. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 7099824581..90f857c96f 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -600,6 +600,42 @@ It is set to be buffer-local (and t) when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-indent-level nil + "When non-nil, indent JSX by this value, instead of like JS. + +Let `js-indent-level' be 4. When this variable is also set to +nil, JSX indentation looks like this (consistent): + + return ( + + + Hello World! + + + ) + +Alternatively, when this variable is also set to 2, JSX +indentation looks like this (different): + + return ( + + + Hello World! + + + )" + :version "27.1" + :type 'integer + :safe (lambda (x) (or (null x) (integerp x))) + :group 'js) +;; This is how indentation behaved out-of-the-box until Emacs 27. JSX +;; indentation was controlled with `sgml-basic-offset', which defaults +;; to 2, whereas `js-indent-level' defaults to 4. Users who had the +;; same values configured for both their HTML and JS indentation would +;; luckily get consistent JSX indentation; most others were probably +;; unhappy. I’d be surprised if anyone actually wants different +;; indentation levels, but just in case, here’s a way back to that. + (defcustom js-jsx-attribute-offset 0 "Specifies a delta for JSXAttribute indentation. @@ -2706,7 +2742,7 @@ The column calculation is based off of `sgml-calculate-indent'." (current-column) ;; This is the first attribute: indent. (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) - (+ (current-column) js-indent-level)))) + (+ (current-column) (or js-jsx-indent-level js-indent-level))))) ('text ;; Indent to reflect nesting. @@ -2715,7 +2751,7 @@ The column calculation is based off of `sgml-calculate-indent'." ;; The last line isn’t nested, but the rest are. (if (or (not (nth 2 context)) ; Unclosed. (< line (line-number-at-pos (nth 2 context)))) - js-indent-level + (or js-jsx-indent-level js-indent-level) 0))) )) diff --git a/test/manual/indent/jsx-indent-level.jsx b/test/manual/indent/jsx-indent-level.jsx new file mode 100644 index 0000000000..0a84b9eb77 --- /dev/null +++ b/test/manual/indent/jsx-indent-level.jsx @@ -0,0 +1,13 @@ +return ( + + + Hello World! + + +) + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 4 +// js-jsx-indent-level: 2 +// End: commit d82603747564063f908c9c877449c827a9808528 Author: Paul Eggert Date: Tue Apr 9 15:42:10 2019 -0700 Remove the need for temacs.in Instead of building a file temacs.in used only to compute a fingerprint, compute the fingerprint directly from the .o and .a files that go into temacs.in. This speeds up the build by avoiding the need to link temacs twice, once with a dummy fingerprint. * lib-src/make-fingerprint.c (main): No need to generate a fingerprint file that includes config.h, now that fingerprint.c depends on all the .o files. * src/Makefile.in ($(libsrc)/make-fingerprint$(EXEEXT)): Use the same rule as $(libsrc)/make-docfile$(EXEEXT). * src/fingerprint-dummy.c: Remove. * src/Makefile.in (${charsets}, $(libsrc)/make-docfile$(EXEEXT)) ($(LIBEGNU_ARCHIVE), $(lwlibdir)/liblw.a, $(oldXMenudir)/libXMenu11.a) (../config.status, ${ETAGS}, ../lisp/TAGS, $(lwlibdir)/TAGS) ($(lispsource)/loaddefs.el): Prefer ‘$(MAKE) -C $(dir $@)’ to ‘${MAKE} -C SOMESTRING’ when either will do, as the former is more regular and lets us coalesce rules better. (EMACS_DEPS_PRE, EMACS_DEPS_POST, BUILD_EMACS_PRE) (BUILD_EMACS_POST, temacs.in$(EXEEXT)): Remove. (FINGERPRINTED): New macro. (fingerprint.c): Use it instead of temacs.in$(EXEEXT), to avoid the need to build temacs.in at all. (temacs$(EXEEXT)): No need to depend on other .o files now; fingerprint.o is enough, since it depends on the rest. Spell out what used to be in BUILD_EMACS_PRE and BUILD_EMACS_POST. (mostlyclean): No need to remove temacs.in. diff --git a/.gitignore b/.gitignore index bd5a8e7947..98b8222180 100644 --- a/.gitignore +++ b/.gitignore @@ -185,7 +185,6 @@ src/bootstrap-emacs src/emacs src/emacs-[0-9]* src/temacs -src/temacs.in src/fingerprint.c src/*.pdmp diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index 4bfeaa0742..35bb8b98a0 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c @@ -99,9 +99,9 @@ main (int argc, char **argv) } else { - puts ("#include \n" - "#include \"fingerprint.h\"\n" - "unsigned char const fingerprint[] = {"); + puts ("#include \"fingerprint.h\"\n" + "unsigned char const fingerprint[] =\n" + "{"); for (int i = 0; i < 32; ++i) printf ("\t0x%02X,\n", digest[i]); puts ("};"); diff --git a/src/Makefile.in b/src/Makefile.in index 0613a0dbed..f8a2ffadc2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -533,7 +533,7 @@ ${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE charsets = ${top_srcdir}/admin/charsets/charsets.stamp ${charsets}: FORCE - ${MAKE} -C ../admin/charsets all + $(MAKE) -C $(dir $@) all charscript = ${lispintdir}/charscript.el ${charscript}: FORCE @@ -584,8 +584,9 @@ $(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ $(shortlisp) -$(libsrc)/make-docfile$(EXEEXT): $(lib)/libgnu.a - $(MAKE) -C $(libsrc) make-docfile$(EXEEXT) +$(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \ + $(lib)/libgnu.a + $(MAKE) -C $(dir $@) $(notdir $@) buildobj.h: Makefile $(AM_V_GEN)for i in $(ALLOBJS); do \ @@ -613,32 +614,21 @@ $(ALLOBJS): globals.h LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a $(LIBEGNU_ARCHIVE): $(config_h) - $(MAKE) -C $(lib) all + $(MAKE) -C $(dir $@) all -EMACS_DEPS_PRE=$(LIBXMENU) $(ALLOBJS) -EMACS_DEPS_POST=$(LIBEGNU_ARCHIVE) $(EMACSRES) ${charsets} ${charscript} -BUILD_EMACS_PRE=$(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ - -o $@ $(ALLOBJS) -BUILD_EMACS_POST=$(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) - -## We hash this file to generate the build fingerprint -temacs.in$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint-dummy.o $(EMACS_DEPS_POST) - $(BUILD_EMACS_PRE) fingerprint-dummy.o $(BUILD_EMACS_POST) - -$(libsrc)/make-fingerprint$(EXEEXT): $(libsrc)/make-fingerprint.c $(lib)/libgnu.a - $(MAKE) -C $(libsrc) make-fingerprint$(EXEEXT) - -fingerprint.c: temacs.in$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT) - $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) \ - >$@.tmp +FINGERPRINTED = $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) +fingerprint.c: $(FINGERPRINTED) $(libsrc)/make-fingerprint$(EXEEXT) + $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) $(FINGERPRINTED) >$@.tmp $(AM_V_at)mv $@.tmp $@ ## We have to create $(etc) here because init_cmdargs tests its ## existence when setting Vinstallation_directory (FIXME?). ## This goes on to affect various things, and the emacs binary fails ## to start if Vinstallation_directory has the wrong value. -temacs$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint.o $(EMACS_DEPS_POST) - $(BUILD_EMACS_PRE) fingerprint.o $(BUILD_EMACS_POST) +temacs$(EXEEXT): fingerprint.o $(charsets) $(charscript) + $(AM_V_CCLD)$(CC) -o $@ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ + $(ALLOBJS) fingerprint.o \ + $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) $(MKDIR_P) $(etc) ifeq ($(DUMPING),unexec) ifneq ($(PAXCTL_notdumped),) @@ -649,15 +639,15 @@ endif ## The following oldxmenu-related rules are only (possibly) used if ## HAVE_X11 && !USE_GTK, but there is no harm in always defining them. $(lwlibdir)/liblw.a: $(config_h) globals.h lisp.h FORCE - $(MAKE) -C $(lwlibdir) liblw.a + $(MAKE) -C $(dir $@) $(notdir $@) $(oldXMenudir)/libXMenu11.a: FORCE - $(MAKE) -C $(oldXMenudir) libXMenu11.a + $(MAKE) -C $(dir $@) $(notdir $@) FORCE: .PHONY: FORCE .PRECIOUS: ../config.status Makefile ../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4 - $(MAKE) -C .. $(notdir $@) + $(MAKE) -C $(dir $@) $(notdir $@) Makefile: ../config.status $(srcdir)/Makefile.in $(MAKE) -C .. src/$@ @@ -675,7 +665,7 @@ ns-app: emacs$(EXEEXT) $(pdmp) mostlyclean: rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o - rm -f temacs.in$(EXEEXT) fingerprint.c + rm -f fingerprint.c rm -f emacs.pdmp rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) @@ -713,7 +703,7 @@ extraclean: distclean ETAGS = ../lib-src/etags${EXEEXT} ${ETAGS}: FORCE - ${MAKE} -C ../lib-src $(notdir $@) + $(MAKE) -C $(dir $@) $(notdir $@) # Remove macuvs.h and fingerprint.c since they'd cause `src/emacs` # to be built before we can get TAGS. @@ -738,11 +728,8 @@ TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) ## Arrange to make tags tables for ../lisp and ../lwlib, ## which the above TAGS file for the C files includes by reference. -../lisp/TAGS: FORCE - $(MAKE) -C ../lisp TAGS ETAGS="$(ETAGS)" - -$(lwlibdir)/TAGS: FORCE - $(MAKE) -C $(lwlibdir) TAGS ETAGS="$(ETAGS)" +../lisp/TAGS $(lwlibdir)/TAGS: FORCE + $(MAKE) -C $(dir $@) $(notdir $@) ETAGS="$(ETAGS)" tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS .PHONY: tags @@ -778,7 +765,7 @@ VCSWITNESS = $(lispsource)/loaddefs.el: $(VCSWITNESS) | \ bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) - $(MAKE) -C ../lisp autoloads EMACS="$(bootstrap_exe)" + $(MAKE) -C $(dir $@) autoloads EMACS="$(bootstrap_exe)" ## Dump an Emacs executable named bootstrap-emacs containing the ## files from loadup.el in source form. diff --git a/src/fingerprint-dummy.c b/src/fingerprint-dummy.c deleted file mode 100644 index 04938bd1d0..0000000000 --- a/src/fingerprint-dummy.c +++ /dev/null @@ -1,25 +0,0 @@ -/* Dummy fingerprint - -Copyright (C) 2016, 2018-2019 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include - -#include "fingerprint.h" - -/* Dummy fingerprint to use as hash input. */ -unsigned char const fingerprint[32] = { 0 }; commit e44ff2de819ead77b00c7fb4ede75ada685ff099 Author: Paul Eggert Date: Tue Apr 9 15:42:10 2019 -0700 Remove assumption of uint64_t etc. in portable code C11 doesn’t guarantee the existence of types like uint64_t, so avoid these types in portable code, as it’s easy to do so. There’s no need to avoid the types in w32-specific code, since w32 is guaranteed to have them. * lib-src/make-fingerprint.c (main): * src/fingerprint-dummy.c: * src/fingerprint.h: * src/pdumper.c (dump_fingerprint, struct dump_header): Prefer unsigned char to uint8_t in portable code, as either will do. Put an "#include " in fingerprint.c files, so that the corresponding .o file is rebuilt after ./configure is run. * lib-src/make-fingerprint.c (main): Simplify loop. * src/Makefile.in (fingerprint.c): Update atomically. * src/pdumper.c: Omit unnecessary check that off_t is the same size as int32_t or int64_t, as the code does not rely on this assumption. (dump_off): Use int_least32_t, not int32_t. (struct dump_reloc): Use unsigned int, not uint32_t. (dump_anonymous_allocate_w32, dump_anonymous_allocate_posix) (dump_anonymous_allocate, dump_map_file_w32, dump_map_file_posix) (dump_map_file: Do the sanity checks at compile time, not at run-time, to avoid usage of uint64_t etc. on non-w32 platforms. diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index d310366442..4bfeaa0742 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c @@ -89,7 +89,7 @@ main (int argc, char **argv) fclose (f); } - uint8_t digest[32]; + unsigned char digest[32]; sha256_finish_ctx (&ctx, digest); if (raw) @@ -99,12 +99,12 @@ main (int argc, char **argv) } else { - printf ("#include \"fingerprint.h\"\n"); - printf ("\n"); - printf ("const uint8_t fingerprint[32] = { "); + puts ("#include \n" + "#include \"fingerprint.h\"\n" + "unsigned char const fingerprint[] = {"); for (int i = 0; i < 32; ++i) - printf ("%s0x%02X", i ? ", " : "", digest[i]); - printf (" };\n"); + printf ("\t0x%02X,\n", digest[i]); + puts ("};"); } return EXIT_SUCCESS; diff --git a/src/Makefile.in b/src/Makefile.in index 10b2da319b..0613a0dbed 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -629,7 +629,9 @@ $(libsrc)/make-fingerprint$(EXEEXT): $(libsrc)/make-fingerprint.c $(lib)/libgnu. $(MAKE) -C $(libsrc) make-fingerprint$(EXEEXT) fingerprint.c: temacs.in$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT) - $(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) > fingerprint.c + $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) \ + >$@.tmp + $(AM_V_at)mv $@.tmp $@ ## We have to create $(etc) here because init_cmdargs tests its ## existence when setting Vinstallation_directory (FIXME?). diff --git a/src/fingerprint-dummy.c b/src/fingerprint-dummy.c index 1603519783..04938bd1d0 100644 --- a/src/fingerprint-dummy.c +++ b/src/fingerprint-dummy.c @@ -17,7 +17,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#include + #include "fingerprint.h" /* Dummy fingerprint to use as hash input. */ -const uint8_t fingerprint[32] = { 0 }; +unsigned char const fingerprint[32] = { 0 }; diff --git a/src/fingerprint.h b/src/fingerprint.h index 913b668b4e..0b195fd0ca 100644 --- a/src/fingerprint.h +++ b/src/fingerprint.h @@ -20,12 +20,10 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_FINGERPRINT_H #define EMACS_FINGERPRINT_H -#include - /* We generate fingerprint.c and fingerprint.o from all the sources in Emacs. This way, we have a unique value that we can use to pair data files (like a portable dump image) with a specific build of Emacs. */ -extern const uint8_t fingerprint[32]; +extern unsigned char const fingerprint[32]; #endif diff --git a/src/pdumper.c b/src/pdumper.c index 68c412d47c..3aa941221d 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -123,8 +123,6 @@ verify (sizeof (intptr_t) == sizeof (ptrdiff_t)); verify (sizeof (void (*)(void)) == sizeof (void *)); verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object)); verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); -verify (sizeof (off_t) == sizeof (int32_t) - || sizeof (off_t) == sizeof (int64_t)); verify (CHAR_BIT == 8); #define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y)) @@ -145,9 +143,9 @@ static struct } remembered_data[32]; static int nr_remembered_data = 0; -typedef int32_t dump_off; -#define DUMP_OFF_MIN INT32_MIN -#define DUMP_OFF_MAX INT32_MAX +typedef int_least32_t dump_off; +#define DUMP_OFF_MIN INT_LEAST32_MIN +#define DUMP_OFF_MAX INT_LEAST32_MAX __attribute__((format (printf,1,2))) static void @@ -290,10 +288,10 @@ verify (DUMP_ALIGNMENT >= GCALIGNMENT); struct dump_reloc { - uint32_t raw_offset : DUMP_RELOC_OFFSET_BITS; + unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS; ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS; }; -verify (sizeof (struct dump_reloc) == sizeof (int32_t)); +verify (sizeof (struct dump_reloc) == sizeof (dump_off)); /* Set the type of a dump relocation. @@ -323,7 +321,7 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) } static void -dump_fingerprint (const char *label, const uint8_t *xfingerprint) +dump_fingerprint (const char *label, unsigned char const *xfingerprint) { fprintf (stderr, "%s: ", label); for (int i = 0; i < 32; ++i) @@ -354,7 +352,7 @@ struct dump_header char magic[sizeof (dump_magic)]; /* Associated Emacs binary. */ - uint8_t fingerprint[32]; + unsigned char fingerprint[32]; /* Relocation table for the dump file; each entry is a struct dump_reloc. */ @@ -4230,17 +4228,12 @@ enum dump_memory_protection DUMP_MEMORY_ACCESS_READWRITE = 3, }; +#if VM_SUPPORTED == VM_MS_WINDOWS static void * dump_anonymous_allocate_w32 (void *base, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_MS_WINDOWS - (void) base; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; DWORD mem_type; DWORD mem_prot; @@ -4269,26 +4262,22 @@ dump_anonymous_allocate_w32 (void *base, ? EBUSY : EPERM; return ret; -#endif } +#endif + +#if VM_SUPPORTED == VM_POSIX /* Old versions of macOS only define MAP_ANON, not MAP_ANONYMOUS. FIXME: This probably belongs elsewhere (gnulib/autoconf?) */ -#ifndef MAP_ANONYMOUS -#define MAP_ANONYMOUS MAP_ANON -#endif +# ifndef MAP_ANONYMOUS +# define MAP_ANONYMOUS MAP_ANON +# endif static void * dump_anonymous_allocate_posix (void *base, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_POSIX - (void) base; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; int mem_prot; @@ -4333,8 +4322,8 @@ dump_anonymous_allocate_posix (void *base, if (ret == MAP_FAILED) ret = NULL; return ret; -#endif } +#endif /* Perform anonymous memory allocation. */ static void * @@ -4342,14 +4331,14 @@ dump_anonymous_allocate (void *base, const size_t size, enum dump_memory_protection protection) { - void *ret = NULL; - if (VM_SUPPORTED == VM_MS_WINDOWS) - ret = dump_anonymous_allocate_w32 (base, size, protection); - else if (VM_SUPPORTED == VM_POSIX) - ret = dump_anonymous_allocate_posix (base, size, protection); - else - errno = ENOSYS; - return ret; +#if VM_SUPPORTED == VM_POSIX + return dump_anonymous_allocate_posix (base, size, protection); +#elif VM_SUPPORTED == VM_MS_WINDOWS + return dump_anonymous_allocate_w32 (base, size, protection); +#else + errno = ENOSYS; + return NULL; +#endif } /* Undo the effect of dump_reserve_address_space(). */ @@ -4371,18 +4360,11 @@ dump_anonymous_release (void *addr, size_t size) #endif } +#if VM_SUPPORTED == VM_MS_WINDOWS static void * dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_MS_WINDOWS - (void) base; - (void) fd; - (void) offset; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret = NULL; HANDLE section = NULL; HANDLE file; @@ -4437,21 +4419,14 @@ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, if (section && !CloseHandle (section)) emacs_abort (); return ret; -#endif } +#endif +#if VM_SUPPORTED == VM_POSIX static void * dump_map_file_posix (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_POSIX - (void) base; - (void) fd; - (void) offset; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; int mem_prot; int mem_flags; @@ -4481,22 +4456,22 @@ dump_map_file_posix (void *base, int fd, off_t offset, size_t size, if (ret == MAP_FAILED) ret = NULL; return ret; -#endif } +#endif /* Map a file into memory. */ static void * dump_map_file (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { - void *ret = NULL; - if (VM_SUPPORTED == VM_MS_WINDOWS) - ret = dump_map_file_w32 (base, fd, offset, size, protection); - else if (VM_SUPPORTED == VM_POSIX) - ret = dump_map_file_posix (base, fd, offset, size, protection); - else - errno = ENOSYS; +#if VM_SUPPORTED == VM_POSIX + return dump_map_file_posix (base, fd, offset, size, protection); +#elif VM_SUPPORTED == VM_MS_WINDOWS + return dump_map_file_w32 (base, fd, offset, size, protection); +#else + errno = ENOSYS; return ret; +#endif } /* Remove a virtual memory mapping. commit 44a39e3e761c0774cd1bb9360db7f49e1d66ec06 Author: Paul Eggert Date: Tue Apr 9 15:42:10 2019 -0700 Remove dmpstruct.h The hassles of updating the dmpstruct.h-using code bit me again. These updates are more trouble than they’re worth. See: https://lists.gnu.org/r/emacs-devel/2019-03/msg00122.html As I’m the main person who’s made changes in this area since dmpstruct.h was introduced, I’m the most motivated to clean up the situation. * make-dist (possibly_non_vc_files): Remove src/dmpstruct.h. * src/Makefile.in (dmpstruct_headers, dmpstruct.h): Remove. (pdumper.o): Do not depend on dmpstruct.h. (mostlyclean): Do not remove dmpstruct.h. * src/dmpstruct.awk: Remove. * src/pdumper.c: Do not include dmpstruct.h. (CHECK_STRUCTS): Remove. All uses removed. diff --git a/.gitignore b/.gitignore index 355824f390..bd5a8e7947 100644 --- a/.gitignore +++ b/.gitignore @@ -187,7 +187,6 @@ src/emacs-[0-9]* src/temacs src/temacs.in src/fingerprint.c -src/dmpstruct.h src/*.pdmp # Character-set info. diff --git a/make-dist b/make-dist index 4e18d77a87..821895a005 100755 --- a/make-dist +++ b/make-dist @@ -366,7 +366,7 @@ possibly_non_vc_files=" $top_level_ChangeLog MANIFEST aclocal.m4 configure admin/charsets/jisx2131-filter - src/config.in src/dmpstruct.h src/emacs-module.h + src/config.in src/emacs-module.h src/fingerprint.c "$( find admin doc etc lisp \ diff --git a/src/Makefile.in b/src/Makefile.in index dee3a534db..10b2da319b 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -456,14 +456,6 @@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) .PHONY: all -dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \ - $(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h -pdumper.o: dmpstruct.h -dmpstruct.h: $(srcdir)/dmpstruct.awk -dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers) - $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \ - $(dmpstruct_headers) > $@ - AUTO_DEPEND = @AUTO_DEPEND@ DEPDIR = deps ifeq ($(AUTO_DEPEND),yes) @@ -681,7 +673,7 @@ ns-app: emacs$(EXEEXT) $(pdmp) mostlyclean: rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o - rm -f temacs.in$(EXEEXT) fingerprint.c dmpstruct.h + rm -f temacs.in$(EXEEXT) fingerprint.c rm -f emacs.pdmp rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) diff --git a/src/dmpstruct.awk b/src/dmpstruct.awk deleted file mode 100755 index 55626cf8b2..0000000000 --- a/src/dmpstruct.awk +++ /dev/null @@ -1,45 +0,0 @@ -# Copyright (C) 2018-2019 Free Software Foundation, Inc. -# -# This file is part of GNU Emacs. -# -# GNU Emacs is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or (at -# your option) any later version. -# -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Emacs. If not, see . - -BEGIN { - print "/* Generated by dmpstruct.awk */" - print "#ifndef EMACS_DMPSTRUCT_H" - print "#define EMACS_DMPSTRUCT_H" - struct_name = "" - tmpfile = "dmpstruct.tmp" -} -# Match a type followed by optional syntactic whitespace -/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/ { - struct_name = $2 - close (tmpfile) -} -/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/, /^( )?};$/ { - print $0 > tmpfile -} -/^( )?} *(GCALIGNED_STRUCT)? *;$/ { - if (struct_name != "") { - fflush (tmpfile) - cmd = "../lib-src/make-fingerprint -r " tmpfile - cmd | getline hash - close (cmd) - printf "#define HASH_%s_%.10s\n", struct_name, hash - struct_name = "" - } -} -END { - print "#endif /* EMACS_DMPSTRUCT_H */" -} diff --git a/src/pdumper.c b/src/pdumper.c index cb2915cb20..68c412d47c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -46,8 +46,6 @@ along with GNU Emacs. If not, see . */ #include "thread.h" #include "bignum.h" -#include "dmpstruct.h" - /* TODO: @@ -68,16 +66,6 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_PDUMPER -/* CHECK_STRUCTS being true makes the build break if we notice - changes to the source defining certain Lisp structures we dump. If - you change one of these structures, check that the pdumper code is - still valid, and update the pertinent hash lower down in this file - (pdumper.c) by manually copying the value from the dmpstruct.h - generated from your new code. */ -#ifndef CHECK_STRUCTS -# define CHECK_STRUCTS 1 -#endif - #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7) # pragma GCC diagnostic error "-Wconversion" # pragma GCC diagnostic error "-Wshadow" @@ -2043,9 +2031,6 @@ dump_pseudovector_lisp_fields (struct dump_context *ctx, static dump_off dump_cons (struct dump_context *ctx, const struct Lisp_Cons *cons) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Cons_00EEE63F67) -# error "Lisp_Cons changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Cons out; dump_object_start (ctx, &out, sizeof (out)); dump_field_lv (ctx, &out, cons, &cons->u.s.car, WEIGHT_STRONG); @@ -2058,9 +2043,6 @@ dump_interval_tree (struct dump_context *ctx, INTERVAL tree, dump_off parent_offset) { -#if CHECK_STRUCTS && !defined (HASH_interval_1B38941C37) -# error "interval changed. See CHECK_STRUCTS comment." -#endif /* TODO: output tree breadth-first? */ struct interval out; dump_object_start (ctx, &out, sizeof (out)); @@ -2102,9 +2084,6 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C) -# error "Lisp_String changed. See CHECK_STRUCTS comment." -#endif /* If we have text properties, write them _after_ the string so that at runtime, the prefetcher and cache will DTRT. (We access the string before its properties.). @@ -2148,10 +2127,6 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string) static dump_off dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Marker_642DBAF866) -# error "Lisp_Marker changed. See CHECK_STRUCTS comment." -#endif - START_DUMP_PVEC (ctx, &marker->header, struct Lisp_Marker, out); dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header); DUMP_FIELD_COPY (out, marker, need_adjustment); @@ -2171,9 +2146,6 @@ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) static dump_off dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882) -# error "Lisp_Overlay changed. See CHECK_STRUCTS comment." -#endif START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out); dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header); dump_field_lv_rawptr (ctx, out, overlay, &overlay->next, @@ -2199,9 +2171,6 @@ static dump_off dump_finalizer (struct dump_context *ctx, const struct Lisp_Finalizer *finalizer) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_D58E647CB8) -# error "Lisp_Finalizer changed. See CHECK_STRUCTS comment." -#endif START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out); /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the only Lisp field, finalizer->function, manually, so we can give it @@ -2221,9 +2190,6 @@ struct bignum_reload_info static dump_off dump_bignum (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_661945DE2B) -# error "Lisp_Bignum changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Bignum *bignum = XBIGNUM (object); START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); @@ -2259,9 +2225,6 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object) static dump_off dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_50A7B216D9) -# error "Lisp_Float changed. See CHECK_STRUCTS comment." -#endif eassert (ctx->header.cold_start); struct Lisp_Float out; dump_object_start (ctx, &out, sizeof (out)); @@ -2272,9 +2235,6 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) static dump_off dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387 -# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." -#endif dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar); struct Lisp_Intfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2286,9 +2246,6 @@ dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) static dump_off dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC) -# error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment." -#endif dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar); struct Lisp_Boolfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2300,9 +2257,6 @@ dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) static dump_off dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC) -# error "Lisp_Objfwd changed. See CHECK_STRUCTS comment." -#endif if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)), ctx->staticpro_table, Qnil))) @@ -2318,9 +2272,6 @@ static dump_off dump_fwd_buffer_obj (struct dump_context *ctx, const struct Lisp_Buffer_Objfwd *buffer_objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_13CA6B04FC) -# error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Buffer_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, buffer_objfwd, type); @@ -2334,9 +2285,6 @@ static dump_off dump_fwd_kboard_obj (struct dump_context *ctx, const struct Lisp_Kboard_Objfwd *kboard_objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069) -# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Kboard_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, kboard_objfwd, type); @@ -2347,9 +2295,6 @@ dump_fwd_kboard_obj (struct dump_context *ctx, static dump_off dump_fwd (struct dump_context *ctx, lispfwd fwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E) -# error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment." -#endif void const *p = fwd.fwdptr; dump_off offset; @@ -2381,9 +2326,6 @@ static dump_off dump_blv (struct dump_context *ctx, const struct Lisp_Buffer_Local_Value *blv) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C -# error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Buffer_Local_Value out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, blv, local_if_set); @@ -2446,13 +2388,6 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC -# error "Lisp_Symbol changed. See CHECK_STRUCTS comment." -#endif -#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) -# error "symbol_redirect changed. See CHECK_STRUCTS comment." -#endif - if (ctx->flags.defer_symbols) { if (offset != DUMP_OBJECT_ON_SYMBOL_QUEUE) @@ -2542,9 +2477,6 @@ static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) { -#if CHECK_STRUCTS && !defined (HASH_vectorlike_header_00A5A4BFB2) -# error "vectorlike_header changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Vector *v = (const struct Lisp_Vector *) header; ptrdiff_t size = header->size; enum pvec_type pvectype = PSEUDOVECTOR_TYPE (v); @@ -2702,9 +2634,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF -# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); bool is_stable = dump_hash_table_stable_p (hash_in); /* If the hash table is likely to be modified in memory (either @@ -2770,9 +2699,6 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9 -# error "buffer changed. See CHECK_STRUCTS comment." -#endif struct buffer munged_buffer = *in_buffer; struct buffer *buffer = &munged_buffer; @@ -2906,9 +2832,6 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) static dump_off dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Vector_3091289B35) -# error "Lisp_Vector changed. See CHECK_STRUCTS comment." -#endif /* No relocation needed, so we don't need dump_object_start. */ dump_align_output (ctx, DUMP_ALIGNMENT); eassert (ctx->offset >= ctx->header.cold_start); @@ -2923,9 +2846,6 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_594AB72B54) -# error "Lisp_Subr changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Subr out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); @@ -2962,9 +2882,6 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54) -# error "pvec_type changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Vector *v = XVECTOR (lv); switch (PSEUDOVECTOR_TYPE (v)) { @@ -3072,9 +2989,6 @@ dump_vectorlike (struct dump_context *ctx, static dump_off dump_object (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) -# error "Lisp_Type changed. See CHECK_STRUCTS comment." -#endif #ifdef ENABLE_CHECKING /* Vdead is extern only when ENABLE_CHECKING. */ eassert (!EQ (object, Vdead)); @@ -3177,9 +3091,6 @@ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object) static dump_off dump_charset (struct dump_context *ctx, int cs_i) { -#if CHECK_STRUCTS && !defined (HASH_charset_317C49E291) -# error "charset changed. See CHECK_STRUCTS comment." -#endif dump_align_output (ctx, alignof (int)); const struct charset *cs = charset_table + cs_i; struct charset out; commit 85fbdf027dc03e606c7c4532162148891e41d786 Author: Stefan Monnier Date: Tue Apr 9 18:39:22 2019 -0400 diff-font-lock-syntax: clarify distinction between t and hunk-also * lisp/vc/diff-mode.el (diff-font-lock-syntax): Rework docstring. (diff-syntax-fontify-hunk): Never use the hunk method when diff-font-lock-syntax is just t. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index eeac24376e..8940c7e09a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -116,7 +116,7 @@ You can always manually refine a hunk with `diff-refine-hunk'." "If non-nil, diff hunk font-lock includes source language syntax highlighting. This highlighting is the same as added by `font-lock-mode' when corresponding source files are visited normally. -Syntax highlighting is added over diff own highlighted changes. +Syntax highlighting is added over diff-mode's own highlighted changes. If t, the default, highlight syntax only in Diff buffers created by Diff commands that compare files or by VC commands that compare revisions. @@ -126,17 +126,17 @@ For diffs against the working-tree version of a file, the highlighting is based on the current file contents. File-based fontification tries to infer fontification from the compared files. -If revision-based or file-based method fails, use hunk-based method to get -fontification from hunk alone if the value is `hunk-also'. - -If `hunk-only', fontification is based on hunk alone, without full source. +If `hunk-only' fontification is based on hunk alone, without full source. It tries to highlight hunks without enough context that sometimes might result -in wrong fontification. This is the fastest option, but less reliable." +in wrong fontification. This is the fastest option, but less reliable. + +If `hunk-also', use reliable file-based syntax highlighting when available +and hunk-based syntax highlighting otherwise as a fallback." :version "27.1" :type '(choice (const :tag "Don't highlight syntax" nil) - (const :tag "Hunk-based also" hunk-also) (const :tag "Hunk-based only" hunk-only) - (const :tag "Highlight syntax" t))) + (const :tag "Highlight syntax" t) + (const :tag "Allow hunk-based fallback" hunk-also))) (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -2434,67 +2434,61 @@ When OLD is non-nil, highlight the hunk from the old source." (string-to-number (match-string 2 line))) (list (string-to-number line) 1)))) ; One-line diffs (props - (cond - ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) - (let* ((file (diff-find-file-name old t)) - (revision (and file (if (not old) (nth 1 diff-vc-revisions) - (or (nth 0 diff-vc-revisions) - (vc-working-revision file)))))) - (if file - (if (not revision) - ;; Get properties from the current working revision - (when (and (not old) (file-exists-p file) - (file-regular-p file)) - (let ((buf (get-file-buffer (expand-file-name file)))) - ;; Try to reuse an existing buffer - (if buf - (with-current-buffer buf - (diff-syntax-fontify-props nil text line-nb)) - ;; Get properties from the file - (with-temp-buffer - (insert-file-contents file) - (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - (expand-file-name file) - revision)) - (buffer (gethash buffer-name - diff-syntax-fontify-revisions))) - (unless (and buffer (buffer-live-p buffer)) - (let* ((vc-buffer (ignore-errors - (vc-find-revision-no-save - (expand-file-name file) revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when vc-buffer - (setq buffer vc-buffer) - (puthash buffer-name buffer - diff-syntax-fontify-revisions)))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb))))) - ;; If file is unavailable, get properties from the hunk alone - (setq file (car (diff-hunk-file-names old))) - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))) - ((and diff-default-directory - (not (eq diff-font-lock-syntax 'hunk-only))) - (let ((file (car (diff-hunk-file-names old)))) - (if (and file (file-exists-p file) (file-regular-p file)) - ;; Try to get full text from the file - (with-temp-buffer - (insert-file-contents file) - (diff-syntax-fontify-props file text line-nb)) - ;; Otherwise, get properties from the hunk alone - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))) - ((memq diff-font-lock-syntax '(hunk-also hunk-only)) - (let ((file (car (diff-hunk-file-names old)))) - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))))) + (or + (when (and diff-vc-backend + (not (eq diff-font-lock-syntax 'hunk-only))) + (let* ((file (diff-find-file-name old t)) + (revision (and file (if (not old) (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + (vc-working-revision file)))))) + (when file + (if (not revision) + ;; Get properties from the current working revision + (when (and (not old) (file-exists-p file) + (file-regular-p file)) + (let ((buf (get-file-buffer (expand-file-name file)))) + ;; Try to reuse an existing buffer + (if buf + (with-current-buffer buf + (diff-syntax-fontify-props nil text line-nb)) + ;; Get properties from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))))) + ;; Get properties from a cached revision + (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" + (expand-file-name file) + revision)) + (buffer (gethash buffer-name + diff-syntax-fontify-revisions))) + (unless (and buffer (buffer-live-p buffer)) + (let* ((vc-buffer (ignore-errors + (vc-find-revision-no-save + (expand-file-name file) revision + diff-vc-backend + (get-buffer-create buffer-name))))) + (when vc-buffer + (setq buffer vc-buffer) + (puthash buffer-name buffer + diff-syntax-fontify-revisions)))) + (when buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb)))))))) + (let ((file (car (diff-hunk-file-names old)))) + (cond + ((and file diff-default-directory + (not (eq diff-font-lock-syntax 'hunk-only)) + (not diff-vc-backend) + (file-readable-p file) (file-regular-p file)) + ;; Try to get full text from the file. + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))) + ;; Otherwise, get properties from the hunk alone + ((memq diff-font-lock-syntax '(hunk-also hunk-only)) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t)))))))) ;; Put properties over the hunk text (goto-char beg) commit d96b672f2b738bb6364023c2dcb9111efd3855ed Author: Alex Branham Date: Tue Apr 9 16:27:50 2019 -0500 Use lexical-binding in bug-reference.el * .dir-locals.el: Set bug-reference-url-format in all modes, not just changelog mode. Use (eval . (bug-reference-mode)) as described in (info "(emacs) Specifying File Variables") * lisp/progmodes/bug-reference.el: Use lexical binding. (bug-reference-unfontify): (bug-reference-fontify): Mention args in docstring. Bug#35123 diff --git a/.dir-locals.el b/.dir-locals.el index 9cd39920c2..ffd65c8802 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,6 +1,7 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70))) + (fill-column . 70) + (bug-reference-url-format . "https://debbugs.gnu.org/%s"))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) (electric-quote-comment . nil) @@ -12,8 +13,7 @@ (log-edit-setup-add-author . t))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) - (bug-reference-url-format . "https://debbugs.gnu.org/%s") - (mode . bug-reference))) + (eval . (bug-reference-mode)))) (diff-mode . ((mode . whitespace))) (emacs-lisp-mode . ((indent-tabs-mode . nil) (electric-quote-comment . nil) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 759db1f568..813ecbe384 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -1,4 +1,4 @@ -;; bug-reference.el --- buttonize bug references +;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2019 Free Software Foundation, Inc. @@ -91,7 +91,7 @@ The second subexpression should match the bug reference (usually a number)." (bug-reference-set-overlay-properties) (defun bug-reference-unfontify (start end) - "Remove bug reference overlays from region." + "Remove bug reference overlays from the region between START and END." (dolist (o (overlays-in start end)) (when (eq (overlay-get o 'category) 'bug-reference) (delete-overlay o)))) @@ -99,7 +99,7 @@ The second subexpression should match the bug reference (usually a number)." (defvar bug-reference-prog-mode) (defun bug-reference-fontify (start end) - "Apply bug reference overlays to region." + "Apply bug reference overlays to the region between START and END." (save-excursion (let ((beg-line (progn (goto-char start) (line-beginning-position))) (end-line (progn (goto-char end) (line-end-position)))) commit 6cb49922e63c2523ccdd6e0a6bd72bcfa72c50c6 Author: Basil L. Contovounesios Date: Mon Mar 25 02:15:10 2019 +0000 Fix Gnus duplicate suppression guards (bug#34987) * lisp/gnus/gnus-dup.el (gnus-dup-enter-articles) (gnus-dup-suppress-articles): Use gnus-dup-hashtb as an indicator of initialization instead of gnus-dup-list, which may happen to be nil. (gnus-dup-unsuppress-article): Do nothing if gnus-dup-hashtb is uninitialized. diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index 49022124e9..4981614a17 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -107,7 +107,7 @@ seen in the same session." (defun gnus-dup-enter-articles () "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let (msgid) @@ -133,7 +133,7 @@ seen in the same session." (defun gnus-dup-suppress-articles () "Mark duplicate articles as read." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (gnus-message 8 "Suppressing duplicates...") (let ((auto (and gnus-newsgroup-auto-expire @@ -152,9 +152,10 @@ seen in the same session." (defun gnus-dup-unsuppress-article (article) "Stop suppression of ARTICLE." - (let* ((header (gnus-data-header (gnus-data-find article))) - (id (when header (mail-header-id header)))) - (when id + (let (header id) + (when (and gnus-dup-hashtb + (setq header (gnus-data-header (gnus-data-find article))) + (setq id (mail-header-id header))) (setq gnus-dup-list-dirty t) (setq gnus-dup-list (delete id gnus-dup-list)) (remhash id gnus-dup-hashtb)))) commit 4f19bbb125a706f9657a299df1c5f03c81ed4a71 Author: Stefan Monnier Date: Tue Apr 9 16:28:42 2019 -0400 * lisp/printing.el: Use lexical-binding Require easy-menu instead of adding declarations. Remove backward compatiblity. Remove redundant ':group' args. (pr-region-active-p): Use use-region-p. (pr-set-keymap-name): Delete function and callers. (pr-set-keymap-parents): Delete function; use set-keymap-parent instead. (pr-read-string): Delete function; use read-string instead. (pr-menu-char-height): Delete function; use frame-char-height instead. (pr-menu-char-width): Delete function; use frame-char-width instead. (pr-menu-position): Merge the two definitions. (pr-get-symbol): Delete function; use easy-menu-intern instead. (pr-update-mode-line): Delete function; use force-mode-line-update instead. (pr-do-update-menus): Turn local save-var into dynbound pr--save-var. (pr-menu-alist): Use setf. Simplify since we don't keep key-bindings in the menus any more. (pr-dosify-file-name): Remove interactive spec. (pr-filename-style): Rename from pr-path-style. (pr-unixify-file-name): Delete function. (pr-standard-file-name): Don't turn \ into / under POSIX. (pr-temp-dir): Don't dosify. Use temporary-file-directory unconditionally. (pr-save-file-modes): Delete macro. (pr-ps-directory-using-ghostscript, pr-ps-directory-print) (pr-ps-directory-ps-print, pr-ps-mode-using-ghostscript, pr-ps-print) (pr-ps-mode-preview, pr-ps-mode-print, pr-printify-directory) (pr-txt-directory, pr-ps-file-up-preview, pr-ps-directory-preview) (pr-ps-file-up-ps-print, pr-ps-preview, pr-ps-using-ghostscript): Use properly prefixed, declared, and explicitly let-bound dynamically bound variables around calls to pr-ps-utility-args and pr-set-dir-args. (pr-ps-file-using-ghostscript): Only dosify when passing to suprocess. (pr-expand-file-name): Delete function; use expand-file-name instead. (pr-ps-file-print): Properly dosify. (pr-menu-create): Use backquotes. (pr-eval-alist, pr-eval-local-alist): Use dolist. (pr-ps-utility-args): Don't dosify here. (pr-ps-utility-process): Dosify here instead. (pr-ps-file, pr-command): Don't dosify here either. (pr-interface-map): Move initialization into declaration. (pr-insert-section-1): Use 'push'. (pr-insert-toggle): Use closure instead of backquoted lambda. (pr-insert-menu): Use apply i.s.o eval. (pr-insert-radio-button): Avoid 'eval'. diff --git a/lisp/printing.el b/lisp/printing.el index 27856eb09f..f2495ecda3 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1,4 +1,4 @@ -;;; printing.el --- printing utilities +;;; printing.el --- printing utilities -*- lexical-binding:t -*- ;; Copyright (C) 2000-2001, 2003-2019 Free Software Foundation, Inc. @@ -460,7 +460,7 @@ Please send all bug fixes and enhancements to ;; subjects shows up at the printer. With major mode printing you don't need ;; to switch from gnus *Summary* buffer first. ;; -;; Current global keyboard mapping for GNU Emacs is: +;; Current global keyboard mapping is: ;; ;; (global-set-key [print] 'pr-ps-fast-fire) ;; (global-set-key [M-print] 'pr-ps-mode-using-ghostscript) @@ -468,14 +468,6 @@ Please send all bug fixes and enhancements to ;; (global-set-key [C-print] 'pr-txt-fast-fire) ;; (global-set-key [C-M-print] 'pr-txt-fast-fire) ;; -;; And for XEmacs is: -;; -;; (global-set-key 'f22 'pr-ps-fast-fire) -;; (global-set-key '(meta f22) 'pr-ps-mode-using-ghostscript) -;; (global-set-key '(shift f22) 'pr-ps-mode-using-ghostscript) -;; (global-set-key '(control f22) 'pr-txt-fast-fire) -;; (global-set-key '(control meta f22) 'pr-txt-fast-fire) -;; ;; As a suggestion of global keyboard mapping for some `printing' commands: ;; ;; (global-set-key "\C-ci" 'pr-interface) @@ -493,7 +485,7 @@ Please send all bug fixes and enhancements to ;; Below it's shown a brief description of `printing' options, please, see the ;; options declaration in the code for a long documentation. ;; -;; `pr-path-style' Specify which path style to use for external +;; `pr-filename-style' Specify which filename style to use for external ;; commands. ;; ;; `pr-path-alist' Specify an alist for command paths. @@ -999,7 +991,7 @@ Please send all bug fixes and enhancements to ;; - automagic region detection. ;; - menu entry hiding. ;; - fast fire PostScript printing command. -;; - `pr-path-style' variable. +;; - `pr-filename-style' variable. ;; ;; Thanks to Kim F. Storm for beta-test and for suggestions: ;; - PostScript Print and PostScript Print Preview merge. @@ -1023,7 +1015,7 @@ Please send all bug fixes and enhancements to (require 'lpr) (require 'ps-print) - +(require 'easymenu) (and (string< ps-print-version "6.6.4") (error "`printing' requires `ps-print' package version 6.6.4 or later")) @@ -1038,93 +1030,16 @@ Please send all bug fixes and enhancements to ;; To avoid compilation gripes -;; Emacs has this since at least 21.1. -(when (featurep 'xemacs) - (or (fboundp 'subst-char-in-string) ; hacked from subr.el - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> (setq i (1- i)) 0) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr)))) - - -;; Emacs has this since at least 21.1, but the SUFFIX argument -;; (which this file uses) only since 22.1. So the fboundp test -;; wasn't even correct/adequate. Whatever, no-one is using -;; this file on older Emacs version, so it's irrelevant. -(when (featurep 'xemacs) - (or (fboundp 'make-temp-file) ; hacked from subr.el - (defun make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temporary-file-directory))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask)))))) - - -(eval-when-compile - ;; User Interface --- declared here to avoid compiler warnings - (defvar pr-path-style) - (defvar pr-auto-region) - (defvar pr-menu-char-height) - (defvar pr-menu-char-width) - (defvar pr-menu-lock) - (defvar pr-ps-printer-alist) - (defvar pr-txt-printer-alist) - (defvar pr-ps-utility-alist) - - - ;; Internal fun alias to avoid compilation gripes - (defalias 'pr-menu-lookup 'ignore) - (defalias 'pr-menu-lock 'ignore) - (defalias 'pr-menu-alist 'ignore) - (defalias 'pr-even-or-odd-pages 'ignore) - (defalias 'pr-menu-get-item 'ignore) - (defalias 'pr-menu-set-item-name 'ignore) - (defalias 'pr-menu-set-utility-title 'ignore) - (defalias 'pr-menu-set-ps-title 'ignore) - (defalias 'pr-menu-set-txt-title 'ignore) - (defalias 'pr-region-active-p 'ignore) - (defalias 'pr-do-update-menus 'ignore) - (defalias 'pr-update-mode-line 'ignore) - (defalias 'pr-read-string 'ignore) - (defalias 'pr-set-keymap-parents 'ignore) - (defalias 'pr-keep-region-active 'ignore)) - +;; User Interface --- declared here to avoid compiler warnings +(define-obsolete-variable-alias 'pr-path-style 'pr-filename-style "27.1") +(defvar pr-filename-style) +(defvar pr-auto-region) +(defvar pr-menu-char-height) +(defvar pr-menu-char-width) +(defvar pr-menu-lock) +(defvar pr-ps-printer-alist) +(defvar pr-txt-printer-alist) +(defvar pr-ps-utility-alist) ;; Internal Vars --- defined here to avoid compiler warnings (defvar pr-menu-print-item "print" @@ -1151,480 +1066,206 @@ Used by `pr-menu-bind' and `pr-update-menus'.") ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; XEmacs Definitions - - -(cond - ((featurep 'xemacs) ; XEmacs - ;; XEmacs - (defalias 'pr-set-keymap-parents 'set-keymap-parents) - (defalias 'pr-set-keymap-name 'set-keymap-name) - - ;; XEmacs - (defun pr-read-string (prompt initial history default) - (let ((str (read-string prompt initial))) - (if (and str (not (string= str ""))) - str - default))) - - ;; XEmacs - (defvar zmacs-region-stays nil) - - ;; XEmacs - (defun pr-keep-region-active () - (setq zmacs-region-stays t)) - - ;; XEmacs - (defun pr-region-active-p () - (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p))) - - ;; XEmacs - (defun pr-menu-char-height () - (font-height (face-font 'default))) - - ;; XEmacs - (defun pr-menu-char-width () - (font-width (face-font 'default))) - - ;; XEmacs - (defmacro pr-xemacs-global-menubar (&rest body) - `(save-excursion - (let ((temp (get-buffer-create (make-temp-name " *Temp")))) - ;; be sure to access global menubar - (set-buffer temp) - ,@body - (kill-buffer temp)))) - - ;; XEmacs - (defun pr-global-menubar (pr-menu-spec) - ;; Menu binding - (pr-xemacs-global-menubar - (add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) - (setq pr-menu-print-item nil)) - - ;; XEmacs - (defvar current-mouse-event nil) - (defun pr-menu-position (entry index horizontal) - (make-event - 'button-release - (list 'button 1 - 'x (- (event-x-pixel current-mouse-event) ; X - (* horizontal pr-menu-char-width)) - 'y (- (event-y-pixel current-mouse-event) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))))) - - (defvar pr-menu-position nil) - (defvar pr-menu-state nil) - - ;; XEmacs - (defvar current-menubar nil) ; to avoid compilation gripes - (defun pr-menu-lookup (path) - (car (find-menu-item current-menubar (cons "Printing" path)))) - - ;; XEmacs - (defun pr-menu-lock (entry index horizontal state path) - (when pr-menu-lock - (or (and pr-menu-position (eq state pr-menu-state)) - (setq pr-menu-position (pr-menu-position entry index horizontal) - pr-menu-state state)) - (let* ((menu (pr-menu-lookup path)) - (result (get-popup-menu-response menu pr-menu-position))) - (and (misc-user-event-p result) - (funcall (event-function result) - (event-object result)))) - (setq pr-menu-position nil))) - - ;; XEmacs - (defalias 'pr-update-mode-line 'set-menubar-dirty-flag) - - ;; XEmacs - (defvar pr-ps-name-old "PostScript Printers") - (defvar pr-txt-name-old "Text Printers") - (defvar pr-ps-utility-old "PostScript Utility") - (defvar pr-even-or-odd-old "Print All Pages") - - ;; XEmacs - (defun pr-do-update-menus (&optional force) - (pr-menu-alist pr-ps-printer-alist - 'pr-ps-name - 'pr-menu-set-ps-title - '("Printing") - 'pr-ps-printer-menu-modified - force - pr-ps-name-old - 'postscript 2) - (pr-menu-alist pr-txt-printer-alist - 'pr-txt-name - 'pr-menu-set-txt-title - '("Printing") - 'pr-txt-printer-menu-modified - force - pr-txt-name-old - 'text 2) - (let ((save-var pr-ps-utility-menu-modified)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("Printing" "PostScript Print" "File") - 'save-var - force - pr-ps-utility-old - nil 1)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("Printing" "PostScript Preview" "File") - 'pr-ps-utility-menu-modified - force - pr-ps-utility-old - nil 1) - (pr-even-or-odd-pages ps-even-or-odd-pages force)) - - ;; XEmacs - (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name - entry index) - (when (and alist (or force (symbol-value modified-sym))) - (pr-xemacs-global-menubar - (add-submenu menu-path - (pr-menu-create name alist var-sym - fun entry index))) - (funcall fun (symbol-value var-sym)) - (set modified-sym nil))) - - ;; XEmacs - (defun pr-relabel-menu-item (newname var-sym) - (pr-xemacs-global-menubar - (relabel-menu-item - (list "Printing" (symbol-value var-sym)) - newname) - (set var-sym newname))) - - ;; XEmacs - (defun pr-menu-set-ps-title (value &optional item entry index) - (pr-relabel-menu-item (format "PostScript Printer: %s" value) - 'pr-ps-name-old) - (pr-ps-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; XEmacs - (defun pr-menu-set-txt-title (value &optional item entry index) - (pr-relabel-menu-item (format "Text Printer: %s" value) - 'pr-txt-name-old) - (pr-txt-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; XEmacs - (defun pr-menu-set-utility-title (value &optional item entry index) - (pr-xemacs-global-menubar - (let ((newname (format "%s" value))) - (relabel-menu-item - (list "Printing" "PostScript Print" "File" pr-ps-utility-old) - newname) - (relabel-menu-item - (list "Printing" "PostScript Preview" "File" pr-ps-utility-old) - newname) - (setq pr-ps-utility-old newname))) - (pr-ps-set-utility value) - (and index - (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) - - ;; XEmacs - (defun pr-even-or-odd-pages (value &optional no-lock) - (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist)) - 'pr-even-or-odd-old) - (setq ps-even-or-odd-pages value) - (or no-lock - (pr-menu-lock 'postscript-options 8 12 'toggle nil))) - - ) - (t ; GNU Emacs - ;; Do nothing - )) ; end cond featurep +;; GNU Emacs Definitions +(defun pr-keep-region-active () + (setq deactivate-mark nil)) - -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GNU Emacs Definitions +(defun pr-region-active-p () + (and pr-auto-region (use-region-p))) -(eval-and-compile - (unless (featurep 'xemacs) - (defvar pr-menu-bar nil - "Specify Printing menu-bar entry."))) - -(cond - ((featurep 'xemacs) ; XEmacs - ;; Do nothing - ) - (t ; GNU Emacs - ;; GNU Emacs - (defalias 'pr-set-keymap-parents 'set-keymap-parent) - (defalias 'pr-set-keymap-name 'ignore) - (defalias 'pr-read-string 'read-string) - - ;; GNU Emacs - (defvar deactivate-mark) - - ;; GNU Emacs - (defun pr-keep-region-active () - (setq deactivate-mark nil)) - - ;; GNU Emacs - (defun pr-region-active-p () - (and pr-auto-region transient-mark-mode mark-active)) - - ;; GNU Emacs - (defun pr-menu-char-height () - (frame-char-height)) - - ;; GNU Emacs - (defun pr-menu-char-width () - (frame-char-width)) - - ;; GNU Emacs - ;; Menu binding - ;; Replace existing "print" item by "Printing" item. - ;; If you're changing this file, you'll load it a second, - ;; third... time, but "print" item exists only in the first load. - (eval-when-compile - (require 'easymenu)) ; to avoid compilation gripes - - (declare-function easy-menu-add-item "easymenu" - (map path item &optional before)) - (declare-function easy-menu-remove-item "easymenu" (map path name)) - - (eval-and-compile - (defun pr-global-menubar (pr-menu-spec) - (require 'easymenu) - (let ((menu-file (if (= emacs-major-version 21) - '("menu-bar" "files") ; GNU Emacs 21 - '("menu-bar" "file")))) ; GNU Emacs 22 or higher - (cond - (pr-menu-print-item - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" pr-menu-spec) - "print-buffer") - (dolist (item '("print-buffer" "print-region" - "ps-print-buffer-faces" "ps-print-region-faces" - "ps-print-buffer" "ps-print-region")) - (easy-menu-remove-item global-map menu-file item)) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar - (pr-get-symbol (nth 1 menu-file)) - (pr-get-symbol "Print")))) - (t - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" pr-menu-spec))) - )))) - - (eval-and-compile +;; Menu binding +;; Replace existing "print" item by "Printing" item. +;; If you're changing this file, you'll load it a second, +;; third... time, but "print" item exists only in the first load. + +(defvar pr-menu-bar nil + "Specify Printing menu-bar entry.") + +(defun pr-global-menubar (menu-spec) + (let ((menu-file '("menu-bar" "file"))) (cond - (lpr-windows-system - ;; GNU Emacs for Windows 9x/NT - (defun pr-menu-position (entry index horizontal) - (let ((pos (cdr (mouse-pixel-position)))) - (list - (list (or (car pos) 0) ; X - (- (or (cdr pos) 0) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))) - (selected-frame)))) ; frame - ) + (pr-menu-print-item + (easy-menu-add-item global-map menu-file + (easy-menu-create-menu "Print" menu-spec) + "print-buffer") + (dolist (item '("print-buffer" "print-region" + "ps-print-buffer-faces" "ps-print-region-faces" + "ps-print-buffer" "ps-print-region")) + (easy-menu-remove-item global-map menu-file item)) + (setq pr-menu-print-item nil + pr-menu-bar (vector 'menu-bar + (easy-menu-intern (nth 1 menu-file)) + (easy-menu-intern "Print")))) (t - ;; GNU Emacs - (defun pr-menu-position (entry index horizontal) - (let ((pos (cdr (mouse-pixel-position)))) - (list - (list (- (or (car pos) 0) ; X - (* horizontal pr-menu-char-width)) - (- (or (cdr pos) 0) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))) - (selected-frame)))) ; frame - ))) - - (defvar pr-menu-position nil) - (defvar pr-menu-state nil) - - ;; GNU Emacs - (defun pr-menu-lookup (path) - (lookup-key global-map - (if path - (vconcat pr-menu-bar - (mapcar 'pr-get-symbol - (if (listp path) - path - (list path)))) - pr-menu-bar))) - - ;; GNU Emacs - (defun pr-menu-lock (entry index horizontal state path) - (when pr-menu-lock - (or (and pr-menu-position (eq state pr-menu-state)) - (setq pr-menu-position (pr-menu-position entry index horizontal) - pr-menu-state state)) - (let* ((menu (pr-menu-lookup path)) - (result (x-popup-menu pr-menu-position menu))) - (and result - (let ((command (lookup-key menu (vconcat result)))) - (if (fboundp command) - (funcall command) - (eval command))))) - (setq pr-menu-position nil))) - - ;; GNU Emacs - (defalias 'pr-update-mode-line 'force-mode-line-update) - - ;; GNU Emacs - (defun pr-do-update-menus (&optional force) - (pr-menu-alist pr-ps-printer-alist - 'pr-ps-name - 'pr-menu-set-ps-title - "PostScript Printers" - 'pr-ps-printer-menu-modified - force - "PostScript Printers" - 'postscript 2) - (pr-menu-alist pr-txt-printer-alist - 'pr-txt-name - 'pr-menu-set-txt-title - "Text Printers" - 'pr-txt-printer-menu-modified - force - "Text Printers" - 'text 2) - (let ((save-var pr-ps-utility-menu-modified)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("PostScript Print" "File" "PostScript Utility") - 'save-var - force - "PostScript Utility" - nil 1)) + (easy-menu-add-item global-map menu-file + (easy-menu-create-menu "Print" menu-spec))) + ))) + +(defun pr-menu-position (entry index horizontal) + (let ((pos (cdr (mouse-pixel-position)))) + (list + (list (- (or (car pos) 0) ; X + (if lpr-windows-system + 0 ;; GNU Emacs for Windows 9x/NT + (* horizontal pr-menu-char-width))) + (- (or (cdr pos) 0) ; Y + (* (pr-menu-index entry index) pr-menu-char-height))) + (selected-frame)))) ; frame + +(defvar pr-menu-position nil) +(defvar pr-menu-state nil) + +(defun pr-menu-lookup (path) + (lookup-key global-map + (if path + (vconcat pr-menu-bar + (mapcar #'easy-menu-intern + (if (listp path) + path + (list path)))) + pr-menu-bar))) + +(defun pr-menu-lock (entry index horizontal state path) + (when pr-menu-lock + (or (and pr-menu-position (eq state pr-menu-state)) + (setq pr-menu-position (pr-menu-position entry index horizontal) + pr-menu-state state)) + (let* ((menu (pr-menu-lookup path)) + (result (x-popup-menu pr-menu-position menu))) + (and result + (let ((command (lookup-key menu (vconcat result)))) + (if (fboundp command) + (funcall command) + (eval command))))) + (setq pr-menu-position nil))) + +(defun pr-do-update-menus (&optional force) + (pr-menu-alist pr-ps-printer-alist + 'pr-ps-name + #'pr-menu-set-ps-title + "PostScript Printers" + 'pr-ps-printer-menu-modified + force + "PostScript Printers" + 'postscript 2) + (pr-menu-alist pr-txt-printer-alist + 'pr-txt-name + #'pr-menu-set-txt-title + "Text Printers" + 'pr-txt-printer-menu-modified + force + "Text Printers" + 'text 2) + (defvar pr--save-var) + (let ((pr--save-var pr-ps-utility-menu-modified)) (pr-menu-alist pr-ps-utility-alist 'pr-ps-utility - 'pr-menu-set-utility-title - '("PostScript Preview" "File" "PostScript Utility") - 'pr-ps-utility-menu-modified + #'pr-menu-set-utility-title + '("PostScript Print" "File" "PostScript Utility") + 'pr--save-var force "PostScript Utility" - nil 1) - (pr-even-or-odd-pages ps-even-or-odd-pages force)) - - ;; GNU Emacs - (defun pr-menu-get-item (name-list) - ;; NAME-LIST is a string or a list of strings. - (or (listp name-list) - (setq name-list (list name-list))) - (and name-list - (let* ((reversed (reverse name-list)) - (name (pr-get-symbol (car reversed))) - (path (nreverse (cdr reversed))) - (menu (lookup-key - global-map - (vconcat pr-menu-bar - (mapcar 'pr-get-symbol path))))) - (assq name (nthcdr 2 menu))))) - - ;; GNU Emacs - (defvar pr-temp-menu nil) - - ;; GNU Emacs - (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name - entry index) - (when (and alist (or force (symbol-value modified-sym))) - (easy-menu-define pr-temp-menu nil "" - (pr-menu-create name alist var-sym fun entry index)) - (let ((item (pr-menu-get-item menu-path))) - (and item - (let* ((binding (nthcdr 3 item)) - (key-binding (cdr binding))) - (setcar binding pr-temp-menu) - (and key-binding (listp (car key-binding)) - (setcdr binding (cdr key-binding))) ; skip KEY-BINDING - (funcall fun (symbol-value var-sym) item)))) - (set modified-sym nil))) - - ;; GNU Emacs - (defun pr-menu-set-item-name (item name) - (and item - (setcar (nthcdr 2 item) name))) ; ITEM-NAME - - ;; GNU Emacs - (defun pr-menu-set-ps-title (value &optional item entry index) - (pr-menu-set-item-name (or item - (pr-menu-get-item "PostScript Printers")) - (format "PostScript Printer: %s" value)) - (pr-ps-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; GNU Emacs - (defun pr-menu-set-txt-title (value &optional item entry index) - (pr-menu-set-item-name (or item - (pr-menu-get-item "Text Printers")) - (format "Text Printer: %s" value)) - (pr-txt-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; GNU Emacs - (defun pr-menu-set-utility-title (value &optional item entry index) - (let ((name (symbol-name value))) - (if item - (pr-menu-set-item-name item name) - (pr-menu-set-item-name - (pr-menu-get-item - '("PostScript Print" "File" "PostScript Utility")) - name) - (pr-menu-set-item-name - (pr-menu-get-item - '("PostScript Preview" "File" "PostScript Utility")) - name))) - (pr-ps-set-utility value) - (and index - (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) - - ;; GNU Emacs - (defun pr-even-or-odd-pages (value &optional no-lock) - (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") - (cdr (assq value pr-even-or-odd-alist))) - (setq ps-even-or-odd-pages value) - (or no-lock - (pr-menu-lock 'postscript-options 8 12 'toggle nil))) - - )) ; end cond featurep - + nil 1)) + (pr-menu-alist pr-ps-utility-alist + 'pr-ps-utility + #'pr-menu-set-utility-title + '("PostScript Preview" "File" "PostScript Utility") + 'pr-ps-utility-menu-modified + force + "PostScript Utility" + nil 1) + (pr-even-or-odd-pages ps-even-or-odd-pages force)) + +(defun pr-menu-get-item (name-list) + ;; NAME-LIST is a string or a list of strings. + (or (listp name-list) + (setq name-list (list name-list))) + (and name-list + (let* ((reversed (reverse name-list)) + (name (easy-menu-intern (car reversed))) + (path (nreverse (cdr reversed))) + (menu (lookup-key + global-map + (vconcat pr-menu-bar + (mapcar #'easy-menu-intern path))))) + (assq name (nthcdr 2 menu))))) + +(defvar pr-temp-menu nil) + +(defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name + entry index) + (when (and alist (or force (symbol-value modified-sym))) + (easy-menu-define pr-temp-menu nil "" + (pr-menu-create name alist var-sym fun entry index)) + (let ((item (pr-menu-get-item menu-path))) + (and item + (progn + (setf (nth 3 item) pr-temp-menu) + (funcall fun (symbol-value var-sym) item)))) + (set modified-sym nil))) + +(defun pr-menu-set-item-name (item name) + (and item + (setcar (nthcdr 2 item) name))) ; ITEM-NAME + +(defun pr-menu-set-ps-title (value &optional item entry index) + (pr-menu-set-item-name (or item + (pr-menu-get-item "PostScript Printers")) + (format "PostScript Printer: %s" value)) + (pr-ps-set-printer value) + (and index + (pr-menu-lock entry index 12 'toggle nil))) + +(defun pr-menu-set-txt-title (value &optional item entry index) + (pr-menu-set-item-name (or item + (pr-menu-get-item "Text Printers")) + (format "Text Printer: %s" value)) + (pr-txt-set-printer value) + (and index + (pr-menu-lock entry index 12 'toggle nil))) + +(defun pr-menu-set-utility-title (value &optional item entry index) + (let ((name (symbol-name value))) + (if item + (pr-menu-set-item-name item name) + (pr-menu-set-item-name + (pr-menu-get-item + '("PostScript Print" "File" "PostScript Utility")) + name) + (pr-menu-set-item-name + (pr-menu-get-item + '("PostScript Preview" "File" "PostScript Utility")) + name))) + (pr-ps-set-utility value) + (and index + (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) + +(defun pr-even-or-odd-pages (value &optional no-lock) + (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") + (cdr (assq value pr-even-or-odd-alist))) + (setq ps-even-or-odd-pages value) + (or no-lock + (pr-menu-lock 'postscript-options 8 12 'toggle nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Functions (I) -(defun pr-dosify-file-name (path) +(defun pr-dosify-file-name (filename) "Replace unix-style directory separator character with dos/windows one." - (interactive "sPath: ") - (if (eq pr-path-style 'windows) - (subst-char-in-string ?/ ?\\ path) - path)) - + (if (eq pr-filename-style 'windows) + (subst-char-in-string ?/ ?\\ filename) + filename)) -(defun pr-unixify-file-name (path) - "Replace dos/windows-style directory separator character with unix one." - (interactive "sPath: ") - (if (eq pr-path-style 'windows) - (subst-char-in-string ?\\ ?/ path) - path)) - - -(defun pr-standard-file-name (path) +(defun pr-standard-file-name (filename) "Ensure the proper directory separator depending on the OS. That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory separator; otherwise, ensure unix-style directory separator." + ;; FIXME: Why not use pr-dosify-file-name? (if (or pr-cygwin-system lpr-windows-system) - (subst-char-in-string ?/ ?\\ path) - (subst-char-in-string ?\\ ?/ path))) - + (subst-char-in-string ?/ ?\\ filename) + filename)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customization Functions @@ -1672,22 +1313,21 @@ separator; otherwise, ensure unix-style directory separator." :group 'postscript) -(defcustom pr-path-style +(defcustom pr-filename-style (if (and (not pr-cygwin-system) lpr-windows-system) 'windows 'unix) - "Specify which path style to use for external commands. + "Specify which filename style to use for external commands. Valid values are: windows Windows 9x/NT style (\\) unix Unix style (/)" - :type '(choice :tag "Path style" + :type '(choice :tag "Filename style" (const :tag "Windows 9x/NT Style (\\)" :value windows) - (const :tag "Unix Style (/)" :value unix)) - :group 'printing) + (const :tag "Unix Style (/)" :value unix))) (defcustom pr-path-alist @@ -1708,13 +1348,13 @@ Where: ENTRY It's a symbol, used to identify this entry. There must exist at least one of the following entries: - unix this entry is used when Emacs is running on GNU or + `unix' this entry is used when Emacs is running on GNU or Unix system. - cygwin this entry is used when Emacs is running on Windows + `cygwin' this entry is used when Emacs is running on Windows 95/98/NT/2000 with Cygwin. - windows this entry is used when Emacs is running on Windows + `windows' this entry is used when Emacs is running on Windows 95/98/NT/2000. DIRECTORY It should be a string or a symbol. If it's a symbol, it should @@ -1764,8 +1404,7 @@ Examples: (choice :menu-tag "Directory" :tag "Directory" (string :value "") - (symbol :value symbol))))) - :group 'printing) + (symbol :value symbol)))))) (defcustom pr-txt-name 'default @@ -1778,8 +1417,7 @@ This variable should be modified by customization engine. If this variable is modified by other means (for example, a lisp function), use `pr-update-menus' function (see it for documentation) to update text printer menu." :type 'symbol - :set 'pr-txt-name-custom-set - :group 'printing) + :set 'pr-txt-name-custom-set) (defcustom pr-txt-printer-alist @@ -1910,8 +1548,7 @@ Useful links: :tag "Printer Name" (const :tag "None" nil) string))) - :set 'pr-alist-custom-set - :group 'printing) + :set 'pr-alist-custom-set) (defcustom pr-ps-name 'default @@ -1924,8 +1561,7 @@ This variable should be modified by customization engine. If this variable is modified by other means (for example, a lisp function), use `pr-update-menus' function (see it for documentation) to update PostScript printer menu." :type 'symbol - :set 'pr-ps-name-custom-set - :group 'printing) + :set 'pr-ps-name-custom-set) (defcustom pr-ps-printer-alist @@ -2196,33 +1832,21 @@ Useful links: (variable :tag "Other")) (sexp :tag "Value"))) )) - :set 'pr-alist-custom-set - :group 'printing) - - -(defcustom pr-temp-dir - (pr-dosify-file-name - (if (boundp 'temporary-file-directory) - (symbol-value 'temporary-file-directory) - ;; hacked from `temporary-file-directory' variable in files.el - (file-name-as-directory - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (cond (lpr-windows-system "c:/temp") - (t "/tmp") - ))))) + :set 'pr-alist-custom-set) + + +(defcustom pr-temp-dir temporary-file-directory "Specify a directory for temporary files during printing. See also `pr-ps-temp-file' and `pr-file-modes'." - :type '(directory :tag "Temporary Directory") - :group 'printing) + :type '(directory :tag "Temporary Directory")) (defcustom pr-ps-temp-file "prspool-" "Specify PostScript temporary file name prefix. See also `pr-temp-dir' and `pr-file-modes'." - :type '(file :tag "PostScript Temporary File Name") - :group 'printing) + :type '(file :tag "PostScript Temporary File Name")) ;; It uses 0600 as default instead of (default-file-modes). @@ -2234,8 +1858,7 @@ See also `pr-temp-dir' and `pr-file-modes'." It should be an integer; only the low 9 bits are used. See also `pr-temp-dir' and `pr-ps-temp-file'." - :type '(integer :tag "File Permission Bits") - :group 'printing) + :type '(integer :tag "File Permission Bits")) (defcustom pr-gv-command @@ -2275,8 +1898,7 @@ Useful links: * MacGSView (Mac OS) `http://www.cs.wisc.edu/~ghost/macos/index.htm' " - :type '(string :tag "Ghostview Utility") - :group 'printing) + :type '(string :tag "Ghostview Utility")) (defcustom pr-gs-command @@ -2301,8 +1923,7 @@ Useful links: * Printer compatibility `http://www.cs.wisc.edu/~ghost/doc/printer.htm' " - :type '(string :tag "Ghostscript Utility") - :group 'printing) + :type '(string :tag "Ghostscript Utility")) (defcustom pr-gs-switches @@ -2343,8 +1964,7 @@ Useful links: * Printer compatibility `http://www.cs.wisc.edu/~ghost/doc/printer.htm' " - :type '(repeat (string :tag "Ghostscript Switch")) - :group 'printing) + :type '(repeat (string :tag "Ghostscript Switch"))) (defcustom pr-gs-device @@ -2359,8 +1979,7 @@ A note on the gs switches: See `pr-gs-switches' for documentation. See also `pr-ps-printer-alist'." - :type '(string :tag "Ghostscript Device") - :group 'printing) + :type '(string :tag "Ghostscript Device")) (defcustom pr-gs-resolution 300 @@ -2372,8 +1991,7 @@ A note on the gs switches: See `pr-gs-switches' for documentation. See also `pr-ps-printer-alist'." - :type '(integer :tag "Ghostscript Resolution") - :group 'printing) + :type '(integer :tag "Ghostscript Resolution")) (defcustom pr-print-using-ghostscript nil @@ -2384,32 +2002,27 @@ ghostscript to print a PostScript file. In GNU or Unix system, if ghostscript is set as a PostScript filter, this variable should be nil." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-faces-p nil "Non-nil means print with face attributes." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-spool-p nil "Non-nil means spool printing in a buffer." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-landscape nil "Non-nil means print PostScript file in landscape orientation." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-duplex nil "Non-nil means print PostScript file in duplex mode." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-tumble nil @@ -2419,8 +2032,7 @@ If tumble is off, produces a printing suitable for binding on the left or right. If tumble is on, produces a printing suitable for binding at the top or bottom." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-auto-region t @@ -2431,8 +2043,7 @@ Note that this will only work if you're using transient mark mode. When this variable is non-nil, the `*-buffer*' commands will behave like `*-region*' commands, that is, `*-buffer*' commands will print only the region marked instead of all buffer." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-auto-mode t @@ -2442,8 +2053,7 @@ That is, if current major-mode is declared in `pr-mode-alist', the `*-buffer*' and `*-region*' commands will behave like `*-mode*' commands; otherwise, `*-buffer*' commands will print the current buffer and `*-region*' commands will print the current region." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-mode-alist @@ -2642,8 +2252,7 @@ DEFAULT It's a way to set default values when this entry is selected. (const :tag "inherits-from:" inherits-from:) (variable :tag "Other")) (sexp :tag "Value"))) - )) - :group 'printing) + ))) (defcustom pr-ps-utility 'mpage @@ -2659,8 +2268,7 @@ function (see it for documentation) to update PostScript utility menu. NOTE: Don't forget to download and install the utilities declared on `pr-ps-utility-alist'." :type '(symbol :tag "PS File Utility") - :set 'pr-ps-utility-custom-set - :group 'printing) + :set 'pr-ps-utility-custom-set) (defcustom pr-ps-utility-alist @@ -2871,38 +2479,34 @@ Useful links: (variable :tag "Other")) (sexp :tag "Value"))) )) - :set 'pr-alist-custom-set - :group 'printing) + :set 'pr-alist-custom-set) (defcustom pr-menu-lock t "Non-nil means menu is locked while selecting toggle options. See also `pr-menu-char-height' and `pr-menu-char-width'." - :type 'boolean - :group 'printing) + :type 'boolean) -(defcustom pr-menu-char-height (pr-menu-char-height) +(defcustom pr-menu-char-height (frame-char-height) "Specify menu char height in pixels. This variable is used to guess which vertical position should be locked the menu, so don't forget to adjust it if menu position is not ok. See also `pr-menu-lock' and `pr-menu-char-width'." - :type 'integer - :group 'printing) + :type 'integer) -(defcustom pr-menu-char-width (pr-menu-char-width) +(defcustom pr-menu-char-width (frame-char-width) "Specify menu char width in pixels. This variable is used to guess which horizontal position should be locked the menu, so don't forget to adjust it if menu position is not ok. See also `pr-menu-lock' and `pr-menu-char-height'." - :type 'integer - :group 'printing) + :type 'integer) (defcustom pr-setting-database @@ -3017,8 +2621,7 @@ SETTING It's a cons like: (const :tag "Ghostscript Resolution" pr-gs-resolution) (variable :tag "Other")) (sexp :tag "Value"))) - )) - :group 'printing) + ))) (defcustom pr-visible-entry-list @@ -3070,8 +2673,7 @@ Any other value is ignored." (const postscript-options) (const postscript-process) (const printing) - (const help))) - :group 'printing) + (const help)))) (defcustom pr-delete-temp-file t @@ -3081,8 +2683,7 @@ Set `pr-delete-temp-file' to nil, if the following message (or a similar) happens when printing: Error: could not open \"c:\\temp\\prspool.ps\" for reading." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-list-directory nil @@ -3094,16 +2695,14 @@ argument of functions below) are also printed (as dired-mode listings). It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript', `pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory' and `pr-txt-directory'." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-buffer-name "*Printing Interface*" "Specify the name of the buffer interface for printing package. It's used by `pr-interface'." - :type 'string - :group 'printing) + :type 'string) (defcustom pr-buffer-name-ignore @@ -3115,16 +2714,14 @@ NOTE: Case is important for matching, that is, `case-fold-search' is always nil. It's used by `pr-interface'." - :type '(repeat (regexp :tag "Buffer Name Regexp")) - :group 'printing) + :type '(repeat (regexp :tag "Buffer Name Regexp"))) (defcustom pr-buffer-verbose t "Non-nil means to be verbose when editing a field in interface buffer. It's used by `pr-interface'." - :type 'boolean - :group 'printing) + :type 'boolean) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3166,15 +2763,6 @@ See `pr-ps-printer-alist'.") See `pr-ps-printer-alist'.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Macros - - -(defmacro pr-save-file-modes (&rest body) - "Execute BODY with file permissions temporarily set to `pr-file-modes'." - (declare (obsolete with-file-modes "25.1")) - `(with-file-modes pr-file-modes ,@body)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keys & Menus @@ -3195,252 +2783,211 @@ See `pr-ps-printer-alist'.") (and pr-print-using-ghostscript (not pr-spool-p))) -(defalias 'pr-get-symbol - (if (featurep 'emacs) 'easy-menu-intern ; since 22.1 - (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el - 'easy-menu-intern - (lambda (s) (if (stringp s) (intern s) s))))) - - (defconst pr-menu-spec - ;; Menu mapping: - ;; unfortunately XEmacs doesn't support :active for submenus, - ;; only for items. - ;; So, it uses :included instead of :active. - ;; Also, XEmacs doesn't support :help tag. - (let ((pr-:active (if (featurep 'xemacs) - :included ; XEmacs - :active)) ; GNU Emacs - (pr-:help (if (featurep 'xemacs) - 'ignore ; XEmacs - #'(lambda (text) (list :help text))))) ; GNU Emacs - `( - ["Printing Interface" pr-interface - ,@(funcall - pr-:help "Use buffer interface instead of menu interface")] + '( + ["Printing Interface" pr-interface + :help "Use buffer interface instead of menu interface"] + "--" + ("PostScript Preview" :included (pr-visible-p 'postscript) + :help "Preview PostScript instead of sending to printer" + ("Directory" :active (not pr-spool-p) + ["1-up" (pr-ps-directory-preview 1 nil nil t) t] + ["2-up" (pr-ps-directory-preview 2 nil nil t) t] + ["4-up" (pr-ps-directory-preview 4 nil nil t) t] + ["Other..." (pr-ps-directory-preview nil nil nil t) + :keys "\\[pr-ps-buffer-preview]"]) + ("Buffer" :active (not pr-spool-p) + ["1-up" (pr-ps-buffer-preview 1 t) t] + ["2-up" (pr-ps-buffer-preview 2 t) t] + ["4-up" (pr-ps-buffer-preview 4 t) t] + ["Other..." (pr-ps-buffer-preview nil t) + :keys "\\[pr-ps-buffer-preview]"]) + ("Region" :active (and (not pr-spool-p) (ps-mark-active-p)) + ["1-up" (pr-ps-region-preview 1 t) t] + ["2-up" (pr-ps-region-preview 2 t) t] + ["4-up" (pr-ps-region-preview 4 t) t] + ["Other..." (pr-ps-region-preview nil t) + :keys "\\[pr-ps-region-preview]"]) + ("Mode" :active (and (not pr-spool-p) (pr-mode-alist-p)) + ["1-up" (pr-ps-mode-preview 1 t) t] + ["2-up" (pr-ps-mode-preview 2 t) t] + ["4-up" (pr-ps-mode-preview 4 t) t] + ["Other..." (pr-ps-mode-preview nil t) + :keys "\\[pr-ps-mode-preview]"]) + ("File" + ["No Preprocessing..." (call-interactively 'pr-ps-file-preview) + :keys "\\[pr-ps-file-preview]" + :help "Preview PostScript file"] "--" - ("PostScript Preview" :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Preview PostScript instead of sending to printer") - ("Directory" ,pr-:active (not pr-spool-p) - ["1-up" (pr-ps-directory-preview 1 nil nil t) t] - ["2-up" (pr-ps-directory-preview 2 nil nil t) t] - ["4-up" (pr-ps-directory-preview 4 nil nil t) t] - ["Other..." (pr-ps-directory-preview nil nil nil t) - :keys "\\[pr-ps-buffer-preview]"]) - ("Buffer" ,pr-:active (not pr-spool-p) - ["1-up" (pr-ps-buffer-preview 1 t) t] - ["2-up" (pr-ps-buffer-preview 2 t) t] - ["4-up" (pr-ps-buffer-preview 4 t) t] - ["Other..." (pr-ps-buffer-preview nil t) - :keys "\\[pr-ps-buffer-preview]"]) - ("Region" ,pr-:active (and (not pr-spool-p) (ps-mark-active-p)) - ["1-up" (pr-ps-region-preview 1 t) t] - ["2-up" (pr-ps-region-preview 2 t) t] - ["4-up" (pr-ps-region-preview 4 t) t] - ["Other..." (pr-ps-region-preview nil t) - :keys "\\[pr-ps-region-preview]"]) - ("Mode" ,pr-:active (and (not pr-spool-p) (pr-mode-alist-p)) - ["1-up" (pr-ps-mode-preview 1 t) t] - ["2-up" (pr-ps-mode-preview 2 t) t] - ["4-up" (pr-ps-mode-preview 4 t) t] - ["Other..." (pr-ps-mode-preview nil t) - :keys "\\[pr-ps-mode-preview]"]) - ("File" - ["No Preprocessing..." (call-interactively 'pr-ps-file-preview) - :keys "\\[pr-ps-file-preview]" - ,@(funcall - pr-:help "Preview PostScript file")] - "--" - ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist - ,@(funcall - pr-:help "Select PostScript utility")] - "--" - ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist] - ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist] - ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist] - ["Other..." (pr-ps-file-up-preview nil t t) - :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist] - "--" - ["Landscape" pr-toggle-file-landscape-menu - :style toggle :selected pr-file-landscape - ,@(funcall - pr-:help "Toggle landscape for PostScript file") - :active pr-ps-utility-alist] - ["Duplex" pr-toggle-file-duplex-menu - :style toggle :selected pr-file-duplex - ,@(funcall - pr-:help "Toggle duplex for PostScript file") - :active pr-ps-utility-alist] - ["Tumble" pr-toggle-file-tumble-menu - :style toggle :selected pr-file-tumble - ,@(funcall - pr-:help "Toggle tumble for PostScript file") - :active (and pr-file-duplex pr-ps-utility-alist)]) - ["Despool..." (call-interactively 'pr-despool-preview) - :active pr-spool-p :keys "\\[pr-despool-preview]" - ,@(funcall - pr-:help "Despool PostScript buffer to printer or file (C-u)")]) - ("PostScript Print" :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Send PostScript to printer or file (C-u)") - ("Directory" - ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t] - ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t] - ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t] - ["Other..." (pr-ps-directory-ps-print nil nil nil t) - :keys "\\[pr-ps-buffer-ps-print]"]) - ("Buffer" - ["1-up" (pr-ps-buffer-ps-print 1 t) t] - ["2-up" (pr-ps-buffer-ps-print 2 t) t] - ["4-up" (pr-ps-buffer-ps-print 4 t) t] - ["Other..." (pr-ps-buffer-ps-print nil t) - :keys "\\[pr-ps-buffer-ps-print]"]) - ("Region" ,pr-:active (ps-mark-active-p) - ["1-up" (pr-ps-region-ps-print 1 t) t] - ["2-up" (pr-ps-region-ps-print 2 t) t] - ["4-up" (pr-ps-region-ps-print 4 t) t] - ["Other..." (pr-ps-region-ps-print nil t) - :keys "\\[pr-ps-region-ps-print]"]) - ("Mode" ,pr-:active (pr-mode-alist-p) - ["1-up" (pr-ps-mode-ps-print 1 t) t] - ["2-up" (pr-ps-mode-ps-print 2 t) t] - ["4-up" (pr-ps-mode-ps-print 4 t) t] - ["Other..." (pr-ps-mode-ps-print nil t) - :keys "\\[pr-ps-mode-ps-print]"]) - ("File" - ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print) - :keys "\\[pr-ps-file-ps-print]" - ,@(funcall - pr-:help "Send PostScript file to printer")] - "--" - ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist - ,@(funcall - pr-:help "Select PostScript utility")] - "--" - ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist] - ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist] - ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist] - ["Other..." (pr-ps-file-up-ps-print nil t t) - :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist] - "--" - ["Landscape" pr-toggle-file-landscape-menu - :style toggle :selected pr-file-landscape - ,@(funcall - pr-:help "Toggle landscape for PostScript file") - :active pr-ps-utility-alist] - ["Duplex" pr-toggle-file-duplex-menu - :style toggle :selected pr-file-duplex - ,@(funcall - pr-:help "Toggle duplex for PostScript file") - :active pr-ps-utility-alist] - ["Tumble" pr-toggle-file-tumble-menu - :style toggle :selected pr-file-tumble - ,@(funcall - pr-:help "Toggle tumble for PostScript file") - :active (and pr-file-duplex pr-ps-utility-alist)]) - ["Despool..." (call-interactively 'pr-despool-ps-print) - :active pr-spool-p :keys "\\[pr-despool-ps-print]" - ,@(funcall - pr-:help "Despool PostScript buffer to printer or file (C-u)")]) - ["PostScript Printers" pr-update-menus - :active pr-ps-printer-alist :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Select PostScript printer")] + ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist + :help "Select PostScript utility"] "--" - ("Printify" :included (pr-visible-p 'text) - ,@(funcall - pr-:help - "Replace non-printing chars with printable representations.") - ["Directory" pr-printify-directory t] - ["Buffer" pr-printify-buffer t] - ["Region" pr-printify-region (ps-mark-active-p)]) - ("Print" :included (pr-visible-p 'text) - ,@(funcall - pr-:help "Send text to printer") - ["Directory" pr-txt-directory t] - ["Buffer" pr-txt-buffer t] - ["Region" pr-txt-region (ps-mark-active-p)] - ["Mode" pr-txt-mode (pr-mode-alist-p)]) - ["Text Printers" pr-update-menus - :active pr-txt-printer-alist :included (pr-visible-p 'text) - ,@(funcall - pr-:help "Select text printer")] + ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist] + ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist] + ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist] + ["Other..." (pr-ps-file-up-preview nil t t) + :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist] "--" - ["Landscape" pr-toggle-landscape-menu - :style toggle :selected ps-landscape-mode - :included (pr-visible-p 'postscript-options)] - ["Print Header" pr-toggle-header-menu - :style toggle :selected ps-print-header - :included (pr-visible-p 'postscript-options)] - ["Print Header Frame" pr-toggle-header-frame-menu - :style toggle :selected ps-print-header-frame :active ps-print-header - :included (pr-visible-p 'postscript-options)] - ["Line Number" pr-toggle-line-menu - :style toggle :selected ps-line-number - :included (pr-visible-p 'postscript-options)] - ["Zebra Stripes" pr-toggle-zebra-menu - :style toggle :selected ps-zebra-stripes - :included (pr-visible-p 'postscript-options)] - ["Duplex" pr-toggle-duplex-menu - :style toggle :selected ps-spool-duplex - :included (pr-visible-p 'postscript-options)] - ["Tumble" pr-toggle-tumble-menu - :style toggle :selected ps-spool-tumble :active ps-spool-duplex - :included (pr-visible-p 'postscript-options)] - ["Upside-Down" pr-toggle-upside-down-menu - :style toggle :selected ps-print-upside-down - :included (pr-visible-p 'postscript-options)] - ("Print All Pages" :included (pr-visible-p 'postscript-options) - ,@(funcall - pr-:help "Select odd/even pages/sheets to print") - ["All Pages" (pr-even-or-odd-pages nil) - :style radio :selected (eq ps-even-or-odd-pages nil)] - ["Even Pages" (pr-even-or-odd-pages 'even-page) - :style radio :selected (eq ps-even-or-odd-pages 'even-page)] - ["Odd Pages" (pr-even-or-odd-pages 'odd-page) - :style radio :selected (eq ps-even-or-odd-pages 'odd-page)] - ["Even Sheets" (pr-even-or-odd-pages 'even-sheet) - :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)] - ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet) - :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)]) + ["Landscape" pr-toggle-file-landscape-menu + :style toggle :selected pr-file-landscape + :help "Toggle landscape for PostScript file" + :active pr-ps-utility-alist] + ["Duplex" pr-toggle-file-duplex-menu + :style toggle :selected pr-file-duplex + :help "Toggle duplex for PostScript file" + :active pr-ps-utility-alist] + ["Tumble" pr-toggle-file-tumble-menu + :style toggle :selected pr-file-tumble + :help "Toggle tumble for PostScript file" + :active (and pr-file-duplex pr-ps-utility-alist)]) + ["Despool..." (call-interactively 'pr-despool-preview) + :active pr-spool-p :keys "\\[pr-despool-preview]" + :help "Despool PostScript buffer to printer or file (C-u)"]) + ("PostScript Print" :included (pr-visible-p 'postscript) + :help "Send PostScript to printer or file (C-u)" + ("Directory" + ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t] + ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t] + ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t] + ["Other..." (pr-ps-directory-ps-print nil nil nil t) + :keys "\\[pr-ps-buffer-ps-print]"]) + ("Buffer" + ["1-up" (pr-ps-buffer-ps-print 1 t) t] + ["2-up" (pr-ps-buffer-ps-print 2 t) t] + ["4-up" (pr-ps-buffer-ps-print 4 t) t] + ["Other..." (pr-ps-buffer-ps-print nil t) + :keys "\\[pr-ps-buffer-ps-print]"]) + ("Region" :active (ps-mark-active-p) + ["1-up" (pr-ps-region-ps-print 1 t) t] + ["2-up" (pr-ps-region-ps-print 2 t) t] + ["4-up" (pr-ps-region-ps-print 4 t) t] + ["Other..." (pr-ps-region-ps-print nil t) + :keys "\\[pr-ps-region-ps-print]"]) + ("Mode" :active (pr-mode-alist-p) + ["1-up" (pr-ps-mode-ps-print 1 t) t] + ["2-up" (pr-ps-mode-ps-print 2 t) t] + ["4-up" (pr-ps-mode-ps-print 4 t) t] + ["Other..." (pr-ps-mode-ps-print nil t) + :keys "\\[pr-ps-mode-ps-print]"]) + ("File" + ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print) + :keys "\\[pr-ps-file-ps-print]" + :help "Send PostScript file to printer"] "--" - ["Spool Buffer" pr-toggle-spool-menu - :style toggle :selected pr-spool-p - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript spooling")] - ["Print with faces" pr-toggle-faces-menu - :style toggle :selected pr-faces-p - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript printing with faces")] - ["Print via Ghostscript" pr-toggle-ghostscript-menu - :style toggle :selected pr-print-using-ghostscript - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript generation using ghostscript")] + ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist + :help "Select PostScript utility"] "--" - ["Auto Region" pr-toggle-region-menu - :style toggle :selected pr-auto-region - :included (pr-visible-p 'printing)] - ["Auto Mode" pr-toggle-mode-menu - :style toggle :selected pr-auto-mode - :included (pr-visible-p 'printing)] - ["Menu Lock" pr-toggle-lock-menu - :style toggle :selected pr-menu-lock - :included (pr-visible-p 'printing)] + ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist] + ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist] + ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist] + ["Other..." (pr-ps-file-up-ps-print nil t t) + :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist] "--" - ("Customize" :included (pr-visible-p 'help) - ["printing" pr-customize t] - ["ps-print" ps-print-customize t] - ["lpr" lpr-customize t]) - ("Show Settings" :included (pr-visible-p 'help) - ["printing" pr-show-pr-setup t] - ["ps-print" pr-show-ps-setup t] - ["lpr" pr-show-lpr-setup t]) - ["Help" pr-help :active t :included (pr-visible-p 'help)] - ))) + ["Landscape" pr-toggle-file-landscape-menu + :style toggle :selected pr-file-landscape + :help "Toggle landscape for PostScript file" + :active pr-ps-utility-alist] + ["Duplex" pr-toggle-file-duplex-menu + :style toggle :selected pr-file-duplex + :help "Toggle duplex for PostScript file" + :active pr-ps-utility-alist] + ["Tumble" pr-toggle-file-tumble-menu + :style toggle :selected pr-file-tumble + :help "Toggle tumble for PostScript file" + :active (and pr-file-duplex pr-ps-utility-alist)]) + ["Despool..." (call-interactively 'pr-despool-ps-print) + :active pr-spool-p :keys "\\[pr-despool-ps-print]" + :help "Despool PostScript buffer to printer or file (C-u)"]) + ["PostScript Printers" pr-update-menus + :active pr-ps-printer-alist :included (pr-visible-p 'postscript) + :help "Select PostScript printer"] + "--" + ("Printify" :included (pr-visible-p 'text) + :help + "Replace non-printing chars with printable representations." + ["Directory" pr-printify-directory t] + ["Buffer" pr-printify-buffer t] + ["Region" pr-printify-region (ps-mark-active-p)]) + ("Print" :included (pr-visible-p 'text) + :help "Send text to printer" + ["Directory" pr-txt-directory t] + ["Buffer" pr-txt-buffer t] + ["Region" pr-txt-region (ps-mark-active-p)] + ["Mode" pr-txt-mode (pr-mode-alist-p)]) + ["Text Printers" pr-update-menus + :active pr-txt-printer-alist :included (pr-visible-p 'text) + :help "Select text printer"] + "--" + ["Landscape" pr-toggle-landscape-menu + :style toggle :selected ps-landscape-mode + :included (pr-visible-p 'postscript-options)] + ["Print Header" pr-toggle-header-menu + :style toggle :selected ps-print-header + :included (pr-visible-p 'postscript-options)] + ["Print Header Frame" pr-toggle-header-frame-menu + :style toggle :selected ps-print-header-frame :active ps-print-header + :included (pr-visible-p 'postscript-options)] + ["Line Number" pr-toggle-line-menu + :style toggle :selected ps-line-number + :included (pr-visible-p 'postscript-options)] + ["Zebra Stripes" pr-toggle-zebra-menu + :style toggle :selected ps-zebra-stripes + :included (pr-visible-p 'postscript-options)] + ["Duplex" pr-toggle-duplex-menu + :style toggle :selected ps-spool-duplex + :included (pr-visible-p 'postscript-options)] + ["Tumble" pr-toggle-tumble-menu + :style toggle :selected ps-spool-tumble :active ps-spool-duplex + :included (pr-visible-p 'postscript-options)] + ["Upside-Down" pr-toggle-upside-down-menu + :style toggle :selected ps-print-upside-down + :included (pr-visible-p 'postscript-options)] + ("Print All Pages" :included (pr-visible-p 'postscript-options) + :help "Select odd/even pages/sheets to print" + ["All Pages" (pr-even-or-odd-pages nil) + :style radio :selected (eq ps-even-or-odd-pages nil)] + ["Even Pages" (pr-even-or-odd-pages 'even-page) + :style radio :selected (eq ps-even-or-odd-pages 'even-page)] + ["Odd Pages" (pr-even-or-odd-pages 'odd-page) + :style radio :selected (eq ps-even-or-odd-pages 'odd-page)] + ["Even Sheets" (pr-even-or-odd-pages 'even-sheet) + :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)] + ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet) + :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)]) + "--" + ["Spool Buffer" pr-toggle-spool-menu + :style toggle :selected pr-spool-p + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript spooling"] + ["Print with faces" pr-toggle-faces-menu + :style toggle :selected pr-faces-p + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript printing with faces"] + ["Print via Ghostscript" pr-toggle-ghostscript-menu + :style toggle :selected pr-print-using-ghostscript + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript generation using ghostscript"] + "--" + ["Auto Region" pr-toggle-region-menu + :style toggle :selected pr-auto-region + :included (pr-visible-p 'printing)] + ["Auto Mode" pr-toggle-mode-menu + :style toggle :selected pr-auto-mode + :included (pr-visible-p 'printing)] + ["Menu Lock" pr-toggle-lock-menu + :style toggle :selected pr-menu-lock + :included (pr-visible-p 'printing)] + "--" + ("Customize" :included (pr-visible-p 'help) + ["printing" pr-customize t] + ["ps-print" ps-print-customize t] + ["lpr" lpr-customize t]) + ("Show Settings" :included (pr-visible-p 'help) + ["printing" pr-show-pr-setup t] + ["ps-print" pr-show-ps-setup t] + ["lpr" pr-show-lpr-setup t]) + ["Help" pr-help :active t :included (pr-visible-p 'help)] + )) (defun pr-menu-bind () @@ -3453,19 +3000,17 @@ Calls `pr-update-menus' to adjust menus." ;; Key binding -(let ((pr-print-key (if (featurep 'xemacs) - 'f22 ; XEmacs - 'print))) ; GNU Emacs - (global-set-key `[,pr-print-key] 'pr-ps-fast-fire) - ;; Well, M-print and S-print are used because in my keyboard S-print works - ;; and M-print doesn't. But M-print can work in other keyboard. - (global-set-key `[(meta ,pr-print-key)] 'pr-ps-mode-using-ghostscript) - (global-set-key `[(shift ,pr-print-key)] 'pr-ps-mode-using-ghostscript) - ;; Well, C-print and C-M-print are used because in my keyboard C-M-print works - ;; and C-print doesn't. But C-print can work in other keyboard. - (global-set-key `[(control ,pr-print-key)] 'pr-txt-fast-fire) - (global-set-key `[(control meta ,pr-print-key)] 'pr-txt-fast-fire)) - +;; FIXME: These should be moved to a function so that just loading the file +;; doesn't affect the global keymap! +(global-set-key [print] 'pr-ps-fast-fire) +;; Well, M-print and S-print are used because on my keyboard S-print works +;; and M-print doesn't. But M-print can work on other keyboards. +(global-set-key [(meta print)] 'pr-ps-mode-using-ghostscript) +(global-set-key [(shift print)] 'pr-ps-mode-using-ghostscript) +;; Well, C-print and C-M-print are used because in my keyboard C-M-print works +;; and C-print doesn't. But C-print can work in other keyboard. +(global-set-key [(control print)] 'pr-txt-fast-fire) +(global-set-key [(control meta print)] 'pr-txt-fast-fire) ;;; You can also use something like: ;;;(global-set-key "\C-ci" 'pr-interface) @@ -3962,13 +3507,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS preview dir"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS preview dir")) - (setq filename (pr-ps-file filename)) - (pr-ps-file-list n-up dir file-regexp filename) - (or pr-spool-p - (pr-ps-file-preview filename))) - + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS preview dir")) + (setq pr--filename (pr-ps-file pr--filename)) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp pr--filename) + (or pr-spool-p + (pr-ps-file-preview pr--filename)))) ;;;###autoload (defun pr-ps-directory-using-ghostscript (n-up dir file-regexp &optional filename) @@ -3988,12 +3536,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir GS"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS print dir GS")) - (let ((file (pr-ps-file filename))) - (pr-ps-file-list n-up dir file-regexp file) - (pr-ps-file-using-ghostscript file) - (or filename (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS print dir GS")) + (let ((file (pr-ps-file pr--filename))) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file) + (pr-ps-file-using-ghostscript file) + (or pr--filename (pr-delete-file file))))) ;;;###autoload @@ -4014,12 +3566,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS print dir")) - (let ((file (pr-ps-file filename))) - (pr-ps-file-list n-up dir file-regexp file) - (pr-ps-file-print file) - (or filename (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS print dir")) + (let ((file (pr-ps-file pr--filename))) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file) + (pr-ps-file-print file) + (or pr--filename (pr-delete-file file))))) ;;;###autoload @@ -4043,11 +3599,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt (pr-prompt-gs "PS print dir")))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt (pr-prompt-gs "PS print dir"))) - (if (pr-using-ghostscript-p) - (pr-ps-directory-using-ghostscript n-up dir file-regexp filename) - (pr-ps-directory-print n-up dir file-regexp filename))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt (pr-prompt-gs "PS print dir"))) + (funcall (if (pr-using-ghostscript-p) + #'pr-ps-directory-using-ghostscript + #'pr-ps-directory-print) + pr--n-up pr--dir pr--file-regexp pr--filename))) ;;;###autoload @@ -4191,11 +3752,13 @@ See also `pr-ps-buffer-ps-print'." See also `pr-ps-buffer-preview'." (interactive (pr-interactive-n-up-file "PS preview mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS preview mode") - (let ((file (pr-ps-file filename))) - (and (pr-ps-mode n-up file) - (not pr-spool-p) - (pr-ps-file-preview file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS preview mode") + (let ((file (pr-ps-file pr--filename))) + (and (pr-ps-mode pr--n-up file) + (not pr-spool-p) + (pr-ps-file-preview file))))) ;;;###autoload @@ -4204,12 +3767,14 @@ See also `pr-ps-buffer-preview'." See also `pr-ps-buffer-using-ghostscript'." (interactive (pr-interactive-n-up-file "PS print GS mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS print GS mode") - (let ((file (pr-ps-file filename))) - (when (and (pr-ps-mode n-up file) - (not pr-spool-p)) - (pr-ps-file-using-ghostscript file) - (or filename (pr-delete-file file))))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print GS mode") + (let ((file (pr-ps-file pr--filename))) + (when (and (pr-ps-mode pr--n-up file) + (not pr-spool-p)) + (pr-ps-file-using-ghostscript file) + (or pr--filename (pr-delete-file file)))))) ;;;###autoload @@ -4218,8 +3783,10 @@ See also `pr-ps-buffer-using-ghostscript'." See also `pr-ps-buffer-print'." (interactive (pr-interactive-n-up-file "PS print mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS print mode") - (pr-ps-mode n-up filename)) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print mode") + (pr-ps-mode pr--n-up pr--filename))) ;;;###autoload @@ -4247,8 +3814,10 @@ prompts for FILE(name)-REGEXP. See also documentation for `pr-list-directory'." (interactive (pr-interactive-dir-args "Printify dir")) - (pr-set-dir-args 'dir 'file-regexp "Printify dir") - (pr-file-list dir file-regexp 'pr-printify-buffer)) + (defvar pr--dir) (defvar pr--file-regexp) + (let ((pr--dir dir) (pr--file-regexp file-regexp)) + (pr-set-dir-args 'pr--dir 'pr--file-regexp "Printify dir") + (pr-file-list pr--dir pr--file-regexp 'pr-printify-buffer))) ;;;###autoload @@ -4283,8 +3852,10 @@ prompts for FILE(name)-REGEXP. See also documentation for `pr-list-directory'." (interactive (pr-interactive-dir-args "Print dir")) - (pr-set-dir-args 'dir 'file-regexp "Print dir") - (pr-file-list dir file-regexp 'pr-txt-buffer)) + (defvar pr--dir) (defvar pr--file-regexp) + (let ((pr--dir dir) (pr--file-regexp file-regexp)) + (pr-set-dir-args 'pr--dir 'pr--file-regexp "Print dir") + (pr-file-list pr--dir pr--file-regexp 'pr-txt-buffer))) ;;;###autoload @@ -4406,10 +3977,12 @@ image in a file with that name." (defun pr-ps-file-up-preview (n-up ifilename &optional ofilename) "Preview PostScript file FILENAME." (interactive (pr-interactive-n-up-inout "PS preview")) - (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename - "PS preview "))) - (pr-ps-utility-process n-up ifilename outfile) - (pr-ps-file-preview outfile))) + (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename) + (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename)) + (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename + "PS preview "))) + (pr-ps-utility-process pr--n-up pr--ifilename outfile) + (pr-ps-file-preview outfile)))) ;;;###autoload @@ -4417,15 +3990,18 @@ image in a file with that name." "Print PostScript file FILENAME using ghostscript." (interactive (list (pr-ps-infile-preprint "Print preview "))) (and (stringp filename) (file-exists-p filename) - (let* ((file (pr-expand-file-name filename)) - (tempfile (pr-dosify-file-name (make-temp-file file)))) + (let* ((file (expand-file-name filename)) + (tempfile (make-temp-file file))) ;; gs use (pr-call-process pr-gs-command (format "-sDEVICE=%s" pr-gs-device) (format "-r%d" pr-gs-resolution) (pr-switches-string pr-gs-switches "pr-gs-switches") - (format "-sOutputFile=\"%s\"" tempfile) - file + (format "-sOutputFile=\"%s\"" + ;; FIXME: Do we need to dosify here really? + (pr-dosify-file-name tempfile)) + ;; FIXME: Do we need to dosify here really? + (pr-dosify-file-name file) "-c quit") ;; printing (pr-ps-file-print tempfile) @@ -4439,7 +4015,7 @@ image in a file with that name." (interactive (list (pr-ps-infile-preprint "Print "))) (and (stringp filename) (file-exists-p filename) ;; printing - (let ((file (pr-expand-file-name filename))) + (let ((file (expand-file-name filename))) (if (string= pr-ps-command "") ;; default action (let ((ps-spool-buffer (get-buffer-create ps-spool-buffer-name))) @@ -4448,16 +4024,16 @@ image in a file with that name." (insert-file-contents-literally file)) (pr-despool-print)) ;; use `pr-ps-command' to print - (apply 'pr-call-process + (apply #'pr-call-process pr-ps-command (pr-switches-string pr-ps-switches "pr-ps-switches") (if (string-match "cp" pr-ps-command) ;; for "cp" (cmd in out) - (list file + (list (pr-dosify-file-name file) (concat pr-ps-printer-switch pr-ps-printer)) ;; else, for others (cmd out in) (list (concat pr-ps-printer-switch pr-ps-printer) - file))))))) + (pr-dosify-file-name file)))))))) ;;;###autoload @@ -4492,14 +4068,16 @@ file name." (if pr-print-using-ghostscript "PS print GS" "PS print"))) - (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename - (if pr-print-using-ghostscript - "PS print GS " - "PS print ")))) - (pr-ps-utility-process n-up ifilename outfile) - (unless ofilename - (pr-ps-file-ps-print outfile) - (pr-delete-file outfile)))) + (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename) + (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename)) + (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename + (if pr-print-using-ghostscript + "PS print GS " + "PS print ")))) + (pr-ps-utility-process pr--n-up pr--ifilename outfile) + (unless pr--ofilename + (pr-ps-file-ps-print outfile) + (pr-delete-file outfile))))) ;;;###autoload @@ -5210,9 +4788,9 @@ If menu binding was not done, calls `pr-menu-bind'." (let ((sym (car elt))) (vector (symbol-name sym) - (list fun (list 'quote sym) nil (list 'quote entry) index) + `(,fun ',sym nil ',entry ',index) :style 'radio - :selected (list 'eq var-sym (list 'quote sym))))) + :selected `(eq ,var-sym ',sym)))) alist))) @@ -5224,7 +4802,7 @@ If menu binding was not done, calls `pr-menu-bind'." value)) (setq pr-ps-utility value) (pr-eval-alist (nthcdr 9 item))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-ps-set-printer (value) @@ -5234,7 +4812,7 @@ If menu binding was not done, calls `pr-menu-bind'." "Invalid PostScript printer name `%s' for variable `pr-ps-name'" value)) (setq pr-ps-name value - pr-ps-command (pr-dosify-file-name (nth 0 ps)) + pr-ps-command (nth 0 ps) pr-ps-switches (nth 1 ps) pr-ps-printer-switch (nth 2 ps) pr-ps-printer (nth 3 ps)) @@ -5251,7 +4829,7 @@ If menu binding was not done, calls `pr-menu-bind'." (t "-P") ))) (pr-eval-alist (nthcdr 4 ps))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-txt-set-printer (value) @@ -5260,7 +4838,7 @@ If menu binding was not done, calls `pr-menu-bind'." (error "Invalid text printer name `%s' for variable `pr-txt-name'" value)) (setq pr-txt-name value - pr-txt-command (pr-dosify-file-name (nth 0 txt)) + pr-txt-command (nth 0 txt) pr-txt-switches (nth 1 txt) pr-txt-printer (nth 2 txt))) (or (stringp pr-txt-command) @@ -5269,30 +4847,28 @@ If menu binding was not done, calls `pr-menu-bind'." (lpr-lp-system "lp") (t "lpr") ))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-eval-alist (alist) - (mapcar #'(lambda (option) - (let ((var-sym (car option)) - (value (cdr option))) - (if (eq var-sym 'inherits-from:) - (pr-eval-setting-alist value 'global) - (set var-sym (eval value))))) - alist)) + (dolist (option alist) + (let ((var-sym (car option)) + (value (cdr option))) + (if (eq var-sym 'inherits-from:) + (pr-eval-setting-alist value 'global) + (set var-sym (eval value)))))) (defun pr-eval-local-alist (alist) (let (local-list) - (mapc #'(lambda (option) - (let ((var-sym (car option)) - (value (cdr option))) - (setq local-list - (if (eq var-sym 'inherits-from:) - (nconc (pr-eval-setting-alist value) local-list) - (set (make-local-variable var-sym) (eval value)) - (cons var-sym local-list))))) - alist) + (dolist (option alist) + (let ((var-sym (car option)) + (value (cdr option))) + (setq local-list + (if (eq var-sym 'inherits-from:) + (nconc (pr-eval-setting-alist value) local-list) + (set (make-local-variable var-sym) (eval value)) + (cons var-sym local-list))))) local-list)) @@ -5338,7 +4914,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-kill-local-variable (local-var-list) - (mapcar 'kill-local-variable local-var-list)) + (mapcar #'kill-local-variable local-var-list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5526,10 +5102,6 @@ If menu binding was not done, calls `pr-menu-bind'." (delete-file file))) -(defun pr-expand-file-name (filename) - (pr-dosify-file-name (expand-file-name filename))) - - (defun pr-ps-outfile-preprint (&optional mess) (let* ((prompt (format "%soutput PostScript file name: " (or mess ""))) (res (read-file-name prompt default-directory "" nil))) @@ -5549,7 +5121,7 @@ If menu binding was not done, calls `pr-menu-bind'." (format "File %s; PostScript file: " prompt) (file-name-directory res) nil nil (file-name-nondirectory res)))) - (pr-expand-file-name res))) + (expand-file-name res))) (defun pr-ps-infile-preprint (&optional mess) @@ -5569,7 +5141,7 @@ If menu binding was not done, calls `pr-menu-bind'." (format "File %s; PostScript file: " prompt) (file-name-directory res) nil nil (file-name-nondirectory res)))) - (pr-expand-file-name res))) + (expand-file-name res))) (defun pr-ps-utility-args (n-up-sym infile-sym outfile-sym prompt) @@ -5582,13 +5154,10 @@ If menu binding was not done, calls `pr-menu-bind'." (set infile-sym (pr-ps-infile-preprint prompt))) (or (symbol-value infile-sym) (error "%s: input PostScript file name is missing" prompt)) - (set infile-sym (pr-dosify-file-name (symbol-value infile-sym))) ;; output file (and (eq (symbol-value outfile-sym) t) (set outfile-sym (and current-prefix-arg (pr-ps-outfile-preprint prompt)))) - (and (symbol-value outfile-sym) - (set outfile-sym (pr-dosify-file-name (symbol-value outfile-sym)))) (pr-ps-file (symbol-value outfile-sym))) @@ -5608,9 +5177,9 @@ If menu binding was not done, calls `pr-menu-bind'." (and pr-file-landscape (nth 4 item)) (and pr-file-duplex (nth 5 item)) (and pr-file-tumble (nth 6 item)) - (pr-expand-file-name infile) + (pr-dosify-file-name (expand-file-name infile)) (nth 7 item) - (pr-expand-file-name outfile))))) + (pr-dosify-file-name (expand-file-name outfile)))))) (defun pr-remove-nil-from-list (lst) @@ -5640,7 +5209,7 @@ If menu binding was not done, calls `pr-menu-bind'." (with-file-modes pr-file-modes (setq status (condition-case data - (apply 'call-process cmd nil buffer nil args) + (apply #'call-process cmd nil buffer nil args) ((quit error) (error-message-string data))))) ;; *Printing Command Output* == show exit status @@ -5666,7 +5235,7 @@ If menu binding was not done, calls `pr-menu-bind'." ;; If SWITCHES is nil, return nil. ;; Otherwise, return the list of string in a string. (and switches - (mapconcat 'identity (pr-switches switches mess) " "))) + (mapconcat #'identity (pr-switches switches mess) " "))) (defun pr-switches (switches mess) @@ -5677,36 +5246,42 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-ps-preview (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (or pr-spool-p (pr-ps-file-preview file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (or pr-spool-p (pr-ps-file-preview file))))) (defun pr-ps-using-ghostscript (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (unless (or pr-spool-p filename) - (pr-ps-file-using-ghostscript file) - (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (unless (or pr-spool-p pr--filename) + (pr-ps-file-using-ghostscript file) + (pr-delete-file file))))) (defun pr-ps-print (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (unless (or pr-spool-p filename) - (pr-ps-file-print file) - (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (unless (or pr-spool-p pr--filename) + (pr-ps-file-print file) + (pr-delete-file file))))) (defun pr-ps-file (&optional filename) - (pr-dosify-file-name (or filename - (make-temp-file - (convert-standard-filename - (expand-file-name pr-ps-temp-file pr-temp-dir)) - nil ".ps")))) + (or filename + (make-temp-file + (convert-standard-filename + (expand-file-name pr-ps-temp-file pr-temp-dir)) + nil ".ps"))) (defun pr-interactive-n-up (mess) @@ -5714,7 +5289,7 @@ If menu binding was not done, calls `pr-menu-bind'." (save-match-data (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ") (prompt "") - (str (pr-read-string (format fmt-prompt prompt mess) "1" nil "1")) + (str (read-string (format fmt-prompt prompt mess) nil nil "1")) int) (while (if (string-match "^\\s *[0-9]+$" str) (setq int (string-to-number str) @@ -5724,7 +5299,7 @@ If menu binding was not done, calls `pr-menu-bind'." (setq prompt "Invalid integer syntax; ")) (ding) (setq str - (pr-read-string (format fmt-prompt prompt mess) str nil "1"))) + (read-string (format fmt-prompt prompt mess) str nil "1"))) int))) @@ -5749,7 +5324,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-regexp (mess) - (pr-read-string (format "[%s] File regexp to print: " mess) "" nil "")) + (read-string (format "[%s] File regexp to print: " mess) nil nil "")) (defun pr-interactive-dir-args (mess) @@ -5796,9 +5371,7 @@ If menu binding was not done, calls `pr-menu-bind'." (and (not pr-spool-p) (eq (symbol-value filename-sym) t) (set filename-sym (and current-prefix-arg - (ps-print-preprint current-prefix-arg)))) - (and (symbol-value filename-sym) - (set filename-sym (pr-dosify-file-name (symbol-value filename-sym))))) + (ps-print-preprint current-prefix-arg))))) (defun pr-set-n-up-and-filename (n-up-sym filename-sym mess) @@ -5875,7 +5448,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-ps-file-list (n-up dir file-regexp filename) - (pr-delete-file-if-exists (setq filename (pr-expand-file-name filename))) + (pr-delete-file-if-exists (setq filename (expand-file-name filename))) (let ((pr-spool-p t)) (pr-file-list dir file-regexp #'(lambda () @@ -5941,15 +5514,14 @@ If Emacs is running on Windows 95/98/NT/2000, tries to find COMMAND, COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (if (string= command "") command - (pr-dosify-file-name - (or (pr-find-command command) - (pr-path-command (cond (pr-cygwin-system 'cygwin) - (lpr-windows-system 'windows) - (t 'unix)) - (file-name-nondirectory command) - nil) - (error "Command not found: %s" - (file-name-nondirectory command)))))) + (or (pr-find-command command) + (pr-path-command (cond (pr-cygwin-system 'cygwin) + (lpr-windows-system 'windows) + (t 'unix)) + (file-name-nondirectory command) + nil) + (error "Command not found: %s" + (file-name-nondirectory command))))) (defun pr-path-command (symbol command sym-list) @@ -6004,12 +5576,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; Printing Interface (inspired by ps-print-interface.el) -(eval-when-compile - (require 'cus-edit) - (require 'wid-edit) - (require 'widget)) - - (defvar pr-i-window-configuration nil) (defvar pr-i-buffer nil) @@ -6027,20 +5593,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defvar pr-i-ps-send 'printer) -(defvar pr-interface-map nil - "Keymap for pr-interface.") - -(unless pr-interface-map +(defvar pr-interface-map (let ((map (make-sparse-keymap))) - (cond ((featurep 'xemacs) ; XEmacs - (pr-set-keymap-parents map (list widget-keymap)) - (pr-set-keymap-name map 'pr-interface-map)) - (t ; GNU Emacs - (pr-set-keymap-parents map widget-keymap))) + (set-keymap-parent map widget-keymap) (define-key map "q" 'pr-interface-quit) (define-key map "?" 'pr-interface-help) - (setq pr-interface-map map))) - + map) + "Keymap for pr-interface.") (defmacro pr-interface-save (&rest body) `(with-current-buffer pr-i-buffer @@ -6111,15 +5670,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (setq found (string-match (car ignore) name) ignore (cdr ignore))) (or found - (setq choices - (cons (list 'quote - (list 'choice-item - :format "%[%t%]" - name)) - choices))))) + (push (list 'choice-item + :format "%[%t%]" + name) + choices)))) (nreverse choices)) " Buffer : " nil - '(progn + (lambda () (pr-interface-save (setq pr-i-region (ps-mark-active-p) pr-i-mode (pr-mode-alist-p))) @@ -6345,11 +5902,10 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-italic "\n\nSelect Pages : " 2 14) (pr-insert-menu "Page Parity" 'ps-even-or-odd-pages (mapcar #'(lambda (alist) - (list 'quote - (list 'choice-item - :format "%[%t%]" - :tag (cdr alist) - :value (car alist)))) + (list 'choice-item + :format "%[%t%]" + :tag (cdr alist) + :value (car alist))) pr-even-or-odd-alist))) @@ -6605,8 +6161,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-insert-toggle (var-sym label) (widget-create 'checkbox - :notify `(lambda (&rest _ignore) - (setq ,var-sym (not ,var-sym))) + :notify (lambda (&rest _ignore) + (set var-sym (not (symbol-value var-sym)))) (symbol-value var-sym)) (widget-insert label)) @@ -6619,32 +6175,32 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (widget-insert separator))) -(defun pr-insert-menu (tag var-sym choices &optional before after &rest body) +(defun pr-insert-menu (tag var-sym choices &optional before after body) (and before (widget-insert before)) - (eval `(widget-create 'menu-choice - :tag ,tag - :format "%v" - :inline t - :value ,var-sym - :notify (lambda (widget &rest _ignore) - (setq ,var-sym (widget-value widget)) - ,@body) - :void '(choice-item :format "%[%t%]" - :tag "Can not display value!") - ,@choices)) - (and after (widget-insert after))) + (apply #'widget-create 'menu-choice + :tag tag + :format "%v" + :inline t + :value (symbol-value var-sym) + :notify (lambda (widget &rest _ignore) + (set var-sym (widget-value widget)) + (when body (funcall body))) + :void '(choice-item :format "%[%t%]" + :tag "Can not display value!") + choices) + (and after (widget-insert after))) (defun pr-insert-radio-button (var-sym sym) (widget-insert "\n") (let ((wid-list (get var-sym 'pr-widget-list)) - (wid (eval `(widget-create - 'radio-button - :format " %[%v%]" - :value (eq ,var-sym (quote ,sym)) - :notify (lambda (&rest _ignore) - (setq ,var-sym (quote ,sym)) - (pr-update-radio-button (quote ,var-sym))))))) + (wid (widget-create + 'radio-button + :format " %[%v%]" + :value (eq (symbol-value var-sym) sym) + :notify (lambda (&rest _ignore) + (set var-sym sym) + (pr-update-radio-button var-sym))))) (put var-sym 'pr-widget-list (cons (cons wid sym) wid-list)))) @@ -6666,20 +6222,18 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-choice-alist (alist) - (let ((max (apply 'max (mapcar #'(lambda (alist) - (length (symbol-name (car alist)))) - alist)))) + (let ((max (apply #'max (mapcar #'(lambda (alist) + (length (symbol-name (car alist)))) + alist)))) (mapcar #'(lambda (alist) (let* ((sym (car alist)) (name (symbol-name sym))) - (list - 'quote - (list - 'choice-item - :format "%[%t%]" - :tag (concat name - (make-string (- max (length name)) ?_)) - :value sym)))) + (list + 'choice-item + :format "%[%t%]" + :tag (concat name + (make-string (- max (length name)) ?_)) + :value sym))) alist))) commit 8a5ecdaa2faa550b4f3553beeda91c3c99c9bc05 Author: Stefan Monnier Date: Tue Apr 9 15:11:38 2019 -0400 quail.el: Use delete-and-extract-region * lisp/international/quail.el (quail-overlay-region-events): Use delete-and-extract-region. (quail-activate): Use setq-local. diff --git a/lisp/international/quail.el b/lisp/international/quail.el index bd05fcec69..3266b93b44 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -568,7 +568,7 @@ While this input method is active, the variable (quail-delete-overlays) (setq describe-current-input-method-function nil) (quail-hide-guidance) - (remove-hook 'post-command-hook 'quail-show-guidance t) + (remove-hook 'post-command-hook #'quail-show-guidance t) (run-hooks 'quail-deactivate-hook)) (kill-local-variable 'input-method-function)) ;; Let's activate Quail input method. @@ -579,19 +579,18 @@ While this input method is active, the variable (setq name (car (car quail-package-alist))) (error "No Quail package loaded")) (quail-select-package name))) - (setq deactivate-current-input-method-function 'quail-deactivate) - (setq describe-current-input-method-function 'quail-help) + (setq deactivate-current-input-method-function #'quail-deactivate) + (setq describe-current-input-method-function #'quail-help) (quail-delete-overlays) (setq quail-guidance-str "") (quail-show-guidance) ;; If we are in minibuffer, turn off the current input method ;; before exiting. (when (eq (selected-window) (minibuffer-window)) - (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer) - (add-hook 'post-command-hook 'quail-show-guidance nil t)) + (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer) + (add-hook 'post-command-hook #'quail-show-guidance nil t)) (run-hooks 'quail-activate-hook) - (make-local-variable 'input-method-function) - (setq input-method-function 'quail-input-method))) + (setq-local input-method-function #'quail-input-method))) (define-obsolete-variable-alias 'quail-inactivate-hook @@ -1367,9 +1366,7 @@ If STR has `advice' text property, append the following special event: (let ((start (overlay-start overlay)) (end (overlay-end overlay))) (if (< start end) - (prog1 - (string-to-list (buffer-substring start end)) - (delete-region start end))))) + (string-to-list (delete-and-extract-region start end))))) (defsubst quail-delete-region () "Delete the text in the current translation region of Quail." commit 4b39b741f1949ebad1dfccc5032dfce521bedc2a Author: Stefan Monnier Date: Tue Apr 9 15:08:21 2019 -0400 python.el: don't syntax-propertize single/double quoted strings * lisp/progmodes/python.el (python-syntax-propertize-function): Only mark triple-quoted strings, let the normal syntax-table handle the rest. (python-syntax-stringify): Adjust accordingly. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5d0d03d502..b05f9a33e9 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -675,7 +675,7 @@ Which one will be chosen depends on the value of (defconst python-syntax-propertize-function (syntax-propertize-rules - ((python-rx string-delimiter) + ((rx (or "\"\"\"" "'''")) (0 (ignore (python-syntax-stringify)))))) (define-obsolete-variable-alias 'python--prettify-symbols-alist @@ -701,35 +701,27 @@ is used to limit the scan." (defun python-syntax-stringify () "Put `syntax-table' property correctly on single/triple quotes." - (let* ((num-quotes (length (match-string-no-properties 1))) - (ppss (prog2 - (backward-char num-quotes) - (syntax-ppss) - (forward-char num-quotes))) - (string-start (and (not (nth 4 ppss)) (nth 8 ppss))) - (quote-starting-pos (- (point) num-quotes)) - (quote-ending-pos (point)) - (num-closing-quotes - (and string-start - (python-syntax-count-quotes - (char-before) string-start quote-starting-pos)))) - (cond ((and string-start (= num-closing-quotes 0)) - ;; This set of quotes doesn't match the string starting - ;; kind. Do nothing. + (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss))) + (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss))) + (quote-starting-pos (- (point) 3)) + (quote-ending-pos (point))) + (cond ((or (nth 4 ppss) ;Inside a comment + (and string-start + ;; Inside of a string quoted with different triple quotes. + (not (eql (char-after string-start) + (char-after quote-starting-pos))))) + ;; Do nothing. nil) - ((not string-start) + ((nth 5 ppss) + ;; The first quote is escaped, so it's not part of a triple quote! + (goto-char (1+ quote-starting-pos))) + ((null string-start) ;; This set of quotes delimit the start of a string. (put-text-property quote-starting-pos (1+ quote-starting-pos) 'syntax-table (string-to-syntax "|"))) - ((= num-quotes num-closing-quotes) + (t ;; This set of quotes delimit the end of a string. (put-text-property (1- quote-ending-pos) quote-ending-pos - 'syntax-table (string-to-syntax "|"))) - ((> num-quotes num-closing-quotes) - ;; This may only happen whenever a triple quote is closing - ;; a single quoted string. Add string delimiter syntax to - ;; all three quotes. - (put-text-property quote-starting-pos quote-ending-pos 'syntax-table (string-to-syntax "|")))))) (defvar python-mode-syntax-table commit c44313327588b5d2aafe9234e71f081f39a16082 Author: Stefan Monnier Date: Tue Apr 9 15:02:00 2019 -0400 * lisp/progmodes/js.el (js-mode): Don't set comment-start-skip globally! diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 535b70317a..7099824581 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4483,6 +4483,7 @@ This function is intended for use in `after-change-functions'." ;; Comments (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) @@ -4508,8 +4509,7 @@ This function is intended for use in `after-change-functions'." c-paragraph-separate "$" c-block-comment-prefix "* " c-line-comment-starter "//" - c-comment-start-regexp "/[*/]\\|\\s!" - comment-start-skip "\\(//+\\|/\\*+\\)\\s *") + c-comment-start-regexp "/[*/]\\|\\s!") (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local c-block-comment-start-regexp "/\\*") (setq-local comment-multi-line t) commit a017927c9ff627a0adf19ac3720bf6b2e77e5da5 Author: Stefan Monnier Date: Tue Apr 9 14:57:29 2019 -0400 Fix up Eshell 'require's after previous dependency reshuffle. * lisp/eshell/em-unix.el: * lisp/eshell/em-script.el: * lisp/eshell/em-pred.el: * lisp/eshell/em-dirs.el: * lisp/eshell/em-alias.el: Fix up 'require's to silence byte-compiler. * lisp/eshell/esh-util.el (eshell-read-hosts-file): Don't limit number of entries per line. Preserve the structure. (eshell-read-hosts): Adjust accordingly. diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index dbffd52aa7..c465d464d6 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -90,7 +90,7 @@ ;;; Code: -(require 'eshell) +(require 'esh-mode) ;;;###autoload (progn @@ -141,12 +141,12 @@ file named by `eshell-aliases-file'.") (defvar eshell-failed-commands-alist nil "An alist of command name failures.") -(defun eshell-alias-initialize () +(defun eshell-alias-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the alias handling code." (make-local-variable 'eshell-failed-commands-alist) - (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t) + (add-hook 'eshell-alternate-command-hook #'eshell-fix-bad-commands t t) (eshell-read-aliases-list) - (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t) + (add-hook 'eshell-named-command-hook #'eshell-maybe-replace-by-alias t t) (make-local-variable 'eshell-complex-commands) (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p)) diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el index 4a0b265ae0..c284c1bd70 100644 --- a/lisp/eshell/em-banner.el +++ b/lisp/eshell/em-banner.el @@ -71,7 +71,7 @@ This can be any sexp, and should end with at least two newlines." :type 'hook :group 'eshell-banner) -(defun eshell-banner-initialize () +(defun eshell-banner-initialize () ;Called from `eshell-mode' via intern-soft! "Output a welcome banner on initialization." ;; it's important to use `eshell-interactive-print' rather than ;; `insert', because `insert' doesn't know how to interact with the diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 25a6e88c8e..e3bfd8d9d4 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -244,7 +244,7 @@ to writing a completion function." (let ((completion-at-point-functions '(lisp-completion-at-point))) (completion-at-point))) -(defun eshell-cmpl-initialize () +(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the completions module." (set (make-local-variable 'pcomplete-command-completion-function) eshell-command-completion-function) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 93b10b5994..c28fd72f45 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -42,15 +42,11 @@ ;;; Code: -(require 'eshell) +(require 'esh-mode) ;For eshell-directory-name +(require 'esh-var) ;For eshell-variable-aliases-list (require 'ring) (require 'esh-opt) -(declare-function eshell-apply-indices "esh-var") -(defvar eshell-variable-aliases-list) -(defvar eshell-directory-name) -(defvar eshell-mode) - ;;;###autoload (progn (defgroup eshell-dirs nil @@ -174,9 +170,8 @@ Thus, this does not include the current directory.") ;;; Functions: -(defun eshell-dirs-initialize () +(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the builtin functions for Eshell." - (require 'esh-var) (make-local-variable 'eshell-variable-aliases-list) (setq eshell-variable-aliases-list (append diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index f03243a6af..99c52ea0d3 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -125,7 +125,7 @@ This option slows down recursive glob processing by quite a bit." ;;; Functions: -(defun eshell-glob-initialize () +(defun eshell-glob-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the extended globbing code." ;; it's important that `eshell-glob-chars-list' come first (when (boundp 'eshell-special-chars-outside-quoting) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index bc0da96c58..614faaa131 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -216,7 +216,7 @@ Returns non-nil if INPUT is blank." Returns nil if INPUT is prepended by blank space, otherwise non-nil." (not (string-match-p "\\`\\s-+" input))) -(defun eshell-hist-initialize () +(defun eshell-hist-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the history management code for one Eshell buffer." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index dd3351b14d..9bc856a296 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -46,9 +46,7 @@ ;;; Code: -(require 'esh-util) -(require 'esh-arg) -(eval-when-compile (require 'eshell)) +(require 'esh-mode) ;;;###autoload (progn @@ -247,10 +245,10 @@ EXAMPLES: (lambda () (insert eshell-modifier-help-string))))) -(defun eshell-pred-initialize () +(defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the predicate/modifier code." (add-hook 'eshell-parse-argument-hook - 'eshell-parse-arg-modifier t t) + #'eshell-parse-arg-modifier t t) (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help) (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help)) diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index a3035205ad..adc68b6c85 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -99,7 +99,7 @@ arriving, or after." ;;; Functions: -(defun eshell-prompt-initialize () +(defun eshell-prompt-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the prompting code." (unless eshell-non-interactive-p (add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 9cb16174f2..a817edbcc9 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -145,7 +145,7 @@ This is default behavior of shells like bash." ;;; Functions: -(defun eshell-rebind-initialize () +(defun eshell-rebind-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the inputting code." (unless eshell-non-interactive-p (add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t) diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index bab26222ba..4a3b84e10e 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -23,8 +23,7 @@ ;;; Code: -(require 'eshell) -(require 'esh-opt) +(require 'esh-mode) ;;;###autoload (progn @@ -57,7 +56,7 @@ This includes when running `eshell-command'." ;;; Functions: -(defun eshell-script-initialize () +(defun eshell-script-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the script parsing code." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist @@ -73,13 +72,14 @@ This includes when running `eshell-command'." ;; to ruin it for other modules (let (eshell-inside-quote-regexp eshell-outside-quote-regexp) - (and (not eshell-non-interactive-p) + (and (not (bound-and-true-p eshell-non-interactive-p)) eshell-login-script (file-readable-p eshell-login-script) (eshell-do-eval (list 'eshell-commands (catch 'eshell-replace-command - (eshell-source-file eshell-login-script))) t)) + (eshell-source-file eshell-login-script))) + t)) (and eshell-rc-script (file-readable-p eshell-rc-script) (eshell-do-eval diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 420f885050..c7965b4187 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -166,7 +166,7 @@ The options are `begin', `after' or `end'." ;;; Functions: -(defun eshell-smart-initialize () +(defun eshell-smart-initialize () ;Called from `eshell-mode' via intern-soft! "Setup Eshell smart display." (unless eshell-non-interactive-p ;; override a few variables, since they would interfere with the diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 9a9f23cddd..dea90405ad 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -147,7 +147,7 @@ behavior for short-lived processes, see bug#18108." ;;; Functions: -(defun eshell-term-initialize () +(defun eshell-term-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the `term' interface code." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 603b7627d5..c7916360ee 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -46,7 +46,7 @@ :tag "TRAMP Eshell features" :group 'eshell-module)) -(defun eshell-tramp-initialize () +(defun eshell-tramp-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the TRAMP-using commands code." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index e4c4265d70..2522181721 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -35,8 +35,7 @@ ;;; Code: -(require 'eshell) -(require 'esh-opt) +(require 'esh-mode) (require 'pcomplete) ;;;###autoload @@ -140,7 +139,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." ;;; Functions: -(defun eshell-unix-initialize () +(defun eshell-unix-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the UNIX support/emulation code." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 3ba4c935a7..026edc5980 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -157,7 +157,7 @@ treated as a literal character." ;;; Functions: -(defun eshell-arg-initialize () +(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the argument parsing code." ;; This is supposedly run after enabling esh-mode, when eshell-mode-map ;; already exists. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 7b05cfbc34..6e03bda22b 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -287,7 +287,7 @@ otherwise t.") "Return currently running command process, if non-Lisp." eshell-last-async-proc) -(defun eshell-cmd-initialize () +(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the Eshell command processing module." (set (make-local-variable 'eshell-current-command) nil) (set (make-local-variable 'eshell-command-name) nil) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index ae8bf84624..978fc55c4d 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -172,7 +172,7 @@ external version." ;;; Functions: -(defun eshell-ext-initialize () +(defun eshell-ext-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the external command handling code." (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t)) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 1a6c71eda0..ce1d021384 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -169,7 +169,7 @@ not be added to this variable." ;;; Functions: -(defun eshell-io-initialize () +(defun eshell-io-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the I/O subsystem code." (add-hook 'eshell-parse-argument-hook 'eshell-parse-redirection nil t) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 1f86dacd96..cff29bed1b 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -412,7 +412,7 @@ and the hook `eshell-exit-hook'." (when (and load-hook (boundp load-hook)) (if (memq initfunc (symbol-value load-hook)) (setq initfunc nil)) (run-hooks load-hook)) - ;; So we don't need the -initialize functions on the hooks (b#5375). + ;; So we don't need the -initialize functions on the hooks (bug#5375). (and initfunc (fboundp initfunc) (funcall initfunc)))) (if eshell-send-direct-to-subprocesses diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d9a6eef716..d538ae32b3 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -121,7 +121,7 @@ PROC and STATUS to functions on the latter." (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) -(defun eshell-proc-initialize () +(defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the process handling code." (make-local-variable 'eshell-process-list) ;; This is supposedly run after enabling esh-mode, when eshell-command-map diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 118978e77d..6f355c70a4 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -478,24 +478,22 @@ list." (insert-file-contents (or filename eshell-hosts-file)) (goto-char (point-min)) (while (re-search-forward - "^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t) - (if (match-string 1) - (cl-pushnew (match-string 1) hosts :test #'equal)) - (if (match-string 2) - (cl-pushnew (match-string 2) hosts :test #'equal)) - (if (match-string 4) - (cl-pushnew (match-string 4) hosts :test #'equal)))) - (sort hosts #'string-lessp))) + ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?" + "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t) + (push (cons (match-string 1) + (split-string (match-string 2))) + hosts))) + (nreverse hosts))) (defun eshell-read-hosts (file result-var timestamp-var) - "Read the contents of /etc/passwd for user names." + "Read the contents of /etc/hosts for host names." (if (or (not (symbol-value result-var)) (not (symbol-value timestamp-var)) (time-less-p (symbol-value timestamp-var) (file-attribute-modification-time (file-attributes file)))) (progn - (set result-var (eshell-read-hosts-file file)) + (set result-var (apply #'nconc (eshell-read-hosts-file file))) (set timestamp-var (current-time)))) (symbol-value result-var)) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 82e0f7135b..b08a5d242f 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -199,7 +199,7 @@ function), and the arguments passed to this function would be the list ;;; Functions: -(defun eshell-var-initialize () +(defun eshell-var-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the variable handle code." ;; Break the association with our parent's environment. Otherwise, ;; changing a variable will affect all of Emacs. commit 1055eee692b2cdcee5ba7ee4ad8d92ead8fc30e5 Author: Stefan Monnier Date: Tue Apr 9 12:04:03 2019 -0400 * lisp/gnus/mm-view.el (mm-display-inline-fontify): Simplify. Remove hacks that were needed before font-lock-ensure. Don't use switch-to-buffer. Don't assume point-min == 1. diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 8ce094349f..1e1d264b99 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -476,29 +476,32 @@ If MODE is not set, try to find mode automatically." (mm-decode-string text charset)) (t text))) - (require 'font-lock) - ;; I find font-lock a bit too verbose. - (let ((font-lock-verbose nil) - (font-lock-support-mode nil) + (let ((font-lock-verbose nil) ; font-lock is a bit too verbose. (enable-local-variables nil)) - ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. - ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes. + ;; We used to set font-lock-mode-hook to nil to avoid enabling + ;; support modes, but now that we use font-lock-ensure, support modes + ;; aren't a problem any more. So we could probably get rid of this + ;; setting now, but it seems harmless and potentially still useful. (set (make-local-variable 'font-lock-mode-hook) nil) (setq buffer-file-name (mm-handle-filename handle)) (with-demoted-errors - (if mode - (save-window-excursion - (switch-to-buffer (current-buffer)) - (funcall mode)) + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka , org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) (set-auto-mode) (setq mode major-mode))) - ;; The mode function might have already turned on font-lock. ;; Do not fontify if the guess mode is fundamental. - (unless (or font-lock-mode - (eq major-mode 'fundamental-mode)) + (unless (eq major-mode 'fundamental-mode) (font-lock-ensure)))) (setq text (buffer-string)) (when (eq mode 'diff-mode) @@ -508,7 +511,7 @@ If MODE is not set, try to find mode automatically." ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. (set-buffer-modified-p nil)) - (let ((b (1- (point)))) + (let ((b (- (point) (save-restriction (widen) (point-min))))) (mm-insert-inline handle text) (dolist (ov ovs) (move-overlay (nth 0 ov) (+ (nth 1 ov) b) commit e1a457e63530cd566a1bc2957b70221bb6f76984 Author: Basil L. Contovounesios Date: Tue Apr 9 16:32:27 2019 +0100 ; Warn of while/dolist pitfall in gnus-sum.el Suggested by Andy Moreton in the following thread: https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00294.html * lisp/gnus/gnus-sum.el (gnus-summary-move-article): Add comment warning of common while/dolist pitfall. (bug#33653#134) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 8959a2b3d0..b8aa302f11 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10088,6 +10088,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) + ;; This `while' is not equivalent to a `dolist' (bug#33653#134). (while articles (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. commit 90c7e363b72f0a145378314a2710ce699b659ba1 Author: Stefan Monnier Date: Tue Apr 9 11:09:11 2019 -0400 * lisp/vc/diff-mode.el: Cosmetic changes in diff-syntax-fontify-hunk (diff-default-directory): Use defvar-local. (diff-syntax-fontify-hunk): Use 'setq' less. Fit within 80 columns. Simplify some looking-at tests. (diff-syntax-fontify-props): Don't check the buffer-local part of find-file-hook. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 840f2c67d2..eeac24376e 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -144,9 +144,8 @@ in wrong fontification. This is the fastest option, but less reliable." (defvar diff-vc-revisions nil "The VC revisions compared in the current Diff buffer, if any.") -(defvar diff-default-directory nil +(defvar-local diff-default-directory nil "The default directory where the current Diff buffer was created.") -(make-variable-buffer-local 'diff-default-directory) (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -2423,7 +2422,9 @@ When OLD is non-nil, highlight the hunk from the old source." (let* ((hunk (buffer-substring-no-properties beg end)) ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props ;; in diffs that have no newline at end of diff file. - (text (string-trim-right (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) ""))) + (text (string-trim-right + (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) + ""))) (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") (if old (match-string 1) (if (match-end 3) (match-string 3) (match-string 1))))) @@ -2432,83 +2433,112 @@ When OLD is non-nil, highlight the hunk from the old source." (list (string-to-number (match-string 1 line)) (string-to-number (match-string 2 line))) (list (string-to-number line) 1)))) ; One-line diffs - props) - (cond - ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) - (let* ((file (diff-find-file-name old t)) - (revision (and file (if (not old) (nth 1 diff-vc-revisions) - (or (nth 0 diff-vc-revisions) - (vc-working-revision file)))))) - (if file - (if (not revision) - ;; Get properties from the current working revision - (when (and (not old) (file-exists-p file) (file-regular-p file)) - ;; Try to reuse an existing buffer - (if (get-file-buffer (expand-file-name file)) - (with-current-buffer (get-file-buffer (expand-file-name file)) - (setq props (diff-syntax-fontify-props nil text line-nb))) - ;; Get properties from the file - (with-temp-buffer - (insert-file-contents file) - (setq props (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - (expand-file-name file) revision)) - (buffer (gethash buffer-name diff-syntax-fontify-revisions))) - (unless (and buffer (buffer-live-p buffer)) - (let* ((vc-buffer (ignore-errors - (vc-find-revision-no-save - (expand-file-name file) revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when vc-buffer - (setq buffer vc-buffer) - (puthash buffer-name buffer diff-syntax-fontify-revisions)))) - (when buffer - (with-current-buffer buffer - (setq props (diff-syntax-fontify-props file text line-nb)))))) - ;; If file is unavailable, get properties from the hunk alone - (setq file (car (diff-hunk-file-names old))) - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) - ((and diff-default-directory (not (eq diff-font-lock-syntax 'hunk-only))) - (let ((file (car (diff-hunk-file-names old)))) - (if (and file (file-exists-p file) (file-regular-p file)) - ;; Try to get full text from the file - (with-temp-buffer - (insert-file-contents file) - (setq props (diff-syntax-fontify-props file text line-nb))) - ;; Otherwise, get properties from the hunk alone - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) - ((memq diff-font-lock-syntax '(hunk-also hunk-only)) - (let ((file (car (diff-hunk-file-names old)))) - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) + (props + (cond + ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) + (let* ((file (diff-find-file-name old t)) + (revision (and file (if (not old) (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + (vc-working-revision file)))))) + (if file + (if (not revision) + ;; Get properties from the current working revision + (when (and (not old) (file-exists-p file) + (file-regular-p file)) + (let ((buf (get-file-buffer (expand-file-name file)))) + ;; Try to reuse an existing buffer + (if buf + (with-current-buffer buf + (diff-syntax-fontify-props nil text line-nb)) + ;; Get properties from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))))) + ;; Get properties from a cached revision + (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" + (expand-file-name file) + revision)) + (buffer (gethash buffer-name + diff-syntax-fontify-revisions))) + (unless (and buffer (buffer-live-p buffer)) + (let* ((vc-buffer (ignore-errors + (vc-find-revision-no-save + (expand-file-name file) revision + diff-vc-backend + (get-buffer-create buffer-name))))) + (when vc-buffer + (setq buffer vc-buffer) + (puthash buffer-name buffer + diff-syntax-fontify-revisions)))) + (when buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + ;; If file is unavailable, get properties from the hunk alone + (setq file (car (diff-hunk-file-names old))) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))) + ((and diff-default-directory + (not (eq diff-font-lock-syntax 'hunk-only))) + (let ((file (car (diff-hunk-file-names old)))) + (if (and file (file-exists-p file) (file-regular-p file)) + ;; Try to get full text from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb)) + ;; Otherwise, get properties from the hunk alone + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))) + ((memq diff-font-lock-syntax '(hunk-also hunk-only)) + (let ((file (car (diff-hunk-file-names old)))) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))))) ;; Put properties over the hunk text (goto-char beg) (when (and props (eq (diff-hunk-style) 'unified)) (while (< (progn (forward-line 1) (point)) end) - (when (or (and (not old) (not (looking-at-p "[-<]"))) - (and old (not (looking-at-p "[+>]")))) - (unless (looking-at-p "\\\\") ; skip "\ No newline at end of file" - (if (and old (not (looking-at-p "[-<]"))) - ;; Fontify context lines only from new source, - ;; don't refontify context lines from old source. - (pop props) - (let ((line-props (pop props)) - (bol (1+ (point)))) - (dolist (prop line-props) - (let ((ol (make-overlay (+ bol (nth 0 prop)) - (+ bol (nth 1 prop)) - nil 'front-advance nil))) - (overlay-put ol 'diff-mode 'syntax) - (overlay-put ol 'evaporate t) - (overlay-put ol 'face (nth 2 prop)))))))))))) + ;; Skip the "\ No newline at end of file" lines as well as the lines + ;; corresponding to the "other" version. + (unless (looking-at-p (if old "[+>\\]" "[-<\\]")) + (if (and old (not (looking-at-p "[-<]"))) + ;; Fontify context lines only from new source, + ;; don't refontify context lines from old source. + (pop props) + (let ((line-props (pop props)) + (bol (1+ (point)))) + (dolist (prop line-props) + ;; Ideally, we'd want to use text-properties as in: + ;; + ;; (add-face-text-property + ;; (+ bol (nth 0 prop)) (+ bol (nth 1 prop)) + ;; (nth 2 prop) 'append) + ;; + ;; rather than overlays here, but they'd get removed by later + ;; font-locking. + ;; This is because we also apply faces outside of the + ;; beg...end chunk currently font-locked and when font-lock + ;; later comes to handle the rest of the hunk that we already + ;; handled we don't (want to) redo it (we work at + ;; hunk-granularity rather than font-lock's own chunk + ;; granularity). + ;; I see two ways to fix this: + ;; - don't immediately apply the props that fall outside of + ;; font-lock's chunk but stash them somewhere (e.g. in another + ;; text property) and only later when font-lock comes back + ;; move them to `face'. + ;; - change the code so work at font-lock's chunk granularity + ;; (this seems doable without too much extra overhead, + ;; contrary to the refine highlighting, which inherently + ;; works at a different granularity). + (let ((ol (make-overlay (+ bol (nth 0 prop)) + (+ bol (nth 1 prop)) + nil 'front-advance nil))) + (overlay-put ol 'diff-mode 'syntax) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face (nth 2 prop))))))))))) (defun diff-syntax-fontify-props (file text line-nb &optional hunk-only) "Get font-lock properties from the source code. @@ -2516,22 +2546,23 @@ FILE is the name of the source file. If non-nil, it requests initialization of the mode according to FILE. TEXT is the literal source text from hunk. LINE-NB is a pair of numbers: start line number and the number of -lines in the hunk. NO-INIT means no initialization is needed to set major -mode. When HUNK-ONLY is non-nil, then don't verify the existence of the +lines in the hunk. +When HUNK-ONLY is non-nil, then don't verify the existence of the hunk text in the source file. Otherwise, don't highlight the hunk if the hunk text is not found in the source file." (when file ;; When initialization is requested, we should be in a brand new ;; temp buffer. - (cl-assert (eq t buffer-undo-list)) - (cl-assert (not font-lock-mode)) (cl-assert (null buffer-file-name)) (let ((enable-local-variables :safe) ;; to find `mode:' (buffer-file-name file)) (set-auto-mode) - (when (and (memq 'generic-mode-find-file-hook - (append find-file-hook (default-value 'find-file-hook))) - (fboundp 'generic-mode-find-file-hook)) + ;; FIXME: Is this really worth the trouble? + (when (and (fboundp 'generic-mode-find-file-hook) + (memq #'generic-mode-find-file-hook + ;; There's no point checking the buffer-local value, + ;; we're in a fresh new buffer. + (default-value 'find-file-hook))) (generic-mode-find-file-hook)))) (let ((font-lock-defaults (or font-lock-defaults '(nil t))) commit c81465580fe262f28ce47502c00f4afcbe3b8f8d Author: Mattias Engdegård Date: Tue Apr 9 16:56:37 2019 +0200 Clarify the TESTFN argument to `alist-get' * lisp/subr.el (alist-get): Rephrase the initial text to clarify the meaning of the TESTFN argument. It's an equality predicate, not a look-up function (Bug#35206). diff --git a/lisp/subr.el b/lisp/subr.el index 45b3916196..bdf98979c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -779,9 +779,9 @@ Elements of ALIST that are not conses are ignored." alist) (defun alist-get (key alist &optional default remove testfn) - "Return the value associated with KEY in ALIST. + "Find the first element of ALIST whose `car' equals KEY and return its `cdr'. If KEY is not found in ALIST, return DEFAULT. -Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. +Equality with KEY is tested by TESTFN, defaulting to `eq'. You can use `alist-get' in PLACE expressions. This will modify an existing association (more precisely, the first one if