From fc475e6669a613cd6d98eb5511c749a23b63c7ac Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 17 May 1999 09:41:37 +0000 Subject: [PATCH] XEmacs 21.2.4 --- lib-src/movemail.c | 279 ++++++++++++++++++++++----- lisp/ChangeLog | 129 +++++++++++++ lisp/about.el | 2 + lisp/auto-autoloads.el | 33 +++- lisp/cus-face.el | 1 + lisp/custom-load.el | 1 - lisp/easymenu.el | 57 +++++- lisp/etags.el | 8 +- lisp/faces.el | 4 +- lisp/isearch-mode.el | 4 + lisp/menubar-items.el | 4 + lisp/menubar.el | 23 ++- lisp/msw-faces.el | 6 + lisp/package-get.el | 393 ++++++++++++++++++++++++++------------ lisp/package-ui.el | 39 +++- lisp/process.el | 19 +- lisp/subr.el | 11 +- lisp/wid-edit.el | 85 ++++----- man/ChangeLog | 4 + man/internals/internals.texi | 169 ++++++++++++----- man/lispref/text.texi | 137 ++++++++++++++ nt/ChangeLog | 9 + nt/xemacs.mak | 2 +- src/ChangeLog | 162 ++++++++++++++++ src/chartab.c | 10 +- src/chartab.h | 1 + src/config.h.in | 2 +- src/dgif_lib.c | 4 +- src/dired.c | 15 +- src/editfns.c | 162 ++++++++++++++-- src/emacs.c | 2 +- src/fileio.c | 9 +- src/fns.c | 428 ++++++++++++++++++++++++++++++++++++++++++ src/frame-msw.c | 36 +++- src/gifrlib.h | 6 +- src/glyphs-msw.c | 2 +- src/gui.c | 8 +- src/gui.h | 1 + src/input-method-motif.c | 7 +- src/input-method-xlib.c | 7 +- src/insdel.c | 33 ++-- src/linuxplay.c | 2 +- src/lisp.h | 3 +- src/m/arm.h | 135 +++++++++++++ src/m/mips-nec.h | 145 ++++++++++++++ src/menubar-x.c | 35 +++- src/menubar.c | 7 + src/mule-charset.c | 2 +- src/process-unix.c | 4 +- src/s/cygwin32.h | 12 +- 50 files changed, 2296 insertions(+), 363 deletions(-) create mode 100644 src/m/arm.h create mode 100644 src/m/mips-nec.h diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 0419719..f345020 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -65,10 +65,15 @@ Boston, MA 02111-1307, USA. */ #include "../src/systime.h" #include #include +#include "getopt.h" #ifdef MAIL_USE_POP #include "pop.h" +#include #endif +extern char *optarg; +extern int optind, opterr; + #ifndef HAVE_STRERROR static char * strerror (int errnum); #endif /* HAVE_STRERROR */ @@ -146,15 +151,43 @@ static int pop_retr (popserver server, int msgno, int (*action)(), void *arg); static int mbx_write (char *, FILE *); static int mbx_delimit_begin (FILE *); static int mbx_delimit_end (FILE *); +static struct re_pattern_buffer* compile_regex (char* regexp_pattern); +static int pop_search_top (popserver server, int msgno, int lines, + struct re_pattern_buffer* regexp); #endif /* Nonzero means this is name of a lock file to delete on fatal error. */ char *delete_lockname; +int verbose=0; +#ifdef MAIL_USE_POP +int reverse=0; +int keep_messages=0; +struct re_pattern_buffer* regexp_pattern=0; +int match_lines=10; +#endif + +#define VERBOSE(x) if (verbose) { printf x; fflush(stdout); } + +struct option longopts[] = +{ + { "inbox", required_argument, NULL, 'i' }, + { "outfile", required_argument, NULL, 'o' }, +#ifdef MAIL_USE_POP + { "password", required_argument, NULL, 'p' }, + { "reverse-pop-order", no_argument, NULL, 'x' }, + { "keep-messages", no_argument, NULL, 'k' }, + { "regex", required_argument, NULL, 'r' }, + { "match-lines", required_argument, NULL, 'l' }, +#endif + { "verbose", no_argument, NULL, 'v' }, + { 0 } +}; + int main (int argc, char *argv[]) { - char *inname, *outname; + char *inname=0, *outname=0, *poppass=0; #ifndef DISABLE_DIRECT_ACCESS int indesc, outdesc; int nread; @@ -172,14 +205,72 @@ main (int argc, char *argv[]) delete_lockname = 0; - if (argc < 3) + while (1) { - fprintf (stderr, "Usage: movemail inbox destfile [POP-password]\n"); - exit(1); +#ifdef MAIL_USE_POP + char* optstring = "i:o:p:l:r:xvk"; +#else + char* optstring = "i:o:v"; +#endif + int opt = getopt_long (argc, argv, optstring, longopts, 0); + + if (opt == EOF) + break; + + switch (opt) + { + case 0: + break; + case 1: /* one of the standard arguments seen */ + if (!inname) + inname = optarg; + else if (!outname) + outname = optarg; + else + poppass = optarg; + break; + + case 'i': /* infile */ + inname = optarg; + break; + + case 'o': /* outfile */ + outname = optarg; + break; +#ifdef MAIL_USE_POP + case 'p': /* pop password */ + poppass = optarg; + break; + case 'k': keep_messages=1; break; + case 'x': reverse = 1; break; + case 'l': /* lines to match */ + match_lines = atoi (optarg); + break; + + case 'r': /* regular expression */ + regexp_pattern = compile_regex (optarg); + break; +#endif + case 'v': verbose = 1; break; + } } - inname = argv[1]; - outname = argv[2]; + while (optind < argc) + { + if (!inname) + inname = argv[optind]; + else if (!outname) + outname = argv[optind]; + else + poppass = argv[optind]; + optind++; + } + + if (!inname || !outname) + { + fprintf (stderr, "Usage: movemail [-rvxk] [-l lines ] [-i] inbox [-o] destfile [[-p] POP-password]\n"); + exit(1); + } #ifdef MAIL_USE_MMDF mmdf_init (argv[0]); @@ -210,7 +301,7 @@ main (int argc, char *argv[]) #ifdef MAIL_USE_POP if (!strncmp (inname, "po:", 3)) { - int retcode = popmail (inname + 3, outname, argc > 3 ? argv[3] : NULL); + int retcode = popmail (inname + 3, outname, poppass); exit (retcode); } @@ -487,9 +578,9 @@ xmalloc (unsigned int size) #include #include -#define NOTOK (-1) -#define OK 0 -#define DONE 1 +#define POP_ERROR (-1) +#define POP_RETRIEVED (0) +#define POP_DONE (1) char *progname; FILE *sfi; @@ -502,11 +593,13 @@ static int popmail (char *user, char *outfile, char *password) { int nmsgs, nbytes; - register int i; + register int i, idx; int mbfi; + short* retrieved_list; FILE *mbf; popserver server; + VERBOSE(("opening server\r")); server = pop_open (0, user, password, POP_NO_GETPASS); if (! server) { @@ -514,6 +607,7 @@ popmail (char *user, char *outfile, char *password) return (1); } + VERBOSE(("stat'ing messages\r")); if (pop_stat (server, &nmsgs, &nbytes)) { error (pop_error, NULL, NULL); @@ -522,10 +616,15 @@ popmail (char *user, char *outfile, char *password) if (!nmsgs) { + VERBOSE(("closing server\n")); pop_close (server); return (0); } + /* build a retrieved table */ + retrieved_list = (short*) xmalloc (sizeof (short) * (nmsgs+1)); + memset (retrieved_list, 0, sizeof (short) * (nmsgs+1)); + mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); if (mbfi < 0) { @@ -546,23 +645,35 @@ popmail (char *user, char *outfile, char *password) return (1); } - for (i = 1; i <= nmsgs; i++) + for (idx = 0; idx < nmsgs; idx++) { - mbx_delimit_begin (mbf); - if (pop_retr (server, i, mbx_write, mbf) != OK) - { - error (Errmsg, NULL, NULL); - close (mbfi); - return (1); - } - mbx_delimit_end (mbf); - fflush (mbf); - if (ferror (mbf)) + i = reverse ? nmsgs - idx : idx + 1; + VERBOSE(("checking message %d \r", i)); + + if (!regexp_pattern + || + pop_search_top (server, i, match_lines, regexp_pattern) == POP_RETRIEVED) { - error ("Error in fflush: %s", strerror (errno), NULL); - pop_close (server); - close (mbfi); - return (1); + VERBOSE(("retrieving message %d \r", i)); + mbx_delimit_begin (mbf); + if (pop_retr (server, i, mbx_write, mbf) != POP_RETRIEVED) + { + error (Errmsg, NULL, NULL); + close (mbfi); + return (1); + } + + retrieved_list[i]=1; + + mbx_delimit_end (mbf); + fflush (mbf); + if (ferror (mbf)) + { + error ("Error in fflush: %s", strerror (errno), NULL); + pop_close (server); + close (mbfi); + return (1); + } } } @@ -586,16 +697,24 @@ popmail (char *user, char *outfile, char *password) return (1); } - for (i = 1; i <= nmsgs; i++) + if (!keep_messages) { - if (pop_delete (server, i)) + for (i = 1; i <= nmsgs; i++) { - error (pop_error, NULL, NULL); - pop_close (server); - return (1); + if (retrieved_list[i] == 1) + { + VERBOSE(("deleting message %d \r", i)); + if (pop_delete (server, i)) + { + error (pop_error, NULL, NULL); + pop_close (server); + return (1); + } + } } } + VERBOSE(("closing server \n")); if (pop_quit (server)) { error (pop_error, NULL, NULL); @@ -615,7 +734,7 @@ pop_retr (popserver server, int msgno, int (*action)(), void *arg) { strncpy (Errmsg, pop_error, sizeof (Errmsg)); Errmsg[sizeof (Errmsg)-1] = '\0'; - return (NOTOK); + return (POP_ERROR); } while (! (ret = pop_retrieve_next (server, &line))) @@ -623,11 +742,11 @@ pop_retr (popserver server, int msgno, int (*action)(), void *arg) if (! line) break; - if ((*action)(line, arg) != OK) + if ((*action)(line, arg) != POP_RETRIEVED) { strcpy (Errmsg, strerror (errno)); pop_close (server); - return (NOTOK); + return (POP_ERROR); } } @@ -635,10 +754,56 @@ pop_retr (popserver server, int msgno, int (*action)(), void *arg) { strncpy (Errmsg, pop_error, sizeof (Errmsg)); Errmsg[sizeof (Errmsg)-1] = '\0'; - return (NOTOK); + return (POP_ERROR); } - return (OK); + return (POP_RETRIEVED); +} + +/* search the top lines of each message looking for a match */ +static int +pop_search_top (popserver server, int msgno, int lines, struct re_pattern_buffer* regexp) +{ + char *line; + int ret; + int match = POP_DONE; + + if (pop_top_first (server, msgno, lines, &line)) + { + strncpy (Errmsg, pop_error, sizeof (Errmsg)); + Errmsg[sizeof (Errmsg)-1] = '\0'; + return (POP_ERROR); + } + + while (! (ret = pop_top_next (server, &line))) + { + if (! line) + break; + + /* VERBOSE (("checking %s\n", line));*/ + if (match != POP_RETRIEVED) + { + if ((ret = re_match (regexp, line, strlen (line), 0, 0)) == -2 ) + { + strcpy (Errmsg, "error in regular expression"); + pop_close (server); + return (POP_ERROR); + } + else if (ret >=0) + { + match = POP_RETRIEVED; + } + } + } + + if (ret) + { + strncpy (Errmsg, pop_error, sizeof (Errmsg)); + Errmsg[sizeof (Errmsg)-1] = '\0'; + return (POP_ERROR); + } + + return match; } /* Do this as a macro instead of using strcmp to save on execution time. */ @@ -654,31 +819,57 @@ mbx_write (char *line, FILE *mbf) if (IS_FROM_LINE (line)) { if (fputc ('>', mbf) == EOF) - return (NOTOK); + return (POP_ERROR); } if (fputs (line, mbf) == EOF) - return (NOTOK); + return (POP_ERROR); if (fputc (0x0a, mbf) == EOF) - return (NOTOK); - return (OK); + return (POP_ERROR); + return (POP_RETRIEVED); } static int mbx_delimit_begin (FILE *mbf) { if (fputs ("\f\n0, unseen,,\n", mbf) == EOF) - return (NOTOK); - return (OK); + return (POP_ERROR); + return (POP_RETRIEVED); } static int mbx_delimit_end (FILE *mbf) { if (putc ('\037', mbf) == EOF) - return (NOTOK); - return (OK); + return (POP_ERROR); + return (POP_RETRIEVED); } +/* Turn a name, which is an ed-style (but Emacs syntax) regular + expression, into a real regular expression by compiling it. */ +static struct re_pattern_buffer* +compile_regex (char* regexp_pattern) +{ + char *err; + struct re_pattern_buffer *patbuf=0; + + patbuf = (struct re_pattern_buffer*) xmalloc (sizeof (struct re_pattern_buffer)); + patbuf->translate = NULL; + patbuf->fastmap = NULL; + patbuf->buffer = NULL; + patbuf->allocated = 0; + + err = (char*) re_compile_pattern (regexp_pattern, strlen (regexp_pattern), patbuf); + if (err != NULL) + { + error ("%s while compiling pattern", err, NULL); + return 0; + } + + return patbuf; +} + + + #endif /* MAIL_USE_POP */ #ifndef HAVE_STRERROR diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6c2d639..92e8583 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,132 @@ +1998-11-28 SL Baur + + * XEmacs 21.2-beta4 is released. + +1998-11-27 Jan Vroonhof + + * easymenu.el (easy-menu-add-item): Wraper around add-menu-btton. + (easy-menu-item-present-p): Wrapper around find-menu-item. + (easy-menu-remove-item): Wrapper around delete-menu-item. + + * menubar.el (delete-menu-item): Add 'from-menu' argument. + (add-menu-button): Add 'in-menu' argument. + (add-menu-item-1): Add in-menu support to helper function. + +1998-11-27 Katsumi Yamaoka + + * isearch-mode.el (isearch-mode): Fix keymap lossage. + +1998-11-26 Jan Vroonhof + + * faces.el (get-custom-frame-properties): Revert Hrvoje Niksic change + of Dec 4, 1997. + +1998-11-25 Hrvoje Niksic + + * process.el (shell-command-on-region): Report if the command + succeeded or failed. + +1998-11-24 Hrvoje Niksic + + * subr.el (buffer-substring-no-properties): Comment out. + +1998-11-07 Adrian Aichner + + * msw-faces.el (mswindows-find-smaller-font): Turning font names + into font instances first, like `x-frob-font-size' does. + (mswindows-find-larger-font): ditto + +1998-11-04 Greg Klanderman + + * package-ui.el (pui-install-selected-packages): fix args in call + to `package-get'. + +1998-10-29 Jan Vroonhof + + * package-get.el (host-name): New widget type. + (package-get-remote): Better customization using new type. + (package-get-download-sites): idem dito. + + (package-get-custom): Do not use package-get-all untill we have + runtime dependencies. + + (package-get-remove-copy): Default to 't' we no longer need this + kludge as we do not currently use depenencies. + + (package-get-was-current): New variable. + (package-get-require-base): New 'force-current' argument. + (package-get-update-base): idem + (package-get-package-provider): idem + (package-get-locate-index-file): New 'no-remote' argument. + (package-get-locate-file): idem. + + (package-get-maybe-save-index): New function. + (package-get-update-base): Use it. + +1998-10-28 Greg Klanderman + + * package-get.el (package-get-remote): default to nil; by default, + don't go out to the net via EFS. They must select a download site. + (package-get-download-sites): new variable. + (package-get-download-menu): new function. + (package-get-locate-index-file): new function. + (package-get-update-base): use it. + + * menubar-items.el (default-menubar): add "Update Package Index" + and "Add Download Site" menus under Options | Manage Packages. + +1998-10-19 Greg Klanderman + + * package-get.el (package-get): bugfix code checking installed version + for case where package is not currently installed. + (package-get-require-signed-base-updates): new variable. + (package-get-update-base-from-buffer): remove REMOTE-SOURCE arg, it was + deemed not a goot thing. Use the variable + package-get-allow-unsigned-base-updates instead. + +1998-10-16 Greg Klanderman + + * package-get.el (package-get): Don't install an older version than + we already have unless explicitly told to. Issue a warning. + + * package-ui.el (pui-add-required-packages): when adding + dependencies, don't add packages that are up to date. + (pui-package-symbol-char): Don't consider a package out of date + if you have a newer version installed than the latest version in + package-get-base. + + * package-get.el (package-get-base-filename): document that it may + be a path relative to package-get-remote; new default value. + (package-get-locate-file): new function. + (package-get-update-base): use it to expand package-get-base-filename. + (package-get-save-base): new function to save the package-get database + to file. + (package-get-update-base-from-buffer): add REMOTE-SOURCE argument. + (package-get-update-base): pass the REMOTE-SOURCE arg. + (package-get-update-base-entry): call package-get-custom-add-entry. + (package-get-file-installed-p): removed; no longer needed. + (package-get-create-custom): ditto. + (toplevel): remove code to build and load package-get-custom.el + (package-get-custom-add-entry): new function. + +1998-10-12 Hrvoje Niksic + + * wid-edit.el (widget-button-click): Don't switch window. + +1998-10-22 Jan Vroonhof + + * cus-face.el (custom-set-face-update-spec): Add autoload cookie + +1998-10-20 Malcolm Box + + * etags.el (find-tag-default): Run find-tag-hook using + run-hooks rather than funcall + +1998-10-19 Hrvoje Niksic + + * isearch-mode.el (isearch-mode): Set the current minor mode maps + and the current local map as the parents to isearch-mode-map. + 1998-10-15 SL Baur * XEmacs 21.2-beta3 is released. diff --git a/lisp/about.el b/lisp/about.el index 1bb1241..e70d07e 100644 --- a/lisp/about.el +++ b/lisp/about.el @@ -1384,6 +1384,7 @@ above. We couldn't have done it without them.\n\n" (print-short "Yasuhiko Kiuchi" "kiuchi@dsp.ksp.fujixerox.co.jp") (print-short "Greg Klanderman" "greg.klanderman@alum.mit.edu") (print-short "Valdis Kletnieks" "Valdis.Kletnieks@vt.edu") + (print-short "Norbert Koch" "n.koch@delta-ii.de") (print-short "Rob Kooper" "kooper@cc.gatech.edu") (print-short "Peter Skov Knudsen" "knu@dde.dk") (print-short "Jens Krinke" "krinke@ips.cs.tu-bs.de") @@ -1510,6 +1511,7 @@ above. We couldn't have done it without them.\n\n" (print-short "Jason Yanowitz" "yanowitz@eternity.cs.umass.edu") (print-short "La Monte Yarroll" "piggy@hilbert.maths.utas.edu.au") (print-short "Blair Zajac" "blair@olympia.gps.caltech.edu") + (print-short "Volker Zell" "vzell@de.oracle.com") (print-short "Daniel Zivkovic" "daniel@canada.sun.com") (print-short "Karel Zuiderveld" "Karel.Zuiderveld@cv.ruu.nl") "\n")) diff --git a/lisp/auto-autoloads.el b/lisp/auto-autoloads.el index c5965ae..517e889 100644 --- a/lisp/auto-autoloads.el +++ b/lisp/auto-autoloads.el @@ -665,11 +665,15 @@ The format is suitable for use with `easy-menu-define'." nil nil) ;;;*** -;;;### (autoloads (custom-set-faces custom-declare-face) "cus-face" "lisp/cus-face.el") +;;;### (autoloads (custom-set-faces custom-set-face-update-spec custom-declare-face) "cus-face" "lisp/cus-face.el") (autoload 'custom-declare-face "cus-face" "\ Like `defface', but FACE is evaluated as a normal argument." nil nil) +(autoload 'custom-set-face-update-spec "cus-face" "\ +Customize the FACE for display types matching DISPLAY, merging + in the new items from PLIST" nil nil) + (autoload 'custom-set-faces "cus-face" "\ Initialize faces according to user preferences. The arguments should be a list where each entry has the form: @@ -1204,22 +1208,38 @@ Install a pre-bytecompiled XEmacs package into package hierarchy." t nil) ;;;*** -;;;### (autoloads (package-get-custom package-get-package-provider package-get package-get-dependencies package-get-all package-get-update-all package-get-delete-package package-get-update-base-from-buffer package-get-update-base package-get-update-base-entry package-get-require-base) "package-get" "lisp/package-get.el") +;;;### (autoloads (package-get-custom package-get-package-provider package-get package-get-dependencies package-get-all package-get-update-all package-get-delete-package package-get-save-base package-get-update-base-from-buffer package-get-update-base package-get-update-base-entry package-get-require-base package-get-download-menu) "package-get" "lisp/package-get.el") + +(autoload 'package-get-download-menu "package-get" "\ +Build the `Add Download Site' menu." nil nil) (autoload 'package-get-require-base "package-get" "\ -Require that a package-get database has been loaded." nil nil) +Require that a package-get database has been loaded. +If the optional FORCE-CURRENT argument or the value of +`package-get-always-update' is Non-nil, try to update the database +from a location in `package-get-remote'. Otherwise a local copy is used +if available and remote access is never done. + +Please use FORCE-CURRENT only when the user is explictly dealing with packages +and remote access is likely in the near future." nil nil) (autoload 'package-get-update-base-entry "package-get" "\ Update an entry in `package-get-base'." nil nil) (autoload 'package-get-update-base "package-get" "\ -Update the package-get database file with entries from DB-FILE." t nil) +Update the package-get database file with entries from DB-FILE. +Unless FORCE-CURRENT is non-nil never try to update the database." t nil) (autoload 'package-get-update-base-from-buffer "package-get" "\ Update the package-get database with entries from BUFFER. BUFFER defaults to the current buffer. This command can be used interactively, for example from a mail or news buffer." t nil) +(autoload 'package-get-save-base "package-get" "\ +Write the package-get database to FILE. + +Note: This database will be unsigned of course." t nil) + (autoload 'package-get-delete-package "package-get" "\ Delete an installation of PACKAGE below directory PKG-TOPDIR. PACKAGE is a symbol, not a string. @@ -1272,7 +1292,10 @@ successfully installed but errors occurred during initialization, or Search for a package that provides SYM and return the name and version. Searches in `package-get-base' for SYM. If SYM is a consp, then it must match a corresponding (provide (SYM VERSION)) from - the package." t nil) + the package. + +If FORCE-CURRENT is non-nil make sure the database is up to date. This might +lead to Emacs accessing remote sites." t nil) (autoload 'package-get-custom "package-get" "\ Fetch and install the latest versions of all customized packages." t nil) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 1660a7a..6be65ba 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -226,6 +226,7 @@ If FRAME is nil, use the default face." (fontobj (font-create-object font))) (font-family fontobj))) +;;;###autoload (defun custom-set-face-update-spec (face display plist) "Customize the FACE for display types matching DISPLAY, merging in the new items from PLIST" diff --git a/lisp/custom-load.el b/lisp/custom-load.el index a8af512..44c31352 100644 --- a/lisp/custom-load.el +++ b/lisp/custom-load.el @@ -75,7 +75,6 @@ (custom-add-loads 'isearch '("isearch-mode")) (custom-add-loads 'font-lock-faces '("font-lock")) (custom-add-loads 'modeline '("modeline")) -(custom-add-loads 'packages '("package-get-custom")) (custom-add-loads 'editing '("simple" "abbrev" "fill" "mouse" "cus-edit" "dragdrop")) (custom-add-loads 'matching '("simple" "isearch-mode" "hyper-apropos")) (custom-add-loads 'i18n '("cus-edit")) diff --git a/lisp/easymenu.el b/lisp/easymenu.el index 3bd9f34..9678183 100644 --- a/lisp/easymenu.el +++ b/lisp/easymenu.el @@ -23,7 +23,9 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Synched up with: Not synched with FSF. +;;; Synched up with: Not synched with FSF but coordinated with the FSF +;;; easymenu maintor for compatability with FSF 20.4. +;;; Please: Coordinate changes with Inge Frick ;; Commentary: @@ -63,6 +65,15 @@ ;; - Function: easy-menu-remove MENU ;; Remove MENU from the current menubar. +;; - Function: easy-menu-add-item +;; Add item or submenu to existing menu + +;; - Function: easy-menu-item-present-p +;; Locate item + +;; - Function: easy-menu-remove-item +;; Delete item from menu. + ;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus ;; automatically appear and disappear when the keymaps specified by ;; the MAPS argument to `easy-menu-define' are activated. @@ -200,6 +211,50 @@ is a list of menu items, as above." (assoc (car menu) current-menubar) (delete-menu-item (list (car menu))))))) +(defsubst easy-menu-normalize (menu) + (if (symbolp menu) + (symbol-value menu) + menu)) + +(defun easy-menu-add-item (menu path item &optional before) + "At the end of the submenu of MENU with path PATH add ITEM. +If ITEM is already present in this submenu, then this item will be changed. +otherwise ITEM will be added at the end of the submenu, unless the optional +argument BEFORE is present, in which case ITEM will instead be added +before the item named BEFORE. +MENU is either a symbol, which have earlier been used as the first +argument in a call to `easy-menu-define', or the value of such a symbol +i.e. a menu, or nil which stands for the current menubar. +PATH is a list of strings for locating the submenu where ITEM is to be +added. If PATH is nil, MENU itself is used. Otherwise, the first +element should be the name of a submenu directly under MENU. This +submenu is then traversed recursively with the remaining elements of PATH. +ITEM is either defined as in `easy-menu-define', a menu defined earlier +by `easy-menu-define' or `easy-menu-create-menu' or an item returned +from `easy-menu-item-present-p' or `easy-menu-remove-item'." + (add-menu-button path item before (easy-menu-normalize menu))) + +(defun easy-menu-item-present-p (menu path name) + "In submenu of MENU with path PATH, return true iff item NAME is present. +MENU and PATH are defined as in `easy-menu-add-item'. +NAME should be a string, the name of the element to be looked for. + +The return value can be used as as an argument to `easy-menu-add-item'." + (car (find-menu-item (or (easy-menu-normalize menu) current-menubar) + (append path (list name))))) + +(defun easy-menu-remove-item (menu path name) + "From submenu of MENU with path PATH remove item NAME. +MENU and PATH are defined as in `easy-menu-add-item'. +NAME should be a string, the name of the element to be removed. + +The return value can be used as as an argument to `easy-menu-add-item'." + (delete-menu-item (append path (list name)) + (easy-menu-normalize menu))) + + + + ;; Think up a good title for the menu. Take the major-mode of the ;; buffer, strip the -mode part, convert hyphens to spaces, and ;; capitalize it. diff --git a/lisp/etags.el b/lisp/etags.el index 5edc1d4..08d26b5 100644 --- a/lisp/etags.el +++ b/lisp/etags.el @@ -554,7 +554,7 @@ Make it buffer-local in a mode hook. The function is called with no arguments.") (defvar find-tag-hook nil - "Function to call after a tag is found. + "*Function to call after a tag is found. Make it buffer-local in a mode hook. The function is called with no arguments.") @@ -777,11 +777,11 @@ Variables of note: (push-mark) (goto-char tag-point) (if find-tag-hook - (funcall find-tag-hook) + (run-hooks 'find-tag-hook) (if local-find-tag-hook - (funcall local-find-tag-hook)))) + (run-hooks 'local-find-tag-hook)))) (setq tags-loop-scan (list 'find-tag nil nil) - tags-loop-operate nil) + tags-loop-operate nil) ;; Return t in case used as the tags-loop-scan. t) diff --git a/lisp/faces.el b/lisp/faces.el index c847f37..1870bec 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1249,9 +1249,7 @@ If FRAME is nil, return the default frame properties." ;; and cache it... (set-frame-property frame 'custom-properties cache)) cache)) - ;; We avoid this cache, because various frame and device - ;; properties can change. - ;;(default-custom-frame-properties) + (default-custom-frame-properties) (t (setq default-custom-frame-properties (extract-custom-frame-properties (selected-frame)))))) diff --git a/lisp/isearch-mode.el b/lisp/isearch-mode.el index 961a0b7..8a611f2 100644 --- a/lisp/isearch-mode.el +++ b/lisp/isearch-mode.el @@ -460,6 +460,10 @@ is treated as a regexp. See \\[isearch-forward] for more info." isearch-mode (gettext " Isearch") ) + (let ((map (append (current-minor-mode-maps) + (list (current-local-map))))) + (if (keymapp map) + (set-keymap-parents isearch-mode-map map))) ;; XEmacs change: without clearing the match data, sometimes old values ;; of isearch-other-end get used. Don't ask me why... diff --git a/lisp/menubar-items.el b/lisp/menubar-items.el index 0eb7865..7879ea0 100644 --- a/lisp/menubar-items.el +++ b/lisp/menubar-items.el @@ -234,6 +234,10 @@ ["Browse..." customize-browse]) ("Manage Packages" + ("Add Download Site" + :filter (lambda (&rest junk) + (package-get-download-menu))) + ["Update Package Index" package-get-update-base] ["List & Install" pui-list-packages] ("Using Custom" ("Select" :filter (lambda (&rest junk) diff --git a/lisp/menubar.el b/lisp/menubar.el index fa55059..4ac3cf6 100644 --- a/lisp/menubar.el +++ b/lisp/menubar.el @@ -218,7 +218,7 @@ If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." (car item-path-list))))) (cons result parent))))) -(defun add-menu-item-1 (leaf-p menu-path new-item before) +(defun add-menu-item-1 (leaf-p menu-path new-item before in-menu) ;; This code looks like it could be cleaned up some more ;; Do we really need 6 calls to find-menu-item? (when before (setq before (normalize-menu-item-name before))) @@ -226,7 +226,7 @@ If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." (cond ((vectorp new-item) (aref new-item 0)) ((consp new-item) (car new-item)) (t nil))) - (menubar current-menubar) + (menubar (or in-menu current-menubar)) (menu (condition-case () (car (find-menu-item menubar menu-path)) (error nil))) @@ -292,7 +292,7 @@ If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." (set-menubar-dirty-flag) new-item)) -(defun add-menu-button (menu-path menu-leaf &optional before) +(defun add-menu-button (menu-path menu-leaf &optional before in-menu) "Add a menu item to some menu, creating the menu first if necessary. If the named item exists already, it is changed. MENU-PATH identifies the menu under which the new menu item should be inserted. @@ -301,12 +301,16 @@ MENU-PATH identifies the menu under which the new menu item should be inserted. MENU-LEAF is a menubar leaf node. See the documentation of `current-menubar'. BEFORE, if provided, is the name of a menu item before which this item should be added, if this item is not on the menu already. If the item is already - present, it will not be moved." - (add-menu-item-1 t menu-path menu-leaf before)) + present, it will not be moved. +If IN-MENU is present use that instead of `current-menubar' as the menu to +change. +" + ;; Note easymenu.el uses the fact that menu-leaf can be a submenu. + (add-menu-item-1 t menu-path menu-leaf before in-menu)) ;; I actually liked the old name better, but the interface has changed too ;; drastically to keep it. --Stig -(defun add-submenu (menu-path submenu &optional before) +(defun add-submenu (menu-path submenu &optional before in-menu) "Add a menu to the menubar or one of its submenus. If the named menu exists already, it is changed. MENU-PATH identifies the menu under which the new menu should be inserted. @@ -319,7 +323,7 @@ BEFORE, if provided, is the name of a menu before which this menu should be added, if this menu is not on its parent already. If the menu is already present, it will not be moved." (check-menu-syntax submenu nil) - (add-menu-item-1 nil menu-path submenu before)) + (add-menu-item-1 nil menu-path submenu before in-menu)) (defun purecopy-menubar (x) ;; this calls purecopy on the strings, and the contents of the vectors, @@ -340,11 +344,12 @@ BEFORE, if provided, is the name of a menu before which this menu should (t (purecopy x)))) -(defun delete-menu-item (path) +(defun delete-menu-item (path &optional from-menu) "Remove the named menu item from the menu hierarchy. PATH is a list of strings which identify the position of the menu item in the menu hierarchy. The documentation of `add-submenu' describes menu-paths." - (let* ((pair (condition-case nil (find-menu-item current-menubar path) + (let* ((pair (condition-case nil (find-menu-item (or from-menu + current-menubar) path) (error nil))) (item (car pair)) (parent (or (cdr pair) current-menubar))) diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el index b2e52f4..e77f415 100644 --- a/lisp/msw-faces.el +++ b/lisp/msw-faces.el @@ -145,6 +145,9 @@ font. If it fails, it returns nil." (defun mswindows-find-smaller-font (font &optional device) "Loads a new version of the given font (or font name) 1 point smaller. Returns the font if it succeeds, nil otherwise." + (if (stringp font) (setq font (make-font-instance font device))) + (if (font-instance-p font) (setq font (font-instance-truename font))) + (if (stringp font) (setq font (make-font-instance font device))) (if (font-instance-p font) (let (old-size (name (mswindows-font-canonicalize-name font))) (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) @@ -160,6 +163,9 @@ Returns the font if it succeeds, nil otherwise." (defun mswindows-find-larger-font (font &optional device) "Loads a new version of the given font (or font name) 1 point larger. Returns the font if it succeeds, nil otherwise." + (if (stringp font) (setq font (make-font-instance font device))) + (if (font-instance-p font) (setq font (font-instance-truename font))) + (if (stringp font) (setq font (make-font-instance font device))) (if (font-instance-p font) (let (old-size (name (mswindows-font-canonicalize-name font))) (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) diff --git a/lisp/package-get.el b/lisp/package-get.el index 023fe91..383e0ff 100644 --- a/lisp/package-get.el +++ b/lisp/package-get.el @@ -3,6 +3,8 @@ ;; Copyright (C) 1998 by Pete Ware ;; Author: Pete Ware +;; Heavy-Modifications: Greg Klanderman +;; Jan Vroonhof ;; Keywords: internal ;; This file is part of XEmacs. @@ -29,6 +31,9 @@ ;; package-get - ;; Retrieve a package and any other required packages from an archive ;; +;; +;; Note (JV): Most of this no longer aplies! +;; ;; The idea: ;; A new XEmacs lisp-only release is generated with the following steps: ;; 1. The maintainer runs some yet to be written program that @@ -160,39 +165,123 @@ one version of a package available.") :type 'directory :group 'package-get) -;; JV Any Custom expert know to get "Host" and "Dir" for the remote option -(defcustom package-get-remote - '(("ftp.xemacs.org" "/pub/xemacs/packages")) +(define-widget 'host-name 'string + "A Host name." + :tag "Host") + +(defcustom package-get-remote nil "*List of remote sites to contact for downloading packages. List format is '(site-name directory-on-site). Each site is tried in order until the package is found. As a special case, `site-name' can be `nil', in which case `directory-on-site' is treated as a local directory." :tag "Package repository" :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory ) - (list :tag "Remote" string string) )) + (list :tag "Remote" host-name directory) )) :group 'package-get) -(defcustom package-get-remove-copy nil +(defcustom package-get-download-sites + '( + ;; North America + ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages") + ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages") + + ;; South America + ("unicamp.br" "ftp.unicamp.br" "pub/xemacs/packages") + + ;; Europe + ("sunsite.cnlab-switch.ch" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages") + ("tu-darmstadt.de" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") + ("sunsite.auc.dk" "sunsite.auc.dk" "pub/emacs/xemacs/packages") + ("pasteur.fr" "ftp.pasteur.fr" "pub/computing/xemacs/packages") + ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages") + ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages") + ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") + ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") + ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages") + ("doc.ic.ac.uk" "ftp.doc.ic.ac.uk" "packages/xemacs/packages") + ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages") + + ;; Asia + ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages") + ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") + ("jaist.ac.jp" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") + ("ring.aist.go.jp" "ring.aist.go.jp" "pub/text/xemacs/packages") + ("ring.asahi-net.or.jp" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") + ("SunSITE.sut.ac.jp" "SunSITE.sut.ac.jp" "pub/archives/packages/xemacs/packages") + ("dti.ad.jp" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") + ("kreonet.re.kr" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages") + ) + "*List of remote sites available for downloading packages. +List format is '(site-description site-name directory-on-site). +SITE-DESCRIPTION is a textual description of the site. SITE-NAME +is the internet address of the download site. DIRECTORY-ON-SITE +is the directory on the site in which packages may be found. +This variable is used to initialize `package-get-remote', the +variable actually used to specify package download sites." + :tag "Package download sites" + :type '(repeat (list hostname directory)) + :group 'package-get) + +(defcustom package-get-remove-copy t "*After copying and installing a package, if this is T, then remove the copy. Otherwise, keep it around." :type 'boolean :group 'package-get) -(defcustom package-get-base-filename - "/ftp.xemacs.org:/pub/xemacs/packages/package-index.LATEST" - "*Name of the default package database file, usually on ftp.xemacs.org." +;; #### it may make sense for this to be a list of names. +;; #### also, should we rename "*base*" to "*index*" or "*db*"? +;; "base" is a pretty poor name. +(defcustom package-get-base-filename "package-index.LATEST.pgp" + "*Name of the default package-get database file. +This may either be a relative path, in which case it is interpreted +with respect to `package-get-remote', or an absolute path." :type 'file :group 'package-get) +(defcustom package-get-always-update nil + "*If Non-nil always make sure we are using the latest package index (base). +Otherwise respect the `force-current' argument of `package-get-require-base'." + :type 'boolean + :group 'package-get) + +(defcustom package-get-require-signed-base-updates t + "*If set to a non-nil value, require explicit user confirmation for updates +to the package-get database which cannot have their signature verified via PGP. +When nil, updates which are not PGP signed are allowed without confirmation." + :type 'boolean + :group 'package-get) + +(defvar package-get-was-current nil + "Non-nil we did our best to fetch a current database.") + ;;;###autoload -(defun package-get-require-base () - "Require that a package-get database has been loaded." - (when (or (not (boundp 'package-get-base)) - (not package-get-base)) - (package-get-update-base)) - (when (or (not (boundp 'package-get-base)) - (not package-get-base)) - (error "Package-get database not loaded"))) +(defun package-get-download-menu () + "Build the `Add Download Site' menu." + (mapcar (lambda (site) + (vector (car site) + `(push (quote ,(cdr site)) + package-get-remote))) + package-get-download-sites)) + +;;;###autoload +(defun package-get-require-base (&optional force-current) + "Require that a package-get database has been loaded. +If the optional FORCE-CURRENT argument or the value of +`package-get-always-update' is Non-nil, try to update the database +from a location in `package-get-remote'. Otherwise a local copy is used +if available and remote access is never done. + +Please use FORCE-CURRENT only when the user is explictly dealing with packages +and remote access is likely in the near future." + (setq force-current (or force-current package-get-always-update)) + (unless (and (boundp 'package-get-base) + package-get-base + (or (not force-current) package-get-was-current)) + (package-get-update-base nil force-current)) + (if (or (not (boundp 'package-get-base)) + (not package-get-base)) + (error "Package-get database not loaded") + (setq package-get-was-current force-current))) (defconst package-get-pgp-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----" "Text for start of PGP signed messages.") @@ -204,21 +293,72 @@ copy. Otherwise, keep it around." ;;;###autoload (defun package-get-update-base-entry (entry) "Update an entry in `package-get-base'." - (let ((existing (assoc (car entry) package-get-base))) + (let ((existing (assq (car entry) package-get-base))) (if existing (setcdr existing (cdr entry)) - (setq package-get-base (cons entry package-get-base))))) + (setq package-get-base (cons entry package-get-base)) + (package-get-custom-add-entry (car entry) (car (cdr entry)))))) + +(defun package-get-locate-file (file &optional nil-if-not-found no-remote) + "Locate an existing FILE with respect to `package-get-remote'. +If FILE is an absolute path or is not found, simply return FILE. +If optional argument NIL-IF-NOT-FOUND is non-nil, return nil +if FILE can not be located. +If NO-REMOTE is non-nil never search remote locations." + (if (file-name-absolute-p file) + file + (let ((entries package-get-remote) + (expanded nil)) + (while entries + (unless (and no-remote (caar entries)) + (let ((expn (package-get-remote-filename (car entries) file))) + (if (and expn (file-exists-p expn)) + (setq entries nil + expanded expn)))) + (setq entries (cdr entries))) + (or expanded + (and (not nil-if-not-found) + file))))) + +(defun package-get-locate-index-file (no-remote) + "Locate the package-get index file. Do not return remote paths if NO-REMOTE +is non-nil." + (or (package-get-locate-file package-get-base-filename t no-remote) + (locate-data-file package-get-base-filename) + package-get-base-filename)) + +(defvar package-get-user-package-location user-init-directory) + +(defun package-get-maybe-save-index (filename) + "Offer to save the current buffer as the local package index file, +if different." + (let ((location (package-get-locate-index-file t))) + (unless (and filename (equal filename location)) + (unless (equal (md5 (current-buffer)) + (with-temp-buffer + (insert-file-contents location) + (md5 (current-buffer)))) + (unless (file-writable-p location) + (setq location (expand-file-name package-get-base-filename + (expand-file-name "etc/" package-get-user-package-location)))) + (when (y-or-n-p (concat "Update package index in" location "? ")) + (write-file location)))))) + ;;;###autoload -(defun package-get-update-base (&optional db-file) - "Update the package-get database file with entries from DB-FILE." - (interactive (list - (read-file-name "Load package-get database: " - (file-name-directory package-get-base-filename) - package-get-base-filename - t - (file-name-nondirectory package-get-base-filename)))) - (setq db-file (expand-file-name (or db-file package-get-base-filename))) +(defun package-get-update-base (&optional db-file force-current) + "Update the package-get database file with entries from DB-FILE. +Unless FORCE-CURRENT is non-nil never try to update the database." + (interactive + (let ((dflt (package-get-locate-index-file nil))) + (list (read-file-name "Load package-get database: " + (file-name-directory dflt) + dflt + t + (file-name-nondirectory dflt))))) + (setq db-file (expand-file-name (or db-file + (package-get-locate-index-file + (not force-current))))) (if (not (file-exists-p db-file)) (error "Package-get database file `%s' does not exist" db-file)) (if (not (file-readable-p db-file)) @@ -229,7 +369,9 @@ copy. Otherwise, keep it around." (set-buffer buf) (erase-buffer buf) (insert-file-contents-internal db-file) - (package-get-update-base-from-buffer buf)) + (package-get-update-base-from-buffer buf) + (if (file-remote-p db-file) + (package-get-maybe-save-index db-file))) (kill-buffer buf)))) ;;;###autoload @@ -253,7 +395,8 @@ used interactively, for example from a mail or news buffer." (when (re-search-forward package-get-pgp-signature-end-line nil t) (setq end (point))) (if (not (and content-beg content-end beg end)) - (or (yes-or-no-p "Package-get entries not PGP signed, continue? ") + (or (not package-get-require-signed-base-updates) + (yes-or-no-p "Package-get entries not PGP signed, continue? ") (error "Package-get database not updated"))) (if (and content-beg content-end beg end) (if (not (condition-case nil @@ -261,7 +404,8 @@ used interactively, for example from a mail or news buffer." (load-library "mc-pgp") (fboundp 'mc-pgp-verify-region)) (error nil))) - (or (yes-or-no-p + (or (not package-get-require-signed-base-updates) + (yes-or-no-p "No mailcrypt; can't verify package-get DB signature, continue? ") (error "Package-get database not updated")))) (if (and beg end @@ -271,10 +415,13 @@ used interactively, for example from a mail or news buffer." (mc-pgp-verify-region beg end) (file-error (and (string-match "No such file" (nth 2 err)) - (yes-or-no-p - "Can't find PGP, continue without package-get DB verification? "))) + (or (not package-get-require-signed-base-updates) + (yes-or-no-p + (concat "Can't find PGP, continue without " + "package-get DB verification? "))))) (t nil))))) (error "Package-get PGP signature failed to verify")) + ;; ToDo: We shoud call package-get-maybe-save-index on the region (package-get-update-base-entries content-beg content-end) (message "Updated package-get database")))) @@ -299,12 +446,45 @@ BEG and END in the current buffer." (setq count (1+ count)))) (message "Got %d package-get database entries" count)))) +;;;###autoload +(defun package-get-save-base (file) + "Write the package-get database to FILE. + +Note: This database will be unsigned of course." + (interactive "FSave package-get database to: ") + (package-get-require-base t) + (let ((buf (get-buffer-create "*package database*"))) + (unwind-protect + (save-excursion + (set-buffer buf) + (erase-buffer buf) + (goto-char (point-min)) + (let ((entries package-get-base) entry plist) + (insert ";; Package Index file -- Do not edit manually.\n") + (insert ";;;@@@\n") + (while entries + (setq entry (car entries)) + (setq plist (car (cdr entry))) + (insert "(package-get-update-base-entry (quote\n") + (insert (format "(%s\n" (symbol-name (car entry)))) + (while plist + (insert (format " %s%s %S\n" + (if (eq plist (car (cdr entry))) "(" " ") + (symbol-name (car plist)) + (car (cdr plist)))) + (setq plist (cdr (cdr plist)))) + (insert "))\n))\n;;;@@@\n") + (setq entries (cdr entries)))) + (insert ";; Package Index file ends here\n") + (write-region (point-min) (point-max) file)) + (kill-buffer buf)))) + (defun package-get-interactive-package-query (get-version package-symbol) "Perform interactive querying for package and optional version. Query for a version if GET-VERSION is non-nil. Return package name as a symbol instead of a string if PACKAGE-SYMBOL is non-nil. The return value is suitable for direct passing to `interactive'." - (package-get-require-base) + (package-get-require-base t) (let ( (table (mapcar '(lambda (item) (let ( (name (symbol-name (car item))) ) (cons name name) @@ -347,7 +527,7 @@ This is just an interactive wrapper for `package-admin-delete-binary-package'." (defun package-get-update-all () "Fetch and install the latest versions of all currently installed packages." (interactive) - (package-get-require-base) + (package-get-require-base t) ;; Load a fresh copy (catch 'exit (mapcar (lambda (pkg) @@ -392,7 +572,7 @@ Returns nil upon error." (while this-requires (if (not (member (car this-requires) fetched-packages)) (let* ((reqd-package (package-get-package-provider - (car this-requires))) + (car this-requires) t)) (reqd-version (cadr reqd-package)) (reqd-name (car reqd-package))) (if (null reqd-name) @@ -415,7 +595,7 @@ Returns nil upon error." Uses `package-get-base' to determine just what is required and what package provides that functionality. Returns the list of packages required by PACKAGES." - (package-get-require-base) + (package-get-require-base t) (let ((orig-packages packages) dependencies provided) (while packages @@ -509,10 +689,13 @@ Returns `t' upon success, the symbol `error' if the package was successfully installed but errors occurred during initialization, or `nil' upon error." (interactive (package-get-interactive-package-query nil t)) + (catch 'skip-update (let* ((this-package (package-get-info-version (package-get-info-find-package package-get-base package) version)) + (latest (package-get-info-prop this-package 'version)) + (installed (package-get-key package :version)) (this-requires (package-get-info-prop this-package 'requires)) (found nil) (search-dirs package-get-remote) @@ -529,6 +712,22 @@ successfully installed but errors occurred during initialization, or (package-admin-get-install-dir package install-dir (or (eq package 'mule-base) (memq 'mule-base this-requires)))) + ;; If they asked for the latest using version=nil, don't get an older + ;; version than we already have. + (if installed + (if (> (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp latest) + (string-to-number latest) + latest)) + (if (not (null version)) + (warn "Installing %s package version %s, you had a newer version %s" + package latest installed) + (warn "Skipping %s package, you have a newer version %s" + package installed) + (throw 'skip-update t)))) + ;; Contrive a list of possible package filenames. ;; Ugly. Is there a better way to do this? (setq filenames (cons base-filename nil)) @@ -537,7 +736,7 @@ successfully installed but errors occurred during initialization, or (list (concat (match-string 1 base-filename) ".tgz"))))) - (setq version (package-get-info-prop this-package 'version)) + (setq version latest) (unless (and (eq conflict 'never) (package-get-installedp package version)) ;; Find the package from the search list in package-get-remote @@ -657,7 +856,7 @@ successfully installed but errors occurred during initialization, or (if (and found package-get-remove-copy) (delete-file full-package-filename)) package-status - )) + ))) (defun package-get-info-find-package (which name) "Look in WHICH for the package called NAME and return all the info @@ -758,13 +957,16 @@ some built in variables. For now, use packages-package-list." (if (floatp version) version (string-to-number version)))) ;;;###autoload -(defun package-get-package-provider (sym) +(defun package-get-package-provider (sym &optional force-current) "Search for a package that provides SYM and return the name and version. Searches in `package-get-base' for SYM. If SYM is a consp, then it must match a corresponding (provide (SYM VERSION)) from - the package." + the package. + +If FORCE-CURRENT is non-nil make sure the database is up to date. This might +lead to Emacs accessing remote sites." (interactive "SSymbol: ") - (package-get-require-base) + (package-get-require-base force-current) (let ((packages package-get-base) (done nil) (found nil)) @@ -774,12 +976,14 @@ some built in variables. For now, use packages-package-list." (while (and (not done) this-package) (if (or (eq this-name sym) (eq (cons this-name - (package-get-info-prop (car this-package) 'version)) + (package-get-info-prop (car this-package) 'version)) sym) - (member sym (package-get-info-prop (car this-package) 'provides))) + (member sym + (package-get-info-prop (car this-package) 'provides))) (progn (setq done t) - (setq found (list (caar packages) - (package-get-info-prop (car this-package) 'version)))) + (setq found + (list (caar packages) + (package-get-info-prop (car this-package) 'version)))) (setq this-package (cdr this-package))))) (setq packages (cdr packages))) found)) @@ -796,12 +1000,12 @@ some built in variables. For now, use packages-package-list." (defun package-get-custom () "Fetch and install the latest versions of all customized packages." (interactive) - (package-get-require-base) + (package-get-require-base t) ;; Load a fresh copy (load "package-get-custom.el") (mapcar (lambda (pkg) (if (eval (intern (concat (symbol-name (car pkg)) "-package"))) - (package-get-all (car pkg) nil)) + (package-get (car pkg) nil)) t) package-get-base)) @@ -814,83 +1018,26 @@ some built in variables. For now, use packages-package-list." (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) t))) -(defun package-get-file-installed-p (file &optional paths) - "Return absolute-path of FILE if FILE exists in PATHS. -If PATHS is omitted, `load-path' is used." - (if (null paths) - (setq paths load-path) - ) - (catch 'tag - (let (path) - (while paths - (setq path (expand-file-name file (car paths))) - (if (file-exists-p path) - (throw 'tag path) - ) - (setq paths (cdr paths)) - )))) +(defvar package-get-custom-groups nil + "List of package-get-custom groups") + +(defun package-get-custom-add-entry (package props) + (let* ((category (plist-get props 'category)) + (group (intern (concat category "-packages"))) + (custom-var (intern (concat (symbol-name package) "-package"))) + (description (plist-get props 'description))) + (when (not (memq group package-get-custom-groups)) + (setq package-get-custom-groups (cons package + package-get-custom-groups)) + (eval `(defgroup ,group nil + ,(concat category " package group") + :group 'packages))) + (eval `(defcustom ,custom-var nil + ,description + :group ',group + :initialize 'package-get-ever-installed-p + :type 'boolean)))) -(defun package-get-create-custom () - "Creates a package customization file package-get-custom.el. -Entries in the customization file are retrieved from package-get-base.el." - (interactive) - ;; Load a fresh copy - (let ((custom-buffer (find-file-noselect - (or (package-get-file-installed-p - "package-get-custom.el") - (expand-file-name - "package-get-custom.el" - (file-name-directory - (package-get-file-installed-p - "package-get-base.el")) - )))) - (pkg-groups nil)) - - ;; clear existing stuff - (delete-region (point-min custom-buffer) - (point-max custom-buffer) custom-buffer) - (insert-string "(require 'package-get)\n" custom-buffer) - (mapcar (lambda (pkg) - (let ((category (plist-get (car (cdr pkg)) 'category))) - (or (memq (intern category) pkg-groups) - (progn - (setq pkg-groups (cons (intern category) pkg-groups)) - (insert-string - (concat "(defgroup " category "-packages nil\n" - " \"" category " package group\"\n" - " :group 'packages)\n\n") custom-buffer))) - - (insert-string - (concat "(defcustom " (symbol-name (car pkg)) - "-package nil \n" - " \"" (plist-get (car (cdr pkg)) 'description) "\"\n" - " :group '" category "-packages\n" - " :initialize 'package-get-ever-installed-p\n" - " :type 'boolean)\n\n") custom-buffer))) - package-get-base) custom-buffer) - ) - -;; need this first to avoid infinite dependency loops (provide 'package-get) - -;; potentially update the custom dependencies every time we load this -(when nil ;; #### disable for now... -gk -(unless noninteractive -(let ((custom-file (package-get-file-installed-p "package-get-custom.el")) - (package-file (package-get-file-installed-p "package-get-base.el"))) - ;; update custom file if it doesn't exist - (if (or (not custom-file) - (and (< (car (nth 5 (file-attributes custom-file))) - (car (nth 5 (file-attributes package-file)))) - (< (car (nth 5 (file-attributes custom-file))) - (car (nth 5 (file-attributes package-file)))))) - (save-excursion - (message "generating package customizations...") - (set-buffer (package-get-create-custom)) - (save-buffer) - (message "generating package customizations...done"))) - (load "package-get-custom.el"))) -) - ;;; package-get.el ends here diff --git a/lisp/package-ui.el b/lisp/package-ui.el index f13ed9b..3e49ae3 100644 --- a/lisp/package-ui.el +++ b/lisp/package-ui.el @@ -213,9 +213,15 @@ disk." (defun pui-package-symbol-char (pkg-sym version) (progn (if (package-get-info-find-package packages-package-list pkg-sym) - (if (package-get-installedp pkg-sym version) - (list " " pui-up-to-date-package-face) - (list "*" pui-outdated-package-face)) + (let ((installed (package-get-key pkg-sym :version))) + (if (>= (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp version) + (string-to-number version) + version)) + (list " " pui-up-to-date-package-face) + (list "*" pui-outdated-package-face))) (list "-" pui-uninstalled-package-face)) )) @@ -332,8 +338,8 @@ and whether or not it is up-to-date." (message "Installing selected packages ...") (sit-for 0) (if (catch 'done (mapcar (lambda (pkg) - (if (not (package-get pkg - pui-package-install-dest-dir)) + (if (not (package-get pkg nil nil + pui-package-install-dest-dir)) (throw 'done nil))) pui-selected-packages) t) @@ -353,7 +359,26 @@ and whether or not it is up-to-date." (interactive) (let ((tmpbuf "*Required-Packages*") do-select) (if pui-selected-packages - (let ((dependencies (package-get-dependencies pui-selected-packages))) + (let ((dependencies + (delq nil (mapcar + (lambda (pkg) + (let ((installed + (package-get-key pkg :version)) + (current + (package-get-info-prop + (package-get-info-version + (package-get-info-find-package + package-get-base pkg) nil) + 'version))) + (if (< (if (stringp installed) + (string-to-number installed) + installed) + (if (stringp current) + (string-to-number current) + current)) + pkg + nil))) + (package-get-dependencies pui-selected-packages))))) ;; Don't change window config when asking the user if he really ;; wants to add the packages. We do this to avoid messing up ;; the window configuration if errors occur (we don't want to @@ -471,7 +496,7 @@ buffer, the user can see which packages are installed, which are not, and which are out-of-date (a newer version is available). The user can then select packages for installation via the keyboard or mouse." (interactive) - (package-get-require-base) + (package-get-require-base t) (let ( (outbuf (get-buffer-create pui-info-buffer)) (sep-string "===============================================================================\n") start ) diff --git a/lisp/process.el b/lisp/process.el index fb46f35..1c93601 100644 --- a/lisp/process.el +++ b/lisp/process.el @@ -245,6 +245,7 @@ In either case, the output is inserted after point (leaving mark after it)." (let ((buffer (get-buffer-create (or output-buffer "*Shell Command Output*"))) (success nil) + (exit-status nil) (directory default-directory)) (unwind-protect (if (eq buffer (current-buffer)) @@ -254,9 +255,10 @@ In either case, the output is inserted after point (leaving mark after it)." (progn (setq buffer-read-only nil) (delete-region (max start end) (point-max)) (delete-region (point-min) (max start end)) - (call-process-region (point-min) (point-max) - shell-file-name t t nil - shell-command-switch command) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t t nil + shell-command-switch command)) (setq success t)) ;; Clear the output buffer, ;; then run the command with output there. @@ -266,9 +268,10 @@ In either case, the output is inserted after point (leaving mark after it)." ;; XEmacs change (setq default-directory directory) (erase-buffer)) - (call-process-region start end shell-file-name - nil buffer nil - shell-command-switch command) + (setq exit-status + (call-process-region start end shell-file-name + nil buffer nil + shell-command-switch command)) (setq success t)) ;; Report the amount of output. (let ((lines (save-excursion @@ -280,7 +283,9 @@ In either case, the output is inserted after point (leaving mark after it)." (if success (display-message 'command - "(Shell command completed with no output)")) + (if (eql exit-status 0) + "(Shell command succeeded with no output)" + "(Shell command failed with no output)"))) (kill-buffer buffer)) ((and success (= lines 1)) (message "%s" diff --git a/lisp/subr.el b/lisp/subr.el index d07033b..69af79b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -540,11 +540,12 @@ yourself.]" ;;;; Miscellanea. -(defun buffer-substring-no-properties (beg end) - "Return the text from BEG to END, without text properties, as a string." - (let ((string (buffer-substring beg end))) - (set-text-properties 0 (length string) nil string) - string)) +;; This is now in C. +;(defun buffer-substring-no-properties (beg end) +; "Return the text from BEG to END, without text properties, as a string." +; (let ((string (buffer-substring beg end))) +; (set-text-properties 0 (length string) nil string) +; string)) (defun get-buffer-window-list (&optional buffer minibuf frame) "Return windows currently displaying BUFFER, or nil if none. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index a311bc4..e7a5d96 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1063,48 +1063,49 @@ Recommended as a parent keymap for modes using widgets.") (defun widget-button-click (event) "Invoke button below mouse pointer." - (interactive "@e") - (cond ((event-glyph event) - (widget-glyph-click event)) - ((widget-event-point event) - (let* ((pos (widget-event-point event)) - (button (get-char-property pos 'button))) - (if button - (let* ((extent (widget-get button :button-extent)) - (face (extent-property extent 'face)) - (mouse-face (extent-property extent 'mouse-face)) - (help-echo (extent-property extent 'help-echo))) - (unwind-protect - (progn - ;; Merge relevant faces, and make the result mouse-face. - (let ((merge `(widget-button-pressed-face ,mouse-face))) - (nconc merge (if (listp face) - face (list face))) - (setq merge (delete-if-not 'find-face merge)) - (set-extent-property extent 'mouse-face merge)) - (unless (widget-apply button :mouse-down-action event) - ;; Wait for button release. - (while (not (button-release-event-p - (setq event (next-event)))) - (dispatch-event event))) - ;; Disallow mouse-face and help-echo. - (set-extent-property extent 'mouse-face nil) - (set-extent-property extent 'help-echo nil) - (setq pos (widget-event-point event)) - (unless (eq (current-buffer) (extent-object extent)) - ;; Barf if dispatch-event tripped us by - ;; changing buffer. - (error "Buffer changed during mouse motion")) - ;; Do the associated action. - (when (and pos (extent-in-region-p extent pos pos)) - (widget-apply-action button event))) - ;; Unwinding: fully release the button. - (set-extent-property extent 'mouse-face mouse-face) - (set-extent-property extent 'help-echo help-echo))) - ;; This should not happen! - (error "`widget-button-click' called outside button")))) - (t - (message "You clicked somewhere weird")))) + (interactive "e") + (with-current-buffer (event-buffer event) + (cond ((event-glyph event) + (widget-glyph-click event)) + ((widget-event-point event) + (let* ((pos (widget-event-point event)) + (button (get-char-property pos 'button))) + (if button + (let* ((extent (widget-get button :button-extent)) + (face (extent-property extent 'face)) + (mouse-face (extent-property extent 'mouse-face)) + (help-echo (extent-property extent 'help-echo))) + (unwind-protect + (progn + ;; Merge relevant faces, and make the result mouse-face. + (let ((merge `(widget-button-pressed-face ,mouse-face))) + (nconc merge (if (listp face) + face (list face))) + (setq merge (delete-if-not 'find-face merge)) + (set-extent-property extent 'mouse-face merge)) + (unless (widget-apply button :mouse-down-action event) + ;; Wait for button release. + (while (not (button-release-event-p + (setq event (next-event)))) + (dispatch-event event))) + ;; Disallow mouse-face and help-echo. + (set-extent-property extent 'mouse-face nil) + (set-extent-property extent 'help-echo nil) + (setq pos (widget-event-point event)) + (unless (eq (current-buffer) (extent-object extent)) + ;; Barf if dispatch-event tripped us by + ;; changing buffer. + (error "Buffer changed during mouse motion")) + ;; Do the associated action. + (when (and pos (extent-in-region-p extent pos pos)) + (widget-apply-action button event))) + ;; Unwinding: fully release the button. + (set-extent-property extent 'mouse-face mouse-face) + (set-extent-property extent 'help-echo help-echo))) + ;; This should not happen! + (error "`widget-button-click' called outside button")))) + (t + (message "You clicked somewhere weird"))))) (defun widget-button1-click (event) "Invoke glyph below mouse pointer." diff --git a/man/ChangeLog b/man/ChangeLog index d329245..8217209 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +1998-11-28 SL Baur + + * XEmacs 21.2-beta4 is released. + 1998-10-15 SL Baur * XEmacs 21.2-beta3 is released. diff --git a/man/internals/internals.texi b/man/internals/internals.texi index 7b8e67e..59d4c50 100644 --- a/man/internals/internals.texi +++ b/man/internals/internals.texi @@ -2045,7 +2045,7 @@ code generalization for future I18N work. @menu * Character-Related Data Types:: * Working With Character and Byte Positions:: -* Conversion of External Data:: +* Conversion to and from External Data:: * General Guidelines for Writing Mule-Aware Code:: * An Example of Mule-Aware Code:: @end menu @@ -2053,9 +2053,9 @@ code generalization for future I18N work. @node Character-Related Data Types @subsection Character-Related Data Types -First, we will list the basic character-related datatypes used by -XEmacs. Note that the separate @code{typedef}s are not required for the -code to work (all of them boil down to @code{unsigned char} or +First, let's review the basic character-related datatypes used by +XEmacs. Note that the separate @code{typedef}s are not mandatory in the +current implementation (all of them boil down to @code{unsigned char} or @code{int}), but they improve clarity of code a great deal, because one glance at the declaration can tell the intended use of the variable. @@ -2093,6 +2093,8 @@ Without Mule support, a @code{Bufbyte} is equivalent to an @item Bufpos @itemx Charcount +@cindex Bufpos +@cindex Charcount A @code{Bufpos} represents a character position in a buffer or string. A @code{Charcount} represents a number (count) of characters. Logically, subtracting two @code{Bufpos} values yields a @@ -2105,6 +2107,8 @@ ever visible to Lisp. @item Bytind @itemx Bytecount +@cindex Bytind +@cindex Bytecount A @code{Bytind} represents a byte position in a buffer or string. A @code{Bytecount} represents the distance between two positions in bytes. The relationship between @code{Bytind} and @code{Bytecount} is the same @@ -2112,6 +2116,8 @@ as the relationship between @code{Bufpos} and @code{Charcount}. @item Extbyte @itemx Extcount +@cindex Extbyte +@cindex Extcount When dealing with the outside world, XEmacs works with @code{Extbyte}s, which are equivalent to @code{unsigned char}. Obviously, an @code{Extcount} is the distance between two @code{Extbyte}s. Extbytes @@ -2130,6 +2136,7 @@ learn about them. @table @code @item MAX_EMCHAR_LEN +@cindex MAX_EMCHAR_LEN This preprocessor constant is the maximum number of buffer bytes per Emacs character, i.e. the byte length of an @code{Emchar}. It is useful when allocating temporary strings to keep a known number of characters. @@ -2155,10 +2162,12 @@ In the current Mule implementation, @code{MAX_EMCHAR_LEN} equals 4. Without Mule, it is 1. @item charptr_emchar -@item set_charptr_emchar -@code{charptr_emchar} macro takes a @code{Bufbyte} pointer and returns -the underlying @code{Emchar}. If it were a function, its prototype -would be: +@itemx set_charptr_emchar +@cindex charptr_emchar +@cindex set_charptr_emchar +The @code{charptr_emchar} macro takes a @code{Bufbyte} pointer and +returns the @code{Emchar} stored at that position. If it were a +function, its prototype would be: @example Emchar charptr_emchar (Bufbyte *p); @@ -2200,14 +2209,19 @@ and increment the counter, at the same time. @item INC_CHARPTR @itemx DEC_CHARPTR +@cindex INC_CHARPTR +@cindex DEC_CHARPTR These two macros increment and decrement a @code{Bufbyte} pointer, -respectively. The pointer needs to be correctly positioned at the -beginning of a valid character position. +respectively. They will adjust the pointer by the appropriate number of +bytes according to the byte length of the character stored there. Both +macros assume that the memory address is located at the beginning of a +valid character. Without Mule support, @code{INC_CHARPTR (p)} and @code{DEC_CHARPTR (p)} simply expand to @code{p++} and @code{p--}, respectively. @item bytecount_to_charcount +@cindex bytecount_to_charcount Given a pointer to a text string and a length in bytes, return the equivalent length in characters. @@ -2216,6 +2230,7 @@ Charcount bytecount_to_charcount (Bufbyte *p, Bytecount bc); @end example @item charcount_to_bytecount +@cindex charcount_to_bytecount Given a pointer to a text string and a length in characters, return the equivalent length in bytes. @@ -2224,6 +2239,7 @@ Bytecount charcount_to_bytecount (Bufbyte *p, Charcount cc); @end example @item charptr_n_addr +@cindex charptr_n_addr Return a pointer to the beginning of the character offset @var{cc} (in characters) from @var{p}. @@ -2232,55 +2248,118 @@ Bufbyte *charptr_n_addr (Bufbyte *p, Charcount cc); @end example @end table -@node Conversion of External Data -@subsection Conversion of External Data +@node Conversion to and from External Data +@subsection Conversion to and from External Data When an external function, such as a C library function, returns a -@code{char} pointer, you should never treat it as @code{Bufbyte}. This -is because these returned strings may contain 8bit characters which can -be misinterpreted by XEmacs, and cause a crash. Instead, you should use -a conversion macro. Many different conversion macros are defined in -@file{buffer.h}, so I will try to order them logically, by direction and -by format. - -Thus the basic conversion macros are @code{GET_CHARPTR_INT_DATA_ALLOCA} -and @code{GET_CHARPTR_EXT_DATA_ALLOCA}. The former is used to convert -external data to internal format, and the latter is used to convert the -other way around. The arguments each of these receives are @var{ptr} -(pointer to the text in external format), @var{len} (length of texts in -bytes), @var{fmt} (format of the external text), @var{ptr_out} (lvalue -to which new text should be copied), and @var{len_out} (lvalue which -will be assigned the length of the internal text in bytes). The -resulting text is stored to a stack-allocated buffer. If the text -doesn't need changing, these macros will do nothing, except for setting -@var{len_out}. +@code{char} pointer, you should almost never treat it as @code{Bufbyte}. +This is because these returned strings may contain 8bit characters which +can be misinterpreted by XEmacs, and cause a crash. Likewise, when +exporting a piece of internal text to the outside world, you should +always convert it to an appropriate external encoding, lest the internal +stuff (such as the infamous \201 characters) leak out. + +The interface to conversion between the internal and external +representations of text are the numerous conversion macros defined in +@file{buffer.h}. Before looking at them, we'll look at the external +formats supported by these macros. Currently meaningful formats are @code{FORMAT_BINARY}, -@code{FORMAT_FILENAME}, @code{FORMAT_OS}, and @code{FORMAT_CTEXT}. +@code{FORMAT_FILENAME}, @code{FORMAT_OS}, and @code{FORMAT_CTEXT}. Here +is a description of these. + +@table @code +@item FORMAT_BINARY +Binary format. This is the simplest format and is what we use in the +absence of a more appropriate format. This converts according to the +@code{binary} coding system: + +@enumerate a +@item +On input, bytes 0--255 are converted into characters 0--255. +@item +On output, characters 0--255 are converted into bytes 0--255 and other +characters are converted into `X'. +@end enumerate + +@item FORMAT_FILENAME +Format used for filenames. In the original Mule, this is user-definable +with the @code{pathname-coding-system} variable. For the moment, we +just use the @code{binary} coding system. + +@item FORMAT_OS +Format used for the external Unix environment---@code{argv[]}, stuff +from @code{getenv()}, stuff from the @file{/etc/passwd} file, etc. -The two macros above take many arguments which makes them unwieldy. For -this reason, several convenience macros are defined with obvious -functionality, but accepting less arguments: +Perhaps should be the same as FORMAT_FILENAME. + +@item FORMAT_CTEXT +Compound--text format. This is the standard X format used for data +stored in properties, selections, and the like. This is an 8-bit +no-lock-shift ISO2022 coding system. +@end table + +The macros to convert between these formats and the internal format, and +vice versa, follow. @table @code -@item GET_C_CHARPTR_EXT_DATA_ALLOCA -@itemx GET_C_CHARPTR_INT_DATA_ALLOCA -These two macros work on ``C char pointers'', which are zero-terminated, -and thus do not need @var{len} or @var{len_out} parameters. +@item GET_CHARPTR_INT_DATA_ALLOCA +@itemx GET_CHARPTR_EXT_DATA_ALLOCA +These two are the most basic conversion macros. +@code{GET_CHARPTR_INT_DATA_ALLOCA} converts external data to internal +format, and @code{GET_CHARPTR_EXT_DATA_ALLOCA} converts the other way +around. The arguments each of these receives are @var{ptr} (pointer to +the text in external format), @var{len} (length of texts in bytes), +@var{fmt} (format of the external text), @var{ptr_out} (lvalue to which +new text should be copied), and @var{len_out} (lvalue which will be +assigned the length of the internal text in bytes). The resulting text +is stored to a stack-allocated buffer. If the text doesn't need +changing, these macros will do nothing, except for setting +@var{len_out}. + +The macros above take many arguments which makes them unwieldy. For +this reason, a number of convenience macros are defined with obvious +functionality, but accepting less arguments. The general rule is that +macros with @samp{INT} in their name convert text to internal Emacs +representation, whereas the @samp{EXT} macros convert to external +representation. + +@item GET_C_CHARPTR_INT_DATA_ALLOCA +@itemx GET_C_CHARPTR_EXT_DATA_ALLOCA +As their names imply, these macros work on C char pointers, which are +zero-terminated, and thus do not need @var{len} or @var{len_out} +parameters. @item GET_STRING_EXT_DATA_ALLOCA @itemx GET_C_STRING_EXT_DATA_ALLOCA -These two macros work on Lisp strings, thus also not needing a @var{len} -parameter. However, @code{GET_STRING_EXT_DATA_ALLOCA} still provides a -@var{len_out} parameter. Note that for Lisp strings only one conversion -direction makes sense. +These two macros convert a Lisp string into an external representation. +The difference between them is that @code{GET_STRING_EXT_DATA_ALLOCA} +stores its output to a generic string, providing @var{len_out}, the +length of the resulting external string. On the other hand, +@code{GET_C_STRING_EXT_DATA_ALLOCA} assumes that the caller will be +satisfied with output string being zero-terminated. + +Note that for Lisp strings only one conversion direction makes sense. @item GET_C_CHARPTR_EXT_BINARY_DATA_ALLOCA +@itemx GET_CHARPTR_EXT_BINARY_DATA_ALLOCA +@itemx GET_STRING_BINARY_DATA_ALLOCA +@itemx GET_C_STRING_BINARY_DATA_ALLOCA @itemx GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA -@itemx GET_C_CHARPTR_EXT_CTEXT_DATA_ALLOCA @itemx ... -These macros are a combination of the above, but with the @var{fmt} -argument encoded into the name of the macro. +These macros convert internal text to a specific external +representation, with the external format being encoded into the name of +the macro. Note that the @code{GET_STRING_...} and +@code{GET_C_STRING...} macros lack the @samp{EXT} tag, because they +only make sense in that direction. + +@item GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA +@itemx GET_CHARPTR_INT_BINARY_DATA_ALLOCA +@itemx GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA +@itemx ... +These macros convert external text of a specific format to its internal +representation, with the external format being incoded into the name of +the macro. @end table @node General Guidelines for Writing Mule-Aware Code diff --git a/man/lispref/text.texi b/man/lispref/text.texi index 6ac2408..f66bf59 100644 --- a/man/lispref/text.texi +++ b/man/lispref/text.texi @@ -53,6 +53,7 @@ buffer, together with their properties (when relevant). position stored in a register. * Transposition:: Swapping two portions of a buffer. * Change Hooks:: Supplying functions to be run when text is changed. +* Transformations:: MD5 and base64 support. @end menu @node Near Point @@ -2668,3 +2669,139 @@ This obsolete variable holds one function to call after any buffer modification This variable is a normal hook that is run whenever a buffer is changed that was previously in the unmodified state. @end defvar + +@node Transformations +@section Textual transformations---MD5 and base64 support +@cindex MD5 digests +@cindex base64 + +Some textual operations inherently require examining each character in +turn, and performing arithmetic operations on them. Such operations +can, of course, be implemented in Emacs Lisp, but tend to be very slow +for large portions of text or data. This is why some of them are +implemented in C, with an appropriate interface for Lisp programmers. +Examples of algorithms thus provided are MD5 and base64 support. + +MD5 is an algorithm for calculating message digests, as described in +rfc1321. Given a message of arbitrary length, MD5 produces an 128-bit +``fingerprint'' (``message digest'') corresponding to that message. It +is considered computationally infeasible to produce two messages having +the same MD5 digest, or to produce a message having a prespecified +target digest. MD5 is used heavily by various authentication schemes. + +Emacs Lisp interface to MD5 consists of a single function @code{md5}: + +@defun md5 object &optional start end +This function returns the MD5 message digest of @var{object}, a buffer +or string. + +Optional arguments @var{start} and @var{end} denote positions for +computing the digest of a portion of @var{object}. + +Some examples of usage: + +@example +@group +;; @r{Calculate the digest of the entire buffer} +(md5 (current-buffer)) + @result{} "8842b04362899b1cda8d2d126dc11712" +@end group + +@group +;; @r{Calculate the digest of the current line} +(md5 (current-buffer) (point-at-bol) (point-at-eol)) + @result{} "60614d21e9dee27dfdb01fa4e30d6d00" +@end group + +@group +;; @r{Calculate the digest of your name and email address} +(md5 (concat (format "%s <%s>" (user-full-name) user-mail-address))) + @result{} "0a2188c40fd38922d941fe6032fce516" +@end group +@end example +@end defun + +Base64 is a portable encoding for arbitrary sequences of octets, in a +form that need not be readable by humans. It uses a 65-character subset +of US-ASCII, as described in rfc2045. Base64 is used by MIME to encode +binary bodies, and to encode binary characters in message headers. + +The Lisp interface to base64 consists of four functions: + +@defun base64-encode-region beg end &optional no-line-break +This function encodes the region between @var{beg} and @var{end} of the +current buffer to base64 format. This means that the original region is +deleted, and replaced with its base64 equivalent. + +Normally, encoded base64 output is multi-line, with 76-character lines. +If @var{no-line-break} is non-@code{nil}, newlines will not be inserted, +resulting in single-line output. + +Mule note: you should make sure that you convert the multibyte +characters (those that do not fit into 0--255 range) to something else, +because they cannot be meaningfully converted to base64. If the +@code{base64-encode-region} encounters such characters, it will signal +an error. + +@code{base64-encode-region} returns the length of the encoded text. + +@example +@group +;; @r{Encode the whole buffer in base64} +(base64-encode-region (point-min) (point-max)) +@end group +@end example + +The function can also be used interactively, in which case it works on +the currently active region. +@end defun + +@defun base64-encode-string string +This function encodes @var{string} to base64, and returns the encoded +string. + +For Mule, the same considerations apply as for +@code{base64-encode-region}. + +@example +@group +(base64-encode-string "fubar") + @result{} "ZnViYXI=" +@end group +@end example +@end defun + +@defun base64-decode-region beg end +This function decodes the region between @var{beg} and @var{end} of the +current buffer. The region should be in base64 encoding. + +If the region was decoded correctly, @code{base64-decode-region} returns +the length of the decoded region. If the decoding failed, @code{nil} is +returned. + +@example +@group +;; @r{Decode a base64 buffer, and replace it with the decoded version} +(base64-decode-region (point-min) (point-max)) +@end group +@end example +@end defun + +@defun base64-decode-string string +This function decodes @var{string} to base64, and returns the decoded +string. @var{string} should be valid base64-encoded text. + +If encoding was not possible, @code{nil} is returned. + +@example +@group +(base64-decode-string "ZnViYXI=") + @result{} "fubar" +@end group + +@group +(base64-decode-string "totally bogus") + @result{} nil +@end group +@end example +@end defun diff --git a/nt/ChangeLog b/nt/ChangeLog index 29e932c..4a04b57 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,12 @@ +1998-11-28 SL Baur + + * XEmacs 21.2-beta4 is released. + +1998-10-29 Andy Piper + + * xemacs.mak ($(LIB_SRC)/movemail.exe): add etags dependencies to + pull in getopt and friends. + 1998-10-15 SL Baur * XEmacs 21.2-beta3 is released. diff --git a/nt/xemacs.mak b/nt/xemacs.mak index 1a45c4f..91cfd85 100644 --- a/nt/xemacs.mak +++ b/nt/xemacs.mak @@ -439,7 +439,7 @@ LIB_SRC_DEFINES = -DHAVE_CONFIG_H -DWIN32 -DWINDOWSNT # Individual dependencies ETAGS_DEPS = $(LIB_SRC)/getopt.c $(LIB_SRC)/getopt1.c $(LIB_SRC)/../src/regex.c $(LIB_SRC)/etags.exe : $(LIB_SRC)/etags.c $(ETAGS_DEPS) -#### ootags??? +$(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(ETAGS_DEPS) LIB_SRC_TOOLS = \ $(LIB_SRC)/make-docfile.exe \ diff --git a/src/ChangeLog b/src/ChangeLog index aa84b92..765c3bf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,165 @@ +1998-11-28 SL Baur + + * XEmacs 21.2-beta4 is released. + +1998-11-27 SL Baur + + * mule-charset.c (complex_vars_of_mule_charset): Fix graphic + property in control-1 charset. + From Julian Bradfield + +1998-11-26 Jan Vroonhof + + * gui-x.c (button_item_to_widget_value): Ignore :key-sequence + keyword. + Add stub for :label. + + * gui.c (gui_item_add_keyval_pair): ditto. + + * menubar-x.c (menu_item_descriptor_to_widget_value_1): Ignore + :key-sequence keyword. + Add stub for:label. + Support :active for submenus like the Windows code and FSF Emacs. + +1998-11-27 Hrvoje Niksic + + * dired.c (make_directory_hash_table): make_string() is OK because + readdir() Mule-encapsulates. + +1998-11-26 Hrvoje Niksic + + * fns.c (Fbase64_encode_string): Fix docstring. + (Fbase64_decode_string): Ditto. + +1998-11-26 Hrvoje Niksic + + * editfns.c (Ftranslate_region): Use + convert_bufbyte_string_into_emchar_string(). + +1998-11-25 Hrvoje Niksic + + * editfns.c (Ftranslate_region): Accept vectors and char-tables as + well as strings. + (Ftranslate_region): Turn table into an array of Emchars for + larger regions. + +1998-11-25 Hrvoje Niksic + + * chartab.c (Freset_char_table): Fix wrong placement of #endif. + +1998-11-24 Hrvoje Niksic + + * chartab.c (Freset_char_table): Don't blindly fill chartables of + type `char' with nils. + + * chartab.c (canonicalize_char_table_value): Coerce ints to chars + for tables of type `char'. + +1998-11-26 Didier Verna + + * input-method-xlib.c (Initialize_Locale): don't call + XtSetLanguageProc. We've done the whole work here. + * input-method-xfs.c (Initialize_Locale): ditto. + * input-method-motif.c (Initialize_Locale): ditto. + +1998-11-26 Didier Verna + + * process-unix.c (unix_create_process): handle properly + Vfile_name_coding_system for converting the program and directory + names. + +1998-11-27 SL Baur + + * m/arm.h: New file. + From James LewisMoss + +1998-11-27 Takeshi Hagiwara + + * m/mips-nec.h: + Fix the realpath() problem of UnixWare2.1.3. + Patches for NEC's sysv4.2 machine. + +1998-11-25 Hrvoje Niksic + + * dired.c (Fdirectory_files): Remove redundant code. + +1998-11-25 Hrvoje Niksic + + * fns.c (free_malloced_ptr): New function. + (XMALLOC_OR_ALLOCA): New macro. + (XMALLOC_UNBIND): Ditto. + (Fbase64_encode_region): Use malloc() for large blocks; arrange it + to be freed in case of non-local exit. + (Fbase64_encode_string): Ditto. + (Fbase64_decode_region): Ditto. + (Fbase64_decode_string): Ditto. + (STORE_BYTE): New macro. + (base64_decode_1): Use it. + +1998-11-25 Hrvoje Niksic + + * fns.c (base64_value_to_char): Base64 stuff. + +1998-11-24 Hrvoje Niksic + + * editfns.c (Fbuffer_substring): New function. + + * lisp.h: Declare make_string_from_buffer_no_extents(). + + * insdel.c (make_string_from_buffer_1): New function. + (make_string_from_buffer_no_extents): Ditto. + +1998-11-15 Michael Sperber [Mr. Preprocessor] + + * linuxplay.c: Including instead of makes + sound work on AIX with OSS installed. Linux should still work. + +1998-11-03 Andy Piper + + * config.h.in: name change for cygwin/version.h + + * configure.in: check for cygwin/version.h now. + + * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> + CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. + move cygwin32/version.h to cygwin/version.h + +1998-11-03 Olivier Galibert + + * lisp.h (struct Lisp_Bit_Vector): Fix declaration of bits from + int to long. + +1998-10-22 Andy Piper + + * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> + CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. + enable BROKEN_SIGIO under b20 to make QUIT work. + +1998-10-22 Andy Piper + + * frame-msw.c (mswindows_size_frame_internal): force frame sizing + to fit within the constraints of the screen size. I.e. make the + frame small enough to fit and move it if some of it will be + off-screen. + +1998-10-19 Greg Klanderman + + * dired.c: conditionalize inclusion of user-name-completion + primitives on non-Windows NT. The needed functions don't exist on NT. + +1998-11-24 SL Baur + + * gifrlib.h: Clean up types for 64 bit compile. + * dgif_lib.c (DGifInitRead): Ditto. + (MakeSavedImage): Ditto. + * emacs.c (decode_path): Ditto. + From Steve Carney + +1998-10-16 William M. Perry + + * glyphs-msw.c (bitmap_table): Fixed typo in builtin bitmaps + (cehckboxes instead of checkboxes). + 1998-10-15 SL Baur * XEmacs 21.2-beta3 is released. diff --git a/src/chartab.c b/src/chartab.c index 470993b..498cb11 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -552,13 +552,15 @@ Reset a char table to its default state. switch (ct->type) { case CHAR_TABLE_TYPE_CHAR: + fill_char_table (ct, make_char (0)); + break; case CHAR_TABLE_TYPE_DISPLAY: case CHAR_TABLE_TYPE_GENERIC: #ifdef MULE case CHAR_TABLE_TYPE_CATEGORY: +#endif /* MULE */ fill_char_table (ct, Qnil); break; -#endif /* MULE */ case CHAR_TABLE_TYPE_SYNTAX: fill_char_table (ct, make_int (Sinherit)); @@ -775,7 +777,7 @@ get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, #endif /* MULE */ -static Lisp_Object +Lisp_Object get_char_table (Emchar ch, struct Lisp_Char_Table *ct) { #ifdef MULE @@ -987,6 +989,10 @@ canonicalize_char_table_value (Lisp_Object value, enum char_table_type type) CHECK_CHAR_COERCE_INT (cdr); return Fcons (car, cdr); } + break; + case CHAR_TABLE_TYPE_CHAR: + CHECK_CHAR_COERCE_INT (value); + break; default: break; } diff --git a/src/chartab.h b/src/chartab.h index ac23e00..2aa4931 100644 --- a/src/chartab.h +++ b/src/chartab.h @@ -180,6 +180,7 @@ struct chartab_range void fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value); void put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, Lisp_Object val); +Lisp_Object get_char_table (Emchar, struct Lisp_Char_Table *); int map_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, int (*fn) (struct chartab_range *range, diff --git a/src/config.h.in b/src/config.h.in index b78318e..eae4bbc 100644 --- a/src/config.h.in +++ b/src/config.h.in @@ -194,7 +194,7 @@ char *alloca(); #undef HAVE_ULIMIT_H #undef HAVE_X11_XLOCALE_H #undef HAVE_LINUX_VERSION_H -#undef HAVE_CYGWIN32_VERSION_H +#undef HAVE_CYGWIN_VERSION_H #undef HAVE_INTTYPES_H #undef HAVE_SYS_UN_H #undef HAVE_A_OUT_H diff --git a/src/dgif_lib.c b/src/dgif_lib.c index d56832d..2ecab3f 100644 --- a/src/dgif_lib.c +++ b/src/dgif_lib.c @@ -110,7 +110,7 @@ void DGifInitRead(GifFileType *GifFile) /* The GIF Version number is ignored at this time. Maybe we should do */ /* something more useful with it. */ Buf[GIF_STAMP_LEN] = 0; - if (strncmp(GIF_STAMP, Buf, GIF_VERSION_POS) != 0) { + if (strncmp(GIF_STAMP, (const char *) Buf, GIF_VERSION_POS) != 0) { GifInternError(GifFile, D_GIF_ERR_NOT_GIF_FILE); } @@ -856,7 +856,7 @@ SavedImage *MakeSavedImage(GifFileType *GifFile, SavedImage *CopyFrom) CopyFrom->ImageDesc.ColorMap->Colors); /* next, the raster */ - sp->RasterBits = (char *)malloc(sizeof(GifPixelType) + sp->RasterBits = (GifPixelType*)malloc(sizeof(GifPixelType) * CopyFrom->ImageDesc.Height * CopyFrom->ImageDesc.Width); memcpy(sp->RasterBits, diff --git a/src/dired.c b/src/dired.c index 076e339..c3083cd 100644 --- a/src/dired.c +++ b/src/dired.c @@ -376,9 +376,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, dp = readdir (d); if (!dp) break; - /* #### This is a bad idea, because d_name can contain - control characters, which can make XEmacs crash. This - should be handled properly with FORMAT_FILENAME. */ + /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */ d_name = (Bufbyte *) dp->d_name; len = NAMLEN (dp); cclen = bytecount_to_charcount (d_name, len); @@ -531,6 +529,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, } + +/* The *pwent() functions do not exist on NT */ +#ifndef WINDOWSNT + static Lisp_Object user_name_completion (Lisp_Object user, int all_flag, int *uniq); @@ -775,6 +777,7 @@ user_name_completion (Lisp_Object user, int all_flag, int *uniq) return Qt; return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); } +#endif /* ! defined WINDOWSNT */ Lisp_Object @@ -791,8 +794,8 @@ make_directory_hash_table (CONST char *path) { Bytecount len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp)) - Fputhash (make_ext_string ((Bufbyte *) dp->d_name, len, - FORMAT_FILENAME), Qt, hash); + /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */ + Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash); } closedir (d); } @@ -938,9 +941,11 @@ syms_of_dired (void) DEFSUBR (Fdirectory_files); DEFSUBR (Ffile_name_completion); DEFSUBR (Ffile_name_all_completions); +#ifndef WINDOWSNT DEFSUBR (Fuser_name_completion); DEFSUBR (Fuser_name_completion_1); DEFSUBR (Fuser_name_all_completions); +#endif DEFSUBR (Ffile_attributes); } diff --git a/src/editfns.c b/src/editfns.c index 442a00b..339b431 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -39,6 +39,7 @@ Boston, MA 02111-1307, USA. */ #include "frame.h" #include "insdel.h" #include "window.h" +#include "chartab.h" #include "line-number.h" #include "systime.h" @@ -1622,6 +1623,23 @@ If BUFFER is nil, the current buffer is assumed. return make_string_from_buffer (b, begv, zv - begv); } +/* It might make more sense to name this + `buffer-substring-no-extents', but this name is FSFmacs-compatible, + and what the function does is probably good enough for what the + user-code will typically want to use it for. */ +DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /* +Return the text from BEG to END, as a string, without copying the extents. +*/ + (start, end, buffer)) +{ + /* This function can GC */ + Bufpos begv, zv; + struct buffer *b = decode_buffer (buffer, 1); + + get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL); + return make_string_from_buffer_no_extents (b, begv, zv - begv); +} + DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /* Insert before point a substring of the contents of buffer BUFFER. BUFFER may be a buffer or a buffer name. @@ -1783,42 +1801,149 @@ and don't mark the buffer as really changed. return Qnil; } +/* #### Shouldn't this also accept a BUFFER argument, in the good old + XEmacs tradition? */ DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /* -From START to END, translate characters according to TABLE. -TABLE is a string; the Nth character in it is the mapping -for the character with code N. Returns the number of characters changed. +Translate characters from START to END according to TABLE. + +If TABLE is a string, the Nth character in it is the mapping for the +character with code N. + +If TABLE is a vector, its Nth element is the mapping for character +with code N. The values of elements may be characters, strings, or +nil (nil meaning don't replace.) + +If TABLE is a char-table, its elements describe the mapping between +characters and their replacements. The char-table should be of type +`char' or `generic'. + +Returns the number of substitutions performed. */ (start, end, table)) { /* This function can GC */ Bufpos pos, stop; /* Limits of the region. */ - REGISTER Emchar oc; /* Old character. */ - REGISTER Emchar nc; /* New character. */ - int cnt; /* Number of changes made. */ - Charcount size; /* Size of translate table. */ + int cnt = 0; /* Number of changes made. */ int mc_count; struct buffer *buf = current_buffer; + Emchar oc; get_buffer_range_char (buf, start, end, &pos, &stop, 0); - CHECK_STRING (table); - - size = XSTRING_CHAR_LENGTH (table); - - cnt = 0; mc_count = begin_multiple_change (buf, pos, stop); - for (; pos < stop; pos++) + if (STRINGP (table)) + { + struct Lisp_String *stable = XSTRING (table); + Charcount size = string_char_length (stable); +#ifdef MULE + /* Under Mule, string_char(n) is O(n), so for large tables or + large regions it makes sense to create an array of Emchars. */ + if (size * (stop - pos) > 65536) + { + Emchar *etable = alloca_array (Emchar, size); + convert_bufbyte_string_into_emchar_string + (string_data (stable), string_length (stable), etable); + for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + { + if (oc < size) + { + Emchar nc = etable[oc]; + if (nc != oc) + { + buffer_replace_char (buf, pos, nc, 0, 0); + ++cnt; + } + } + } + } + else +#endif /* MULE */ + { + for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + { + if (oc < size) + { + Emchar nc = string_char (stable, oc); + if (nc != oc) + { + buffer_replace_char (buf, pos, nc, 0, 0); + ++cnt; + } + } + } + } + } + else if (VECTORP (table)) + { + Charcount size = XVECTOR_LENGTH (table); + Lisp_Object *vtable = XVECTOR_DATA (table); + + for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + { + if (oc < size) + { + Lisp_Object replacement = vtable[oc]; + retry: + if (CHAR_OR_CHAR_INTP (replacement)) + { + Emchar nc = XCHAR_OR_CHAR_INT (replacement); + if (nc != oc) + { + buffer_replace_char (buf, pos, nc, 0, 0); + ++cnt; + } + } + else if (STRINGP (replacement)) + { + Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; + buffer_delete_range (buf, pos, pos + 1, 0); + buffer_insert_lisp_string_1 (buf, pos, replacement, 0); + pos += incr, stop += incr; + ++cnt; + } + else if (!NILP (replacement)) + { + replacement = wrong_type_argument (Qchar_or_string_p, replacement); + goto retry; + } + } + } + } + else if (CHAR_TABLEP (table) + && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC + || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) { - oc = BUF_FETCH_CHAR (buf, pos); - if (oc >= 0 && oc < size) + struct Lisp_Char_Table *ctable = XCHAR_TABLE (table); + + for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) { - nc = string_char (XSTRING (table), oc); - if (nc != oc) + Lisp_Object replacement = get_char_table (oc, ctable); + retry2: + if (CHAR_OR_CHAR_INTP (replacement)) { - buffer_replace_char (buf, pos, nc, 0, 0); + Emchar nc = XCHAR_OR_CHAR_INT (replacement); + if (nc != oc) + { + buffer_replace_char (buf, pos, nc, 0, 0); + ++cnt; + } + } + else if (STRINGP (replacement)) + { + Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; + buffer_delete_range (buf, pos, pos + 1, 0); + buffer_insert_lisp_string_1 (buf, pos, replacement, 0); + pos += incr, stop += incr; ++cnt; } + else if (!NILP (replacement)) + { + replacement = wrong_type_argument (Qchar_or_string_p, replacement); + goto retry2; + } } } + else + dead_wrong_type_argument (Qstringp, table); end_multiple_change (buf, mc_count); return make_int (cnt); @@ -2263,6 +2388,7 @@ syms_of_editfns (void) DEFSUBR (Fstring_to_char); DEFSUBR (Fchar_to_string); DEFSUBR (Fbuffer_substring); + DEFSUBR (Fbuffer_substring_no_properties); DEFSUBR (Fpoint_marker); DEFSUBR (Fmark_marker); diff --git a/src/emacs.c b/src/emacs.c index edad0fc..09de76b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2513,7 +2513,7 @@ decode_path (CONST char *path) GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (path, newpath); - len = strlen (newpath); + len = strlen ((const char *) newpath); /* #### Does this make sense? It certainly does for decode_env_path(), but it looks dubious here. Does any code depend on decode_path("") returning nil instead of an empty diff --git a/src/fileio.c b/src/fileio.c index 4893391..f46d1e0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3346,7 +3346,10 @@ to the value of CODESYS. If this is nil, no code conversion occurs. /* On VMS and APOLLO, must do the stat after the close since closing changes the modtime. */ /* As it does on Windows too - kkm */ -#if !defined (WINDOWSNT) /* !defined (VMS) && !defined (APOLLO) */ + /* The spurious warnings appear on Linux too. Rather than handling + this on a per-system basis, unconditionally do the stat after the close - cgw */ + +#if 0 /* !defined (WINDOWSNT) /* !defined (VMS) && !defined (APOLLO) */ fstat (desc, &st); #endif @@ -3364,9 +3367,9 @@ to the value of CODESYS. If this is nil, no code conversion occurs. unbind_to (speccount, Qnil); } -#if defined (WINDOWSNT) /* defined (VMS) || defined (APOLLO) */ + /* # if defined (WINDOWSNT) /* defined (VMS) || defined (APOLLO) */ stat ((char *) XSTRING_DATA (fn), &st); -#endif + /* #endif */ #ifdef CLASH_DETECTION if (!auto_saving) diff --git a/src/fns.c b/src/fns.c index bc4cc9e..2f30628 100644 --- a/src/fns.c +++ b/src/fns.c @@ -49,6 +49,9 @@ Boston, MA 02111-1307, USA. */ #include "extents.h" #include "frame.h" #include "systime.h" +#include "insdel.h" +#include "lstream.h" +#include "opaque.h" /* NOTE: This symbol is also used in lread.c */ #define FEATUREP_SYNTAX @@ -3522,7 +3525,428 @@ If FILENAME is omitted, the printname of FEATURE is used as the file name. return unbind_to (speccount, feature); } } + +/* base64 encode/decode functions. + Based on code from GNU recode. */ + +#define MIME_LINE_LENGTH 76 + +#define IS_ASCII(Character) \ + ((Character) < 128) +#define IS_BASE64(Character) \ + (IS_ASCII (Character) && base64_char_to_value[Character] >= 0) + +/* Table of characters coding the 64 values. */ +static char base64_value_to_char[64] = +{ + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */ + 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */ + 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */ + 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */ + 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */ + 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */ + '8', '9', '+', '/' /* 60-63 */ +}; + +/* Table of base64 values for first 128 characters. */ +static short base64_char_to_value[128] = +{ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */ + -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */ + 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */ + -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */ + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */ + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */ + 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */ + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */ + 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */ + 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */ +}; + +/* The following diagram shows the logical steps by which three octets + get transformed into four base64 characters. + + .--------. .--------. .--------. + |aaaaaabb| |bbbbcccc| |ccdddddd| + `--------' `--------' `--------' + 6 2 4 4 2 6 + .--------+--------+--------+--------. + |00aaaaaa|00bbbbbb|00cccccc|00dddddd| + `--------+--------+--------+--------' + + .--------+--------+--------+--------. + |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| + `--------+--------+--------+--------' + + The octets are divided into 6 bit chunks, which are then encoded into + base64 characters. */ + +#define ADVANCE_INPUT(c, stream) \ + (ec = Lstream_get_emchar (stream), \ + ec == -1 ? 0 : \ + ((ec > 255) ? \ + (error ("Non-ascii character detected in base64 input"), 0) \ + : (c = (Bufbyte)ec, 1))) + +static Bytind +base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break) +{ + EMACS_INT counter = 0; + Bufbyte *e = to; + Emchar ec; + unsigned int value; + + while (1) + { + Bufbyte c; + if (!ADVANCE_INPUT (c, istream)) + break; + + /* Wrap line every 76 characters. */ + if (line_break) + { + if (counter < MIME_LINE_LENGTH / 4) + counter++; + else + { + *e++ = '\n'; + counter = 1; + } + } + + /* Process first byte of a triplet. */ + *e++ = base64_value_to_char[0x3f & c >> 2]; + value = (0x03 & c) << 4; + + /* Process second byte of a triplet. */ + if (!ADVANCE_INPUT (c, istream)) + { + *e++ = base64_value_to_char[value]; + *e++ = '='; + *e++ = '='; + break; + } + + *e++ = base64_value_to_char[value | (0x0f & c >> 4)]; + value = (0x0f & c) << 2; + + /* Process third byte of a triplet. */ + if (!ADVANCE_INPUT (c, istream)) + { + *e++ = base64_value_to_char[value]; + *e++ = '='; + break; + } + + *e++ = base64_value_to_char[value | (0x03 & c >> 6)]; + *e++ = base64_value_to_char[0x3f & c]; + } + + /* Complete last partial line. */ + if (line_break) + if (counter > 0) + *e++ = '\n'; + + return e - to; +} +#undef ADVANCE_INPUT + +#define ADVANCE_INPUT(c, stream) \ + (ec = Lstream_get_emchar (stream), \ + ec == -1 ? 0 : (c = (Bufbyte)ec, 1)) + +#define INPUT_EOF_P(stream) \ + (ADVANCE_INPUT (c2, stream) \ + ? (Lstream_unget_emchar (stream, (Emchar)c2), 0) \ + : 1) + +#define STORE_BYTE(pos, val) do { \ + pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \ + ++*ccptr; \ +} while (0) + +static Bytind +base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr) +{ + EMACS_INT counter = 0; + Emchar ec; + Bufbyte *e = to; + unsigned long value; + + *ccptr = 0; + while (1) + { + Bufbyte c, c2; + + if (!ADVANCE_INPUT (c, istream)) + break; + + /* Accept wrapping lines, reversibly if at each 76 characters. */ + if (c == '\n') + { + if (!ADVANCE_INPUT (c, istream)) + break; + if (INPUT_EOF_P (istream)) + break; + /* FSF Emacs has this check, apparently inherited from + recode. However, I see no reason to be this picky about + line length -- why reject base64 with say 72-byte lines? + (yes, there are programs that generate them.) */ + /*if (counter != MIME_LINE_LENGTH / 4) return -1;*/ + counter = 1; + } + else + counter++; + + /* Process first byte of a quadruplet. */ + if (!IS_BASE64 (c)) + return -1; + value = base64_char_to_value[c] << 18; + + /* Process second byte of a quadruplet. */ + if (!ADVANCE_INPUT (c, istream)) + return -1; + + if (!IS_BASE64 (c)) + return -1; + value |= base64_char_to_value[c] << 12; + + STORE_BYTE (e, value >> 16); + /* Process third byte of a quadruplet. */ + if (!ADVANCE_INPUT (c, istream)) + return -1; + + if (c == '=') + { + if (!ADVANCE_INPUT (c, istream)) + return -1; + if (c != '=') + return -1; + continue; + } + + if (!IS_BASE64 (c)) + return -1; + value |= base64_char_to_value[c] << 6; + + STORE_BYTE (e, 0xff & value >> 8); + + /* Process fourth byte of a quadruplet. */ + if (!ADVANCE_INPUT (c, istream)) + return -1; + + if (c == '=') + continue; + + if (!IS_BASE64 (c)) + return -1; + value |= base64_char_to_value[c]; + + STORE_BYTE (e, 0xff & value); + } + + return e - to; +} +#undef ADVANCE_INPUT +#undef INPUT_EOF_P + +static Lisp_Object +free_malloced_ptr (Lisp_Object unwind_obj) +{ + void *ptr = (void *)get_opaque_ptr (unwind_obj); + xfree (ptr); + free_opaque_ptr (unwind_obj); + return Qnil; +} + +/* Don't use alloca for regions larger than this, lest we overflow + the stack. */ +#define MAX_ALLOCA 65536 + +/* We need to setup proper unwinding, because there is a number of + ways these functions can blow up, and we don't want to have memory + leaks in those cases. */ +#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \ + if ((len) > MAX_ALLOCA) \ + { \ + ptr = (type *)xmalloc ((len) * sizeof (type)); \ + speccount = specpdl_depth (); \ + record_unwind_protect (free_malloced_ptr, \ + make_opaque_ptr ((void *)ptr)); \ + } \ + else \ + ptr = alloca_array (type, len); \ +} while (0) + +#define XMALLOC_UNBIND(ptr, len) do { \ + if ((len) > MAX_ALLOCA) \ + unbind_to (speccount, Qnil); \ +} while (0) + +DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* +Base64-encode the region between BEG and END. +Return the length of the encoded text. +Optional third argument NO-LINE-BREAK means do not break long lines +into shorter lines. +*/ + (beg, end, no_line_break)) +{ + Bufbyte *encoded; + Bytind encoded_length; + Charcount allength, length; + struct buffer *buf = current_buffer; + Bufpos begv, zv, old_pt = BUF_PT (buf); + Lisp_Object input; + int speccount; + + get_buffer_range_char (buf, beg, end, &begv, &zv, 0); + + /* We need to allocate enough room for encoding the text. + We need 33 1/3% more space, plus a newline every 76 + characters, and then we round up. */ + length = zv - begv; + allength = length + length/3 + 1; + allength += allength / MIME_LINE_LENGTH + 1 + 6; + + input = make_lisp_buffer_input_stream (buf, begv, zv, 0); + /* We needn't multiply allength with MAX_EMCHAR_LEN because all the + base64 characters will be single-byte. */ + XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte); + encoded_length = base64_encode_1 (XLSTREAM (input), encoded, + NILP (no_line_break)); + if (encoded_length > allength) + abort (); + Lstream_delete (XLSTREAM (input)); + + /* Now we have encoded the region, so we insert the new contents + and delete the old. (Insert first in order to preserve markers.) */ + buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0); + XMALLOC_UNBIND (encoded, allength); + buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); + + /* Simulate FSF Emacs: if point was in the region, place it at the + beginning. */ + if (old_pt >= begv && old_pt < zv) + BUF_SET_PT (buf, begv); + + /* We return the length of the encoded text. */ + return make_int (encoded_length); +} + +DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 1, 0, /* +Base64 encode STRING and return the result. +*/ + (string)) +{ + Charcount allength, length; + Bytind encoded_length; + Bufbyte *encoded; + Lisp_Object input, result; + int speccount; + + CHECK_STRING (string); + + length = XSTRING_CHAR_LENGTH (string); + allength = length + length/3 + 1 + 6; + + input = make_lisp_string_input_stream (string, 0, -1); + XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte); + encoded_length = base64_encode_1 (XLSTREAM (input), encoded, 0); + if (encoded_length > allength) + abort (); + Lstream_delete (XLSTREAM (input)); + result = make_string (encoded, encoded_length); + XMALLOC_UNBIND (encoded, allength); + return result; +} + +DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* +Base64-decode the region between BEG and END. +Return the length of the decoded text. +If the region can't be decoded, return nil and don't modify the buffer. +*/ + (beg, end)) +{ + struct buffer *buf = current_buffer; + Bufpos begv, zv, old_pt = BUF_PT (buf); + Bufbyte *decoded; + Bytind decoded_length; + Charcount length, cc_decoded_length; + Lisp_Object input; + int speccount; + + get_buffer_range_char (buf, beg, end, &begv, &zv, 0); + length = zv - begv; + + input = make_lisp_buffer_input_stream (buf, begv, zv, 0); + /* We need to allocate enough room for decoding the text. */ + XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte); + decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); + if (decoded_length > length * MAX_EMCHAR_LEN) + abort (); + Lstream_delete (XLSTREAM (input)); + + if (decoded_length < 0) + { + /* The decoding wasn't possible. */ + XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN); + return Qnil; + } + + /* Now we have decoded the region, so we insert the new contents + and delete the old. (Insert first in order to preserve markers.) */ + BUF_SET_PT (buf, begv); + buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0); + XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN); + buffer_delete_range (buf, begv + cc_decoded_length, + zv + cc_decoded_length, 0); + + /* Simulate FSF Emacs: if point was in the region, place it at the + beginning. */ + if (old_pt >= begv && old_pt < zv) + BUF_SET_PT (buf, begv); + + return make_int (cc_decoded_length); +} + +DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* +Base64-decode STRING and return the result. +*/ + (string)) +{ + Bufbyte *decoded; + Bytind decoded_length; + Charcount length, cc_decoded_length; + Lisp_Object input, result; + int speccount; + + CHECK_STRING (string); + + length = XSTRING_CHAR_LENGTH (string); + /* We need to allocate enough room for decoding the text. */ + XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte); + + input = make_lisp_string_input_stream (string, 0, -1); + decoded_length = base64_decode_1 (XLSTREAM (input), decoded, + &cc_decoded_length); + if (decoded_length > length * MAX_EMCHAR_LEN) + abort (); + Lstream_delete (XLSTREAM (input)); + + if (decoded_length < 0) + { + return Qnil; + XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN); + } + + result = make_string (decoded, decoded_length); + XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN); + return result; +} Lisp_Object Qyes_or_no_p; @@ -3608,6 +4032,10 @@ syms_of_fns (void) DEFSUBR (Ffeaturep); DEFSUBR (Frequire); DEFSUBR (Fprovide); + DEFSUBR (Fbase64_encode_region); + DEFSUBR (Fbase64_encode_string); + DEFSUBR (Fbase64_decode_region); + DEFSUBR (Fbase64_decode_string); } void diff --git a/src/frame-msw.c b/src/frame-msw.c index 2b1dee1..f7d154a 100644 --- a/src/frame-msw.c +++ b/src/frame-msw.c @@ -26,6 +26,7 @@ Boston, MA 02111-1307, USA. */ Ultimately based on FSF. Substantially rewritten for XEmacs by Ben Wing. Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. + Graphics features added and frame resizing fiddled with by Andy Piper. */ #include @@ -594,7 +595,7 @@ void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) int pixel_width, pixel_height; int size_p = (dest->width >=0 || dest->height >=0); int move_p = (dest->top >=0 || dest->left >=0); - + struct device* d = XDEVICE (FRAME_DEVICE (f)); char_to_real_pixel_size (f, dest->width, dest->height, &pixel_width, &pixel_height); if (dest->width < 0) @@ -607,7 +608,7 @@ void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) dest->left = rect.left; if (dest->top < 0) dest->top = rect.top; - + rect.left = rect.top = 0; rect.right = pixel_width; rect.bottom = pixel_height; @@ -617,12 +618,41 @@ void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) GetMenu (FRAME_MSWINDOWS_HANDLE(f)) != NULL, GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_EXSTYLE)); + /* resize and move the window so that it fits on the screen. This is + not restrictive since this will happen later anyway in WM_SIZE. We + have to do this after adjusting the rect to account for menubar + etc. */ + pixel_width = rect.right - rect.left; + pixel_height = rect.bottom - rect.top; + if (pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) + { + pixel_width = DEVICE_MSWINDOWS_HORZRES(d); + size_p=1; + } + if (pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) + { + pixel_height = DEVICE_MSWINDOWS_VERTRES(d); + size_p=1; + } + + /* adjust position so window is on screen */ + if (dest->left + pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) + { + dest->left = DEVICE_MSWINDOWS_HORZRES(d) - pixel_width; + move_p=1; + } + if (dest->top + pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) + { + dest->top = DEVICE_MSWINDOWS_VERTRES(d) - pixel_height; + move_p=1; + } + if (IsIconic (FRAME_MSWINDOWS_HANDLE(f)) || IsZoomed (FRAME_MSWINDOWS_HANDLE(f))) ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_RESTORE); SetWindowPos (FRAME_MSWINDOWS_HANDLE(f), NULL, - dest->left, dest->top, rect.right - rect.left, rect.bottom - rect.top, + dest->left, dest->top, pixel_width, pixel_height, SWP_NOACTIVATE | SWP_NOZORDER | SWP_NOSENDCHANGING | (size_p ? 0 : SWP_NOSIZE) | (move_p ? 0 : SWP_NOMOVE)); diff --git a/src/gifrlib.h b/src/gifrlib.h index 5b185d7..715cef2 100644 --- a/src/gifrlib.h +++ b/src/gifrlib.h @@ -167,15 +167,15 @@ extern void GifWarning(GifFileType *GifFile, const char *err_str); /* This is the in-core version of an extension record */ typedef struct { - int ByteCount; - char *Bytes; /* on malloc(3) heap */ + int ByteCount; + GifByteType *Bytes; /* on malloc(3) heap */ } ExtensionBlock; /* This holds an image header, its unpacked raster bits, and extensions */ typedef struct SavedImage { GifImageDesc ImageDesc; - char *RasterBits; /* on malloc(3) heap */ + GifPixelType *RasterBits; /* on malloc(3) heap */ int Function; int ExtensionBlockCount; diff --git a/src/glyphs-msw.c b/src/glyphs-msw.c index ddb16d4..7366c8e 100644 --- a/src/glyphs-msw.c +++ b/src/glyphs-msw.c @@ -1041,7 +1041,7 @@ static CONST resource_t bitmap_table[] = { "size", OBM_SIZE }, { "btsize", OBM_BTSIZE }, { "check", OBM_CHECK }, - { "cehckboxes", OBM_CHECKBOXES }, + { "checkboxes", OBM_CHECKBOXES }, { "btncorners" , OBM_BTNCORNERS }, {0} }; diff --git a/src/gui.c b/src/gui.c index 2d4fb6d..18251ad 100644 --- a/src/gui.c +++ b/src/gui.c @@ -29,8 +29,8 @@ Boston, MA 02111-1307, USA. */ #include "bytecode.h" /* for struct Lisp_Compiled_Function */ Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; -Lisp_Object Q_filter, Q_config, Q_included; -Lisp_Object Q_accelerator; +Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; +Lisp_Object Q_accelerator, Q_label; Lisp_Object Qtoggle, Qradio; #ifdef HAVE_POPUPS @@ -134,6 +134,8 @@ gui_item_add_keyval_pair (struct gui_item *pgui_item, else if (EQ (key, Q_style)) pgui_item->style = val; else if (EQ (key, Q_selected)) pgui_item->selected = val; else if (EQ (key, Q_keys)) pgui_item->keys = val; + else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */ + else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ else signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); } @@ -337,12 +339,14 @@ syms_of_gui (void) defkeyword (&Q_active, ":active"); defkeyword (&Q_suffix, ":suffix"); defkeyword (&Q_keys, ":keys"); + defkeyword (&Q_key_sequence,":key-sequence"); defkeyword (&Q_style, ":style"); defkeyword (&Q_selected, ":selected"); defkeyword (&Q_filter, ":filter"); defkeyword (&Q_config, ":config"); defkeyword (&Q_included, ":included"); defkeyword (&Q_accelerator, ":accelerator"); + defkeyword (&Q_label, ":label"); defsymbol (&Qtoggle, "toggle"); defsymbol (&Qradio, "radio"); diff --git a/src/gui.h b/src/gui.h index b0876e9..ab80f52 100644 --- a/src/gui.h +++ b/src/gui.h @@ -69,6 +69,7 @@ struct gui_item extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; +extern Lisp_Object Q_key_sequence, Q_label; void gui_item_init (struct gui_item *pgui_item); void gui_item_add_keyval_pair (struct gui_item *pgui_item, diff --git a/src/input-method-motif.c b/src/input-method-motif.c index dd95167..a1cb446 100644 --- a/src/input-method-motif.c +++ b/src/input-method-motif.c @@ -41,7 +41,12 @@ Initialize_Locale (void) { char *locale; - XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL); + /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc + routine calls setlocale(LC_ALL, lang) which fucks up our lower-level + locale management, and especially the value of LC_NUMERIC. Anyway, since + at this point, we don't know yet whether we're gonna need an X11 frame, + we should really do it manually and not use Xlib's dumb default routine */ + /*XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL);*/ if ((locale = setlocale (LC_ALL, "")) == NULL) { stderr_out ("Can't set locale.\n"); diff --git a/src/input-method-xlib.c b/src/input-method-xlib.c index 56d2dac..a66ea11 100644 --- a/src/input-method-xlib.c +++ b/src/input-method-xlib.c @@ -79,7 +79,12 @@ Initialize_Locale (void) { char *locale; - XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL); + /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc + routine calls setlocale(LC_ALL, lang) which fucks up our lower-level + locale management, and especially the value of LC_NUMERIC. Anyway, since + at this point, we don't know yet whether we're gonna need an X11 frame, + we should really do it manually and not use Xlib's dumb default routine */ + /*XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL);*/ if ((locale = setlocale (LC_ALL, "")) == NULL) { stderr_out ("Can't set locale.\n"); diff --git a/src/insdel.c b/src/insdel.c index f516263..a85481c 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2992,22 +2992,20 @@ buffer_replace_char (struct buffer *buf, Bufpos pos, Emchar ch, /* Make a string from a buffer. This needs to take into account the gap, and add any necessary extents from the buffer. */ -Lisp_Object -make_string_from_buffer (struct buffer *buf, Bufpos pos, Charcount length) +static Lisp_Object +make_string_from_buffer_1 (struct buffer *buf, Bufpos pos, Charcount length, + int no_extents) { /* This function can GC */ - Lisp_Object val; - struct gcpro gcpro1; - Bytind bi_ind; - Bytecount bi_len; + Bytind bi_ind = bufpos_to_bytind (buf, pos); + Bytecount bi_len = bufpos_to_bytind (buf, pos + length) - bi_ind; + Lisp_Object val = make_uninit_string (bi_len); - bi_ind = bufpos_to_bytind (buf, pos); - bi_len = bufpos_to_bytind (buf, pos + length) - bi_ind; - - val = make_uninit_string (bi_len); + struct gcpro gcpro1; GCPRO1 (val); - add_string_extents (val, buf, bi_ind, bi_len); + if (!no_extents) + add_string_extents (val, buf, bi_ind, bi_len); { Bytecount len1 = BI_BUF_GPT (buf) - bi_ind; @@ -3039,6 +3037,19 @@ make_string_from_buffer (struct buffer *buf, Bufpos pos, Charcount length) return val; } +Lisp_Object +make_string_from_buffer (struct buffer *buf, Bufpos pos, Charcount length) +{ + return make_string_from_buffer_1 (buf, pos, length, 0); +} + +Lisp_Object +make_string_from_buffer_no_extents (struct buffer *buf, Bufpos pos, + Charcount length) +{ + return make_string_from_buffer_1 (buf, pos, length, 1); +} + void barf_if_buffer_read_only (struct buffer *buf, Bufpos from, Bufpos to) { diff --git a/src/linuxplay.c b/src/linuxplay.c index 8c04648..bfe3e7d 100644 --- a/src/linuxplay.c +++ b/src/linuxplay.c @@ -65,7 +65,7 @@ #include #include #include -#include +#include #include #include #include diff --git a/src/lisp.h b/src/lisp.h index 8d7360e..232f48a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -960,7 +960,7 @@ struct Lisp_Bit_Vector struct lrecord_header lheader; Lisp_Object next; long size; - unsigned int bits[1]; + unsigned long bits[1]; }; DECLARE_LRECORD (bit_vector, struct Lisp_Bit_Vector); @@ -2048,6 +2048,7 @@ Bufpos bufpos_clip_to_bounds (Bufpos, Bufpos, Bufpos); Bytind bytind_clip_to_bounds (Bytind, Bytind, Bytind); void buffer_insert1 (struct buffer *, Lisp_Object); Lisp_Object make_string_from_buffer (struct buffer *, int, int); +Lisp_Object make_string_from_buffer_no_extents (struct buffer *, int, int); Lisp_Object save_excursion_save (void); Lisp_Object save_restriction_save (void); Lisp_Object save_excursion_restore (Lisp_Object); diff --git a/src/m/arm.h b/src/m/arm.h new file mode 100644 index 0000000..2bf2940 --- /dev/null +++ b/src/m/arm.h @@ -0,0 +1,135 @@ +/* Machine description file for digital/intel arm/strongarm + Copyright (C) 1987 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 2, 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 XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: FSF 19.31. */ + +/* Define WORD_MACHINE if addresses and such have + * to be corrected before they can be used as byte counts. */ + +#undef WORD_MACHINE + +/* Now define a symbol for the cpu type, if your compiler + does not define it automatically: + Ones defined so far include vax, m68000, ns16000, pyramid, + orion, tahoe, APOLLO and many others */ + +#ifndef arm +#define arm +#endif + +/* crt0.c, if it is used, should use the i386-bsd style of entry. + with no extra dummy args. On USG and XENIX, + NO_REMAP says this isn't used. */ + +/* Mly 16-Jan-96 16:38:32: this is part of a prototype -- same bug present in + other m*.h files */ +#define CRT0_DUMMIES int bogus_fp, + +/* crt0.c should define a symbol `start' and do .globl with a dot. */ + +#define DOT_GLOBAL_START + +#ifdef USG5_4 /* Older USG systems do not support the load average. */ +/* Data type of load average, as read out of kmem. */ + +#define LOAD_AVE_TYPE long + +/* Convert that into an integer that is 100 for a load average of 1.0 */ +/* This is totally uncalibrated. */ + + +/* FSHIFT and FSCALE are defined in param.h, but are required by + LOAD_AVE_CVT, so they need to be defined here. */ + +#ifndef FSHIFT +#define FSHIFT 8 /* bits to right of fixed binary point */ +#endif + +#ifndef FSCALE +#define FSCALE (1< says using vfork + under i386-unknown-sysv4.2 makes C-g sometimes cause a SIGSEGV + in TTY mode; the problem goes away if you use fork */ +#ifdef USG5_4_2 +#define vfork fork +#endif diff --git a/src/m/mips-nec.h b/src/m/mips-nec.h new file mode 100644 index 0000000..15fefcc --- /dev/null +++ b/src/m/mips-nec.h @@ -0,0 +1,145 @@ +/* m- file for Mips machines. + Copyright (C) 1987, 1992, 1993, 1995 Free Software Foundation, Inc. + + This file contains some changes for our SVR4 based SINIX-Mips 5.4. + I hope this is helpful to port the emacs to our RM?00 series and + maybe to the DC/OSx (Mips-based) machines of Pyramid Inc. + (Marco.Walther@mch.sni.de) + +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 2, 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 XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: FSF 19.31. */ + +/* The following line tells the configuration script what sort of + operating system this machine is likely to run. + USUAL-OPSYS="note" + +NOTE-START +Use m-mips4.h for RISCOS version 4; use s-bsd4-3.h with the BSD world. +Note that the proper m- file for the Decstation is m-pmax.h. +This is the m- file for SNI RM*00 machines. Use s- sinix5-4.h file! +With this the file mips-siemens.h is obsolete. +NOTE-END */ + +/* Define WORD_MACHINE if addresses and such have + * to be corrected before they can be used as byte counts. */ + +#undef WORD_MACHINE + +/* Define how to take a char and sign-extend into an int. + On machines where char is signed, this is a no-op. */ + +#define SIGN_EXTEND_CHAR(c) ((signed char)(c)) + +/* Now define a symbol for the cpu type, if your compiler + does not define it automatically: + Ones defined so far include vax, m68000, ns16000, pyramid, + orion, tahoe, APOLLO and many others */ +#ifndef mips +# define mips +#endif + +/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend + the 24-bit bit field into an int. In other words, if bit fields + are always unsigned. + + If you use NO_UNION_TYPE, this flag does not matter. */ + +#define EXPLICIT_SIGN_EXTEND + +/* Data type of load average, as read out of kmem. */ + +#define LOAD_AVE_TYPE long + +/* Convert that into an integer that is 100 for a load average of 1.0 */ + +#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / 256.0) + +/* CDC EP/IX 1.4.3 uses /unix */ + +#undef KERNEL_FILE +#define KERNEL_FILE "/unix" + +/* Define CANNOT_DUMP on machines where unexec does not work. + Then the function dump-emacs will not be defined + and temacs will do (load "loadup") automatically unless told otherwise. */ + +#undef CANNOT_DUMP + +/* Define VIRT_ADDR_VARIES if the virtual addresses of + pure and impure space as loaded can vary, and even their + relative order cannot be relied on. + + Otherwise Emacs assumes that text space precedes data space, + numerically. */ + +/* #define VIRT_ADDR_VARIES */ + +/* Define C_ALLOCA if this machine does not support a true alloca + and the one written in C should be used instead. + Define HAVE_ALLOCA to say that the system provides a properly + working alloca function and it should be used. + Define neither one if an assembler-language alloca + in the file alloca.s should be used. */ + +#ifdef __GNUC__ +#define HAVE_ALLOCA +#else +#define C_ALLOCA +#endif + +/* Define NO_REMAP if memory segmentation makes it not work well + to change the boundary between the text section and data section + when Emacs is dumped. If you define this, the preloaded Lisp + code will not be sharable; but that's better than failing completely. */ + +#define NO_REMAP + +/* Describe layout of the address space in an executing process. */ +/* MARCO ??? +*/ +#define TEXT_START 0x400000 +/* +#define DATA_START 0x10000000 +#define DATA_SEG_BITS 0x10000000 +*/ + +#undef ORDINARY_LINK + +#undef LIBS_DEBUG + +/* Alter some of the options used when linking. */ + +#undef LIBS_MACHINE +/* #define LIBS_MACHINE "-lmld" */ /* mrb */ +#define START_FILES "pre-crt0.o /usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o" + +#ifdef LIB_STANDARD +#undef LIB_STANDARD +#endif +#define LIB_STANDARD "-lc /usr/ccs/lib/crtn.o" + +#ifdef __GNUC__ +#define C_DEBUG_SWITCH +#define C_OPTIMIZE_SWITCH "-O" +#define LD_SWITCH_MACHINE +#else +#define C_DEBUG_SWITCH "-DSYSV" +#define C_OPTIMIZE_SWITCH "-DSYSV " +#define LD_SWITCH_MACHINE +#endif diff --git a/src/menubar-x.c b/src/menubar-x.c index a225eb5..4964779 100644 --- a/src/menubar-x.c +++ b/src/menubar-x.c @@ -146,8 +146,10 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, { Lisp_Object key, val; Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; + Lisp_Object active_p = Qt; Lisp_Object accel; int included_spec = 0; + int active_spec = 0; wv->type = CASCADE_TYPE; wv->enabled = 1; wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); @@ -172,6 +174,8 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, config_tag = val; else if (EQ (key, Q_filter)) hook_fn = val; + else if (EQ (key, Q_active)) + active_p = val, active_spec = 1; else if (EQ (key, Q_accelerator)) { if ( SYMBOLP (val) @@ -180,6 +184,10 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, else signal_simple_error ("bad keyboard accelerator", val); } + else if (EQ (key, Q_label)) + { + /* implement in 21.2 */ + } else signal_simple_error ("unknown menu cascade keyword", cascade); } @@ -191,7 +199,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, wv = NULL; goto menu_item_done; } - if (!NILP (hook_fn)) + + if (active_spec) + active_p = Feval (active_p); + + if (!NILP (hook_fn) && !NILP (active_p)) { #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF if (filter_p || depth == 0) @@ -236,6 +248,24 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, wv->contents = title_wv; prev = sep_wv; } + wv->enabled = ! NILP (active_p); + if (deep_p && !wv->enabled && !NILP (desc)) + { + widget_value *dummy; + /* Add a fake entry so the menus show up */ + wv->contents = dummy = xmalloc_widget_value (); + dummy->name = "(inactive)"; + dummy->accel = NULL; + dummy->enabled = 0; + dummy->selected = 0; + dummy->value = NULL; + dummy->type = BUTTON_TYPE; + dummy->call_data = NULL; + dummy->next = NULL; + + goto menu_item_done; + } + } else if (menubar_root_p) { @@ -248,8 +278,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, signal_simple_error ("menu name (first element) must be a string", desc); } - - wv->enabled = 1; + if (deep_p || menubar_root_p) { widget_value *next; diff --git a/src/menubar.c b/src/menubar.c index 7b1fb16..4e2aa8a 100644 --- a/src/menubar.c +++ b/src/menubar.c @@ -501,6 +501,13 @@ The possible keywords are this: Basically, the filter function should have no side-effects. + :key-sequence keys Used in FSF Emacs as an hint to an equivalent keybinding. + Ignored by XEnacs for easymenu.el compatability. + + :label
(unimplemented!) Like :suffix, but replaces label + completely. + (might be added in 21.2). + For example: ("File" diff --git a/src/mule-charset.c b/src/mule-charset.c index eb86610..d9b39b8 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -1249,7 +1249,7 @@ complex_vars_of_mule_charset (void) build_string ("iso8859-1")); Vcharset_control_1 = make_charset (-1, Qcontrol_1, LEADING_BYTE_CONTROL_1, 2, - CHARSET_TYPE_94, 1, 0, 0, + CHARSET_TYPE_94, 1, 1, 0, CHARSET_LEFT_TO_RIGHT, build_string ("Control characters"), build_string ("")); diff --git a/src/process-unix.c b/src/process-unix.c index 6be1c1a..8220dcc 100644 --- a/src/process-unix.c +++ b/src/process-unix.c @@ -735,7 +735,7 @@ unix_create_process (struct Lisp_Process *p, /* Nothing below here GCs so our string pointers shouldn't move. */ new_argv = alloca_array (char *, nargv + 2); - new_argv[0] = (char *) XSTRING_DATA (program); + GET_C_STRING_FILENAME_DATA_ALLOCA (program, new_argv[0]); for (i = 0; i < nargv; i++) { Lisp_Object tem = argv[i]; @@ -743,7 +743,7 @@ unix_create_process (struct Lisp_Process *p, new_argv[i + 1] = (char *) XSTRING_DATA (tem); } new_argv[i + 1] = 0; - current_dir = (char *) XSTRING_DATA (cur_dir); + GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir); #ifdef HAVE_PTYS if (!NILP (Vprocess_connection_type)) diff --git a/src/s/cygwin32.h b/src/s/cygwin32.h index 39490f3..3155383 100644 --- a/src/s/cygwin32.h +++ b/src/s/cygwin32.h @@ -71,8 +71,8 @@ Boston, MA 02111-1307, USA. */ /* cheesy way to determine cygwin version */ #ifndef NOT_C_CODE #include -#ifdef HAVE_CYGWIN32_VERSION_H -#include +#ifdef HAVE_CYGWIN_VERSION_H +#include #else #ifdef SIGIO #define CYGWIN_B19 @@ -85,7 +85,7 @@ extern void cygwin32_win32_to_posix_path_list(const char*, char*); extern int cygwin32_win32_to_posix_path_list_buf_size(const char*); extern void cygwin32_posix_to_win32_path_list(const char*, char*); extern int cygwin32_posix_to_win32_path_list_buf_size(const char*); -#ifndef CYGWIN_DLL_VERSION_MAJOR +#ifndef CYGWIN_VERSION_DLL_MAJOR struct timeval; struct timezone; struct itimerval; @@ -151,8 +151,12 @@ extern long random(); #define DATA_END -1 #define HEAP_IN_DATA #define UNEXEC "unexcw.o" -/* #define BROKEN_SIGIO */ + +#ifdef CYGWIN_VERSION_DLL_MAJOR +#define BROKEN_SIGIO +#else #define PROCESS_IO_BLOCKING +#endif #define strnicmp strncasecmp #ifndef HAVE_SOCKETS #define HAVE_SOCKETS -- 1.7.10.4