#include "../src/systime.h"
#include <stdlib.h>
#include <string.h>
+#include "getopt.h"
#ifdef MAIL_USE_POP
#include "pop.h"
+#include <regex.h>
#endif
+extern char *optarg;
+extern int optind, opterr;
+
#ifndef HAVE_STRERROR
static char * strerror (int errnum);
#endif /* HAVE_STRERROR */
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;
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]);
#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);
}
#include <stdio.h>
#include <pwd.h>
-#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;
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)
{
return (1);
}
+ VERBOSE(("stat'ing messages\r"));
if (pop_stat (server, &nmsgs, &nbytes))
{
error (pop_error, NULL, NULL);
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)
{
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);
+ }
}
}
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);
{
strncpy (Errmsg, pop_error, sizeof (Errmsg));
Errmsg[sizeof (Errmsg)-1] = '\0';
- return (NOTOK);
+ return (POP_ERROR);
}
while (! (ret = pop_retrieve_next (server, &line)))
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);
}
}
{
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. */
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 */
\f
#ifndef HAVE_STRERROR
+1998-11-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta4 is released.
+
+1998-11-27 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * 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 <yamaoka@jpl.org>
+
+ * isearch-mode.el (isearch-mode): Fix keymap lossage.
+
+1998-11-26 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * faces.el (get-custom-frame-properties): Revert Hrvoje Niksic change
+ of Dec 4, 1997.
+
+1998-11-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * process.el (shell-command-on-region): Report if the command
+ succeeded or failed.
+
+1998-11-24 Hrvoje Niksic <hniksic@srce.hr>
+
+ * subr.el (buffer-substring-no-properties): Comment out.
+
+1998-11-07 Adrian Aichner <aichner@ecf.teradyne.com>
+
+ * 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 <greg@alphatech.com>
+
+ * package-ui.el (pui-install-selected-packages): fix args in call
+ to `package-get'.
+
+1998-10-29 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * 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 <greg@alphatech.com>
+
+ * 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 <greg@alphatech.com>
+
+ * 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 <greg@alphatech.com>
+
+ * 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 <hniksic@srce.hr>
+
+ * wid-edit.el (widget-button-click): Don't switch window.
+
+1998-10-22 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * cus-face.el (custom-set-face-update-spec): Add autoload cookie
+
+1998-10-20 Malcolm Box <malcolm@brownale.demon.co.uk>
+
+ * etags.el (find-tag-default): Run find-tag-hook using
+ run-hooks rather than funcall
+
+1998-10-19 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <steve@altair.xemacs.org>
* XEmacs 21.2-beta3 is released.
(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")
(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"))
;;;***
\f
-;;;### (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:
;;;***
\f
-;;;### (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.
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)
(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"
(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"))
;; 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 <inge@nada.kth.se>
;; Commentary:
;; - 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.
(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.
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.")
(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)
;; 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))))))
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...
["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)
(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)))
(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)))
(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.
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.
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,
(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)))
(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)
(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)
;; Copyright (C) 1998 by Pete Ware
;; Author: Pete Ware <ware@cis.ohio-state.edu>
+;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
+;; Jan Vroonhof <vroonhof@math.ethz.ch>
;; Keywords: internal
;; This file is part of XEmacs.
;; 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
: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.")
;;;###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))
(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
(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
(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
(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"))))
(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)
(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)
(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)
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
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)
(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))
(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
(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
(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))
(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))
(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))
(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
(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))
))
(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)
(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
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 )
(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))
(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.
;; 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
(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"
;;;; 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.
(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."
+1998-11-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta4 is released.
+
1998-10-15 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta3 is released.
@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
@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.
@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
@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
@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
@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.
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);
@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.
@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.
@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}.
@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
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
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
+1998-11-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta4 is released.
+
+1998-10-29 Andy Piper <andyp@parallax.co.uk>
+
+ * xemacs.mak ($(LIB_SRC)/movemail.exe): add etags dependencies to
+ pull in getopt and friends.
+
1998-10-15 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta3 is released.
# 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 \
+1998-11-28 SL Baur <steve@altair.xemacs.org>
+
+ * XEmacs 21.2-beta4 is released.
+
+1998-11-27 SL Baur <steve@altair.xemacs.org>
+
+ * mule-charset.c (complex_vars_of_mule_charset): Fix graphic
+ property in control-1 charset.
+ From Julian Bradfield <jcb@daimi.au.dk>
+
+1998-11-26 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * 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 <hniksic@srce.hr>
+
+ * dired.c (make_directory_hash_table): make_string() is OK because
+ readdir() Mule-encapsulates.
+
+1998-11-26 Hrvoje Niksic <hniksic@srce.hr>
+
+ * fns.c (Fbase64_encode_string): Fix docstring.
+ (Fbase64_decode_string): Ditto.
+
+1998-11-26 Hrvoje Niksic <hniksic@srce.hr>
+
+ * editfns.c (Ftranslate_region): Use
+ convert_bufbyte_string_into_emchar_string().
+
+1998-11-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <hniksic@srce.hr>
+
+ * chartab.c (Freset_char_table): Fix wrong placement of #endif.
+
+1998-11-24 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <verna@inf.enst.fr>
+
+ * 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 <verna@inf.enst.fr>
+
+ * process-unix.c (unix_create_process): handle properly
+ Vfile_name_coding_system for converting the program and directory
+ names.
+
+1998-11-27 SL Baur <steve@altair.xemacs.org>
+
+ * m/arm.h: New file.
+ From James LewisMoss <dres@ioa.com>
+
+1998-11-27 Takeshi Hagiwara <hagiwara@ie.niigata-u.ac.jp>
+
+ * m/mips-nec.h:
+ Fix the realpath() problem of UnixWare2.1.3.
+ Patches for NEC's sysv4.2 machine.
+
+1998-11-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * dired.c (Fdirectory_files): Remove redundant code.
+
+1998-11-25 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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 <hniksic@srce.hr>
+
+ * fns.c (base64_value_to_char): Base64 stuff.
+
+1998-11-24 Hrvoje Niksic <hniksic@srce.hr>
+
+ * 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] <sperber@informatik.uni-tuebingen.de>
+
+ * linuxplay.c: Including <fcntl.h> instead of <sys/fcntl.h> makes
+ sound work on AIX with OSS installed. Linux should still work.
+
+1998-11-03 Andy Piper <andyp@parallax.co.uk>
+
+ * 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 <galibert@pobox.com>
+
+ * lisp.h (struct Lisp_Bit_Vector): Fix declaration of bits from
+ int to long.
+
+1998-10-22 Andy Piper <andyp@parallax.co.uk>
+
+ * 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 <andyp@parallax.co.uk>
+
+ * 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 <greg@alphatech.com>
+
+ * 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 <steve@altair.xemacs.org>
+
+ * gifrlib.h: Clean up types for 64 bit compile.
+ * dgif_lib.c (DGifInitRead): Ditto.
+ (MakeSavedImage): Ditto.
+ * emacs.c (decode_path): Ditto.
+ From Steve Carney <carney@pa.dec.com>
+
+1998-10-16 William M. Perry <wmperry@aventail.com>
+
+ * glyphs-msw.c (bitmap_table): Fixed typo in builtin bitmaps
+ (cehckboxes instead of checkboxes).
+
1998-10-15 SL Baur <steve@altair.xemacs.org>
* XEmacs 21.2-beta3 is released.
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));
#endif /* MULE */
-static Lisp_Object
+Lisp_Object
get_char_table (Emchar ch, struct Lisp_Char_Table *ct)
{
#ifdef MULE
CHECK_CHAR_COERCE_INT (cdr);
return Fcons (car, cdr);
}
+ break;
+ case CHAR_TABLE_TYPE_CHAR:
+ CHECK_CHAR_COERCE_INT (value);
+ break;
default:
break;
}
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,
#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
/* 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);
}
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,
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);
}
\f
+
+/* The *pwent() functions do not exist on NT */
+#ifndef WINDOWSNT
+
static Lisp_Object user_name_completion (Lisp_Object user,
int all_flag,
int *uniq);
return Qt;
return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
}
+#endif /* ! defined WINDOWSNT */
\f
Lisp_Object
{
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);
}
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);
}
#include "frame.h"
#include "insdel.h"
#include "window.h"
+#include "chartab.h"
#include "line-number.h"
#include "systime.h"
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.
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);
DEFSUBR (Fstring_to_char);
DEFSUBR (Fchar_to_string);
DEFSUBR (Fbuffer_substring);
+ DEFSUBR (Fbuffer_substring_no_properties);
DEFSUBR (Fpoint_marker);
DEFSUBR (Fmark_marker);
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
/* 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
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)
#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
return unbind_to (speccount, feature);
}
}
+\f
+/* 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;
+}
\f
Lisp_Object Qyes_or_no_p;
DEFSUBR (Ffeaturep);
DEFSUBR (Frequire);
DEFSUBR (Fprovide);
+ DEFSUBR (Fbase64_encode_region);
+ DEFSUBR (Fbase64_encode_string);
+ DEFSUBR (Fbase64_decode_region);
+ DEFSUBR (Fbase64_decode_string);
}
void
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 <config.h>
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)
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;
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));
/* 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;
{ "size", OBM_SIZE },
{ "btsize", OBM_BTSIZE },
{ "check", OBM_CHECK },
- { "cehckboxes", OBM_CHECKBOXES },
+ { "checkboxes", OBM_CHECKBOXES },
{ "btncorners" , OBM_BTNCORNERS },
{0}
};
#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
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);
}
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");
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,
{
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");
{
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");
/* 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;
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)
{
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#include <sys/fcntl.h>
+#include <fcntl.h>
#include <sys/file.h>
#include <sys/ioctl.h>
#include <sys/signal.h>
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);
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);
--- /dev/null
+/* 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<<FSHIFT)
+#endif
+
+#define LOAD_AVE_CVT(x) ((int) (((double) (x)) * 100.0 / FSCALE))
+#endif
+
+
+/* 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. */
+
+#undef VIRT_ADDR_VARIES
+
+
+/* this brings in alloca() if we're using cc */
+#ifdef USG
+#define NO_REMAP
+#define TEXT_START 0
+#endif /* USG */
+
+
+#ifdef USG5_4
+#define DATA_SEG_BITS 0x08000000
+#endif
+
+#ifdef MSDOS
+#define NO_REMAP
+#endif
+
+#ifdef WINDOWSNT
+#define VIRT_ADDR_VARIES
+#define DATA_END get_data_end ()
+#define DATA_START get_data_start ()
+#define HAVE_ALLOCA
+#endif
+
+#ifdef linux
+/* libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared library, */
+/* we cannot get the maximum address for brk */
+#define ULIMIT_BREAK_VALUE (32*1024*1024)
+
+#define SEGMENT_MASK ((SEGMENT_SIZE)-1)
+#endif
+
+#if 0
+#ifdef __GNUC__
+/* GCC's alloca() is semi-broken. See lisp.h.
+
+ This brokenness has been confirmed under both Linux and NetBSD.
+ It may also exist on non-Intel architectures. */
+#define BROKEN_ALLOCA_IN_FUNCTION_CALLS
+#endif
+#endif
+
+
+/* XEmacs change: John Hughes <john@AtlanTech.COM> 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
--- /dev/null
+/* 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
{
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)));
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)
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);
}
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)
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)
{
signal_simple_error ("menu name (first element) must be a string",
desc);
}
-
- wv->enabled = 1;
+
if (deep_p || menubar_root_p)
{
widget_value *next;
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 <form> (unimplemented!) Like :suffix, but replaces label
+ completely.
+ (might be added in 21.2).
+
For example:
("File"
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 (""));
/* 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];
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))
/* cheesy way to determine cygwin version */
#ifndef NOT_C_CODE
#include <signal.h>
-#ifdef HAVE_CYGWIN32_VERSION_H
-#include <cygwin32/version.h>
+#ifdef HAVE_CYGWIN_VERSION_H
+#include <cygwin/version.h>
#else
#ifdef SIGIO
#define CYGWIN_B19
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;
#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
projects / chise / xemacs-chise.git- / commitdiff