diff options
| author | Karoly Lorentey | 2004-05-11 09:11:36 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-05-11 09:11:36 +0000 |
| commit | ab4b17bed77ba635b5654accdfde3fbdf125f3e6 (patch) | |
| tree | 69bb5c993b157473ee83d40b4d2f3810661c2beb | |
| parent | f4d07503cab876a7e0eaab4701674f7e7f8279e5 (diff) | |
| parent | 88214ef69ef9698b96644d61f0580dca89f70924 (diff) | |
| download | emacs-ab4b17bed77ba635b5654accdfde3fbdf125f3e6.tar.gz emacs-ab4b17bed77ba635b5654accdfde3fbdf125f3e6.zip | |
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-290
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-161
33 files changed, 1337 insertions, 276 deletions
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 75d5f964201..8c641f45ae7 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog | |||
| @@ -1,3 +1,17 @@ | |||
| 1 | 2004-05-08 Thien-Thi Nguyen <ttn@gnu.org> | ||
| 2 | |||
| 3 | * cvtmail.c: Throughout, replace 0 destined for `exit' arg | ||
| 4 | with `EXIT_SUCCESS'. Likewise, replace 1 with `EXIT_FAILURE'. | ||
| 5 | (main): Use `EXIT_SUCCESS' or `EXIT_FAILURE' for return value. | ||
| 6 | |||
| 7 | * ebrowse.c, emacsclient.c, fakemail.c, hexl.c, | ||
| 8 | make-docfile.c, movemail.c, profile.c, sorted-doc.c, | ||
| 9 | test-distrib.c, update-game-score.c, yow.c: Likewise. | ||
| 10 | |||
| 11 | 2004-05-08 Thien-Thi Nguyen <ttn@gnu.org> | ||
| 12 | |||
| 13 | * Makefile.in (emacsclient${EXEEXT}): Use makefile var `version'. | ||
| 14 | |||
| 1 | 2004-05-07 Thien-Thi Nguyen <ttn@gnu.org> | 15 | 2004-05-07 Thien-Thi Nguyen <ttn@gnu.org> |
| 2 | 16 | ||
| 3 | * b2m.c (GOOD, BAD): Delete macros. Throughout, | 17 | * b2m.c (GOOD, BAD): Delete macros. Throughout, |
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 7868364148a..1da04d88b82 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | # Makefile for lib-src subdirectory in GNU Emacs. | 1 | # Makefile for lib-src subdirectory in GNU Emacs. |
| 2 | # Copyright (C) 1985, 1987, 1988, 1993, 1994, 2002, 2003 | 2 | # Copyright (C) 1985, 1987, 1988, 1993, 1994, 2002, 2003, 2004 |
| 3 | # Free Software Foundation, Inc. | 3 | # Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | # This file is part of GNU Emacs. | 5 | # This file is part of GNU Emacs. |
| @@ -447,7 +447,7 @@ yow${EXEEXT}: ${srcdir}/yow.c ../src/epaths.h | |||
| 447 | 447 | ||
| 448 | emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h $(GETOPTDEPS) | 448 | emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h $(GETOPTDEPS) |
| 449 | $(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c $(GETOPTOBJS) \ | 449 | $(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c $(GETOPTOBJS) \ |
| 450 | -DVERSION=`sed -n -e '/(defconst emacs-version/ s/^[^"]*\("[^"]*"\).*/\1/p' ${srcdir}/../lisp/version.el` \ | 450 | -DVERSION="\"${version}\"" \ |
| 451 | $(LOADLIBES) -o emacsclient | 451 | $(LOADLIBES) -o emacsclient |
| 452 | 452 | ||
| 453 | hexl${EXEEXT}: ${srcdir}/hexl.c ../src/config.h | 453 | hexl${EXEEXT}: ${srcdir}/hexl.c ../src/config.h |
diff --git a/lib-src/cvtmail.c b/lib-src/cvtmail.c index 28a4ae4c703..8992b3f9e80 100644 --- a/lib-src/cvtmail.c +++ b/lib-src/cvtmail.c | |||
| @@ -119,7 +119,7 @@ main (argc, argv) | |||
| 119 | } | 119 | } |
| 120 | fclose (mddf); | 120 | fclose (mddf); |
| 121 | fclose (mfilef); | 121 | fclose (mfilef); |
| 122 | return 0; | 122 | return EXIT_SUCCESS; |
| 123 | } | 123 | } |
| 124 | 124 | ||
| 125 | void | 125 | void |
| @@ -148,7 +148,7 @@ fatal (s1, s2) | |||
| 148 | char *s1, *s2; | 148 | char *s1, *s2; |
| 149 | { | 149 | { |
| 150 | error (s1, s2); | 150 | error (s1, s2); |
| 151 | exit (1); | 151 | exit (EXIT_FAILURE); |
| 152 | } | 152 | } |
| 153 | 153 | ||
| 154 | void | 154 | void |
| @@ -157,7 +157,7 @@ sysfail (s) | |||
| 157 | { | 157 | { |
| 158 | fprintf (stderr, "cvtmail: "); | 158 | fprintf (stderr, "cvtmail: "); |
| 159 | perror (s); | 159 | perror (s); |
| 160 | exit (1); | 160 | exit (EXIT_FAILURE); |
| 161 | } | 161 | } |
| 162 | 162 | ||
| 163 | char * | 163 | char * |
| @@ -183,3 +183,5 @@ xrealloc (ptr, size) | |||
| 183 | 183 | ||
| 184 | /* arch-tag: b93c25a9-9012-44f1-b78b-9cc7aed44a7a | 184 | /* arch-tag: b93c25a9-9012-44f1-b78b-9cc7aed44a7a |
| 185 | (do not change this comment) */ | 185 | (do not change this comment) */ |
| 186 | |||
| 187 | /* cvtmail.c ends here */ | ||
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index eeeb0eb3efd..4ad45d195f6 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c | |||
| @@ -564,7 +564,7 @@ xmalloc (nbytes) | |||
| 564 | if (p == NULL) | 564 | if (p == NULL) |
| 565 | { | 565 | { |
| 566 | yyerror ("out of memory", NULL); | 566 | yyerror ("out of memory", NULL); |
| 567 | exit (1); | 567 | exit (EXIT_FAILURE); |
| 568 | } | 568 | } |
| 569 | return p; | 569 | return p; |
| 570 | } | 570 | } |
| @@ -581,7 +581,7 @@ xrealloc (p, sz) | |||
| 581 | if (p == NULL) | 581 | if (p == NULL) |
| 582 | { | 582 | { |
| 583 | yyerror ("out of memory", NULL); | 583 | yyerror ("out of memory", NULL); |
| 584 | exit (1); | 584 | exit (EXIT_FAILURE); |
| 585 | } | 585 | } |
| 586 | return p; | 586 | return p; |
| 587 | } | 587 | } |
| @@ -3671,7 +3671,7 @@ usage (error) | |||
| 3671 | int error; | 3671 | int error; |
| 3672 | { | 3672 | { |
| 3673 | puts (USAGE); | 3673 | puts (USAGE); |
| 3674 | exit (error ? 1 : 0); | 3674 | exit (error ? EXIT_FAILURE : EXIT_SUCCESS); |
| 3675 | } | 3675 | } |
| 3676 | 3676 | ||
| 3677 | 3677 | ||
| @@ -3688,7 +3688,7 @@ version () | |||
| 3688 | printf ("ebrowse %s\n", VERSION); | 3688 | printf ("ebrowse %s\n", VERSION); |
| 3689 | puts ("Copyright (C) 1992-1999, 2000, 2001 Free Software Foundation, Inc."); | 3689 | puts ("Copyright (C) 1992-1999, 2000, 2001 Free Software Foundation, Inc."); |
| 3690 | puts ("This program is distributed under the same terms as Emacs."); | 3690 | puts ("This program is distributed under the same terms as Emacs."); |
| 3691 | exit (0); | 3691 | exit (EXIT_SUCCESS); |
| 3692 | } | 3692 | } |
| 3693 | 3693 | ||
| 3694 | 3694 | ||
| @@ -3925,7 +3925,7 @@ main (argc, argv) | |||
| 3925 | if (yyout == NULL) | 3925 | if (yyout == NULL) |
| 3926 | { | 3926 | { |
| 3927 | yyerror ("cannot open output file `%s'", out_filename); | 3927 | yyerror ("cannot open output file `%s'", out_filename); |
| 3928 | exit (1); | 3928 | exit (EXIT_FAILURE); |
| 3929 | } | 3929 | } |
| 3930 | } | 3930 | } |
| 3931 | 3931 | ||
| @@ -3970,11 +3970,10 @@ main (argc, argv) | |||
| 3970 | if (yyout != stdout) | 3970 | if (yyout != stdout) |
| 3971 | fclose (yyout); | 3971 | fclose (yyout); |
| 3972 | 3972 | ||
| 3973 | return 0; | 3973 | return EXIT_SUCCESS; |
| 3974 | } | 3974 | } |
| 3975 | 3975 | ||
| 3976 | |||
| 3977 | /* ebrowse.c ends here. */ | ||
| 3978 | |||
| 3979 | /* arch-tag: fc03b4bc-91a9-4c3d-b3b9-12a77fa86dd8 | 3976 | /* arch-tag: fc03b4bc-91a9-4c3d-b3b9-12a77fa86dd8 |
| 3980 | (do not change this comment) */ | 3977 | (do not change this comment) */ |
| 3978 | |||
| 3979 | /* ebrowse.c ends here */ | ||
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 92f19d4746c..a241a17eb60 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c | |||
| @@ -48,9 +48,6 @@ Boston, MA 02111-1307, USA. */ | |||
| 48 | char *getenv (), *getwd (); | 48 | char *getenv (), *getwd (); |
| 49 | char *getcwd (); | 49 | char *getcwd (); |
| 50 | 50 | ||
| 51 | /* This is defined with -D from the compilation command, | ||
| 52 | which extracts it from ../lisp/version.el. */ | ||
| 53 | |||
| 54 | #ifndef VERSION | 51 | #ifndef VERSION |
| 55 | #define VERSION "unspecified" | 52 | #define VERSION "unspecified" |
| 56 | #endif | 53 | #endif |
| @@ -157,7 +154,7 @@ decode_options (argc, argv) | |||
| 157 | 154 | ||
| 158 | case 'V': | 155 | case 'V': |
| 159 | printf ("emacsclient %s\n", VERSION); | 156 | printf ("emacsclient %s\n", VERSION); |
| 160 | exit (0); | 157 | exit (EXIT_SUCCESS); |
| 161 | break; | 158 | break; |
| 162 | 159 | ||
| 163 | case 't': | 160 | case 't': |
| @@ -176,7 +173,7 @@ decode_options (argc, argv) | |||
| 176 | 173 | ||
| 177 | default: | 174 | default: |
| 178 | fprintf (stderr, "Try `%s --help' for more information\n", progname); | 175 | fprintf (stderr, "Try `%s --help' for more information\n", progname); |
| 179 | exit (1); | 176 | exit (EXIT_FAILURE); |
| 180 | break; | 177 | break; |
| 181 | } | 178 | } |
| 182 | } | 179 | } |
| @@ -209,7 +206,7 @@ The following OPTIONS are accepted:\n\ | |||
| 209 | Editor to fallback to if the server is not running\n\ | 206 | Editor to fallback to if the server is not running\n\ |
| 210 | \n\ | 207 | \n\ |
| 211 | Report bugs to bug-gnu-emacs@gnu.org.\n", progname); | 208 | Report bugs to bug-gnu-emacs@gnu.org.\n", progname); |
| 212 | exit (0); | 209 | exit (EXIT_SUCCESS); |
| 213 | } | 210 | } |
| 214 | 211 | ||
| 215 | /* Like malloc but get fatal error if memory is exhausted. */ | 212 | /* Like malloc but get fatal error if memory is exhausted. */ |
| @@ -222,7 +219,7 @@ xmalloc (size) | |||
| 222 | if (result == NULL) | 219 | if (result == NULL) |
| 223 | { | 220 | { |
| 224 | perror ("malloc"); | 221 | perror ("malloc"); |
| 225 | exit (1); | 222 | exit (EXIT_FAILURE); |
| 226 | } | 223 | } |
| 227 | return result; | 224 | return result; |
| 228 | } | 225 | } |
| @@ -236,7 +233,7 @@ xstrdup (const char *s) | |||
| 236 | if (result == NULL) | 233 | if (result == NULL) |
| 237 | { | 234 | { |
| 238 | perror ("strdup"); | 235 | perror ("strdup"); |
| 239 | exit (1); | 236 | exit (EXIT_FAILURE); |
| 240 | } | 237 | } |
| 241 | return result; | 238 | return result; |
| 242 | } | 239 | } |
| @@ -336,7 +333,7 @@ fail (void) | |||
| 336 | } | 333 | } |
| 337 | else | 334 | else |
| 338 | { | 335 | { |
| 339 | exit (1); | 336 | exit (EXIT_FAILURE); |
| 340 | } | 337 | } |
| 341 | } | 338 | } |
| 342 | 339 | ||
| @@ -520,7 +517,7 @@ main (argc, argv) | |||
| 520 | { | 517 | { |
| 521 | fprintf (stderr, "%s: file name or argument required\n", progname); | 518 | fprintf (stderr, "%s: file name or argument required\n", progname); |
| 522 | fprintf (stderr, "Try `%s --help' for more information\n", progname); | 519 | fprintf (stderr, "Try `%s --help' for more information\n", progname); |
| 523 | exit (1); | 520 | exit (EXIT_FAILURE); |
| 524 | } | 521 | } |
| 525 | 522 | ||
| 526 | /* | 523 | /* |
| @@ -598,7 +595,7 @@ main (argc, argv) | |||
| 598 | { | 595 | { |
| 599 | fprintf (stderr, "%s: socket-name %s too long", | 596 | fprintf (stderr, "%s: socket-name %s too long", |
| 600 | argv[0], socket_name); | 597 | argv[0], socket_name); |
| 601 | exit (1); | 598 | exit (EXIT_FAILURE); |
| 602 | } | 599 | } |
| 603 | 600 | ||
| 604 | sock_status = socket_status (server.sun_path); | 601 | sock_status = socket_status (server.sun_path); |
| @@ -819,9 +816,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", | |||
| 819 | 816 | ||
| 820 | /* Maybe wait for an answer. */ | 817 | /* Maybe wait for an answer. */ |
| 821 | if (nowait) | 818 | if (nowait) |
| 822 | { | 819 | return EXIT_SUCCESS; |
| 823 | return 0; | ||
| 824 | } | ||
| 825 | 820 | ||
| 826 | if (!eval && !tty) | 821 | if (!eval && !tty) |
| 827 | { | 822 | { |
| @@ -883,7 +878,7 @@ To start the server in Emacs, type \"M-x server-start\".\n", | |||
| 883 | fflush (stdout); | 878 | fflush (stdout); |
| 884 | fsync (1); | 879 | fsync (1); |
| 885 | 880 | ||
| 886 | return 0; | 881 | return EXIT_SUCCESS; |
| 887 | } | 882 | } |
| 888 | 883 | ||
| 889 | #endif /* HAVE_SOCKETS */ | 884 | #endif /* HAVE_SOCKETS */ |
| @@ -905,3 +900,5 @@ strerror (errnum) | |||
| 905 | 900 | ||
| 906 | /* arch-tag: f39bb9c4-73eb-477e-896d-50832e2ca9a7 | 901 | /* arch-tag: f39bb9c4-73eb-477e-896d-50832e2ca9a7 |
| 907 | (do not change this comment) */ | 902 | (do not change this comment) */ |
| 903 | |||
| 904 | /* emacsclient.c ends here */ | ||
diff --git a/lib-src/fakemail.c b/lib-src/fakemail.c index 944a728a28c..cee7eaa130e 100644 --- a/lib-src/fakemail.c +++ b/lib-src/fakemail.c | |||
| @@ -169,7 +169,7 @@ fatal (s1, s2) | |||
| 169 | char *s1, *s2; | 169 | char *s1, *s2; |
| 170 | { | 170 | { |
| 171 | error (s1, s2); | 171 | error (s1, s2); |
| 172 | exit (1); | 172 | exit (EXIT_FAILURE); |
| 173 | } | 173 | } |
| 174 | 174 | ||
| 175 | /* Like malloc but get fatal error if memory is exhausted. */ | 175 | /* Like malloc but get fatal error if memory is exhausted. */ |
| @@ -410,7 +410,7 @@ close_the_streams () | |||
| 410 | no_problems = (no_problems && | 410 | no_problems = (no_problems && |
| 411 | ((*rem->action) (rem->handle) == 0)); | 411 | ((*rem->action) (rem->handle) == 0)); |
| 412 | the_streams = ((stream_list) NULL); | 412 | the_streams = ((stream_list) NULL); |
| 413 | return (no_problems ? 0 : 1); | 413 | return (no_problems ? EXIT_SUCCESS : EXIT_FAILURE); |
| 414 | } | 414 | } |
| 415 | 415 | ||
| 416 | void | 416 | void |
| @@ -667,7 +667,7 @@ read_header () | |||
| 667 | if (next_line == ((line_list *) NULL)) | 667 | if (next_line == ((line_list *) NULL)) |
| 668 | { | 668 | { |
| 669 | /* Not a valid header */ | 669 | /* Not a valid header */ |
| 670 | exit (1); | 670 | exit (EXIT_FAILURE); |
| 671 | } | 671 | } |
| 672 | *next_line = new_list (); | 672 | *next_line = new_list (); |
| 673 | (*next_line)->string = alloc_string (length); | 673 | (*next_line)->string = alloc_string (length); |
| @@ -753,3 +753,5 @@ main (argc, argv) | |||
| 753 | 753 | ||
| 754 | /* arch-tag: acb0afa6-315a-4c5b-b9e3-def5725c8783 | 754 | /* arch-tag: acb0afa6-315a-4c5b-b9e3-def5725c8783 |
| 755 | (do not change this comment) */ | 755 | (do not change this comment) */ |
| 756 | |||
| 757 | /* fakemail.c ends here */ | ||
diff --git a/lib-src/hexl.c b/lib-src/hexl.c index 0cfb88445b3..5ca7c2a5b8a 100644 --- a/lib-src/hexl.c +++ b/lib-src/hexl.c | |||
| @@ -270,15 +270,17 @@ main (argc, argv) | |||
| 270 | fclose (fp); | 270 | fclose (fp); |
| 271 | 271 | ||
| 272 | } while (*argv != NULL); | 272 | } while (*argv != NULL); |
| 273 | return 0; | 273 | return EXIT_SUCCESS; |
| 274 | } | 274 | } |
| 275 | 275 | ||
| 276 | void | 276 | void |
| 277 | usage () | 277 | usage () |
| 278 | { | 278 | { |
| 279 | fprintf (stderr, "usage: %s [-de] [-iso]\n", progname); | 279 | fprintf (stderr, "usage: %s [-de] [-iso]\n", progname); |
| 280 | exit (1); | 280 | exit (EXIT_FAILURE); |
| 281 | } | 281 | } |
| 282 | 282 | ||
| 283 | /* arch-tag: 20e04fb7-926e-4e48-be86-64fe869ecdaa | 283 | /* arch-tag: 20e04fb7-926e-4e48-be86-64fe869ecdaa |
| 284 | (do not change this comment) */ | 284 | (do not change this comment) */ |
| 285 | |||
| 286 | /* hexl.c ends here */ | ||
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 1c0bc559225..802b4e09e67 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c | |||
| @@ -104,7 +104,7 @@ fatal (s1, s2) | |||
| 104 | char *s1, *s2; | 104 | char *s1, *s2; |
| 105 | { | 105 | { |
| 106 | error (s1, s2); | 106 | error (s1, s2); |
| 107 | exit (1); | 107 | exit (EXIT_FAILURE); |
| 108 | } | 108 | } |
| 109 | 109 | ||
| 110 | /* Like malloc but get fatal error if memory is exhausted. */ | 110 | /* Like malloc but get fatal error if memory is exhausted. */ |
| @@ -1210,3 +1210,5 @@ scan_lisp_file (filename, mode) | |||
| 1210 | 1210 | ||
| 1211 | /* arch-tag: f7203aaf-991a-4238-acb5-601db56f2894 | 1211 | /* arch-tag: f7203aaf-991a-4238-acb5-601db56f2894 |
| 1212 | (do not change this comment) */ | 1212 | (do not change this comment) */ |
| 1213 | |||
| 1214 | /* make-docfile.c ends here */ | ||
diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 2d0cd9043fd..a634e2966d7 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c | |||
| @@ -216,7 +216,7 @@ main (argc, argv) | |||
| 216 | preserve_mail++; | 216 | preserve_mail++; |
| 217 | break; | 217 | break; |
| 218 | default: | 218 | default: |
| 219 | exit(1); | 219 | exit (EXIT_FAILURE); |
| 220 | } | 220 | } |
| 221 | } | 221 | } |
| 222 | 222 | ||
| @@ -234,7 +234,7 @@ main (argc, argv) | |||
| 234 | #else | 234 | #else |
| 235 | fprintf (stderr, "Usage: movemail [-p] inbox destfile%s\n", ""); | 235 | fprintf (stderr, "Usage: movemail [-p] inbox destfile%s\n", ""); |
| 236 | #endif | 236 | #endif |
| 237 | exit (1); | 237 | exit (EXIT_FAILURE); |
| 238 | } | 238 | } |
| 239 | 239 | ||
| 240 | inname = argv[optind]; | 240 | inname = argv[optind]; |
| @@ -536,12 +536,12 @@ main (argc, argv) | |||
| 536 | if (spool_name) | 536 | if (spool_name) |
| 537 | mailunlock (); | 537 | mailunlock (); |
| 538 | #endif | 538 | #endif |
| 539 | exit (0); | 539 | exit (EXIT_SUCCESS); |
| 540 | } | 540 | } |
| 541 | 541 | ||
| 542 | wait (&status); | 542 | wait (&status); |
| 543 | if (!WIFEXITED (status)) | 543 | if (!WIFEXITED (status)) |
| 544 | exit (1); | 544 | exit (EXIT_FAILURE); |
| 545 | else if (WRETCODE (status) != 0) | 545 | else if (WRETCODE (status) != 0) |
| 546 | exit (WRETCODE (status)); | 546 | exit (WRETCODE (status)); |
| 547 | 547 | ||
| @@ -554,7 +554,7 @@ main (argc, argv) | |||
| 554 | 554 | ||
| 555 | #endif /* ! DISABLE_DIRECT_ACCESS */ | 555 | #endif /* ! DISABLE_DIRECT_ACCESS */ |
| 556 | 556 | ||
| 557 | return 0; | 557 | return EXIT_SUCCESS; |
| 558 | } | 558 | } |
| 559 | 559 | ||
| 560 | #ifdef MAIL_USE_MAILLOCK | 560 | #ifdef MAIL_USE_MAILLOCK |
| @@ -607,7 +607,7 @@ fatal (s1, s2) | |||
| 607 | if (delete_lockname) | 607 | if (delete_lockname) |
| 608 | unlink (delete_lockname); | 608 | unlink (delete_lockname); |
| 609 | error (s1, s2, 0); | 609 | error (s1, s2, 0); |
| 610 | exit (1); | 610 | exit (EXIT_FAILURE); |
| 611 | } | 611 | } |
| 612 | 612 | ||
| 613 | /* Print error message. `s1' is printf control string, `s2' and `s3' | 613 | /* Print error message. `s1' is printf control string, `s2' and `s3' |
| @@ -709,6 +709,8 @@ char Errmsg[200]; /* POP errors, at least, can exceed | |||
| 709 | * If the mailbox is in the form "po:username:hostname", then it is | 709 | * If the mailbox is in the form "po:username:hostname", then it is |
| 710 | * modified by this function -- the second colon is replaced by a | 710 | * modified by this function -- the second colon is replaced by a |
| 711 | * null. | 711 | * null. |
| 712 | * | ||
| 713 | * Return a value suitable for passing to `exit'. | ||
| 712 | */ | 714 | */ |
| 713 | 715 | ||
| 714 | int | 716 | int |
| @@ -736,19 +738,19 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 736 | if (! server) | 738 | if (! server) |
| 737 | { | 739 | { |
| 738 | error ("Error connecting to POP server: %s", pop_error, 0); | 740 | error ("Error connecting to POP server: %s", pop_error, 0); |
| 739 | return (1); | 741 | return EXIT_FAILURE; |
| 740 | } | 742 | } |
| 741 | 743 | ||
| 742 | if (pop_stat (server, &nmsgs, &nbytes)) | 744 | if (pop_stat (server, &nmsgs, &nbytes)) |
| 743 | { | 745 | { |
| 744 | error ("Error getting message count from POP server: %s", pop_error, 0); | 746 | error ("Error getting message count from POP server: %s", pop_error, 0); |
| 745 | return (1); | 747 | return EXIT_FAILURE; |
| 746 | } | 748 | } |
| 747 | 749 | ||
| 748 | if (!nmsgs) | 750 | if (!nmsgs) |
| 749 | { | 751 | { |
| 750 | pop_close (server); | 752 | pop_close (server); |
| 751 | return (0); | 753 | return EXIT_SUCCESS; |
| 752 | } | 754 | } |
| 753 | 755 | ||
| 754 | mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); | 756 | mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); |
| @@ -756,7 +758,7 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 756 | { | 758 | { |
| 757 | pop_close (server); | 759 | pop_close (server); |
| 758 | error ("Error in open: %s, %s", strerror (errno), outfile); | 760 | error ("Error in open: %s, %s", strerror (errno), outfile); |
| 759 | return (1); | 761 | return EXIT_FAILURE; |
| 760 | } | 762 | } |
| 761 | fchown (mbfi, getuid (), -1); | 763 | fchown (mbfi, getuid (), -1); |
| 762 | 764 | ||
| @@ -766,7 +768,7 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 766 | error ("Error in fdopen: %s", strerror (errno), 0); | 768 | error ("Error in fdopen: %s", strerror (errno), 0); |
| 767 | close (mbfi); | 769 | close (mbfi); |
| 768 | unlink (outfile); | 770 | unlink (outfile); |
| 769 | return (1); | 771 | return EXIT_FAILURE; |
| 770 | } | 772 | } |
| 771 | 773 | ||
| 772 | if (reverse_order) | 774 | if (reverse_order) |
| @@ -789,7 +791,7 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 789 | { | 791 | { |
| 790 | error (Errmsg, 0, 0); | 792 | error (Errmsg, 0, 0); |
| 791 | close (mbfi); | 793 | close (mbfi); |
| 792 | return (1); | 794 | return EXIT_FAILURE; |
| 793 | } | 795 | } |
| 794 | mbx_delimit_end (mbf); | 796 | mbx_delimit_end (mbf); |
| 795 | fflush (mbf); | 797 | fflush (mbf); |
| @@ -798,7 +800,7 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 798 | error ("Error in fflush: %s", strerror (errno), 0); | 800 | error ("Error in fflush: %s", strerror (errno), 0); |
| 799 | pop_close (server); | 801 | pop_close (server); |
| 800 | close (mbfi); | 802 | close (mbfi); |
| 801 | return (1); | 803 | return EXIT_FAILURE; |
| 802 | } | 804 | } |
| 803 | } | 805 | } |
| 804 | 806 | ||
| @@ -812,14 +814,14 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 812 | if (fsync (mbfi) < 0) | 814 | if (fsync (mbfi) < 0) |
| 813 | { | 815 | { |
| 814 | error ("Error in fsync: %s", strerror (errno), 0); | 816 | error ("Error in fsync: %s", strerror (errno), 0); |
| 815 | return (1); | 817 | return EXIT_FAILURE; |
| 816 | } | 818 | } |
| 817 | #endif | 819 | #endif |
| 818 | 820 | ||
| 819 | if (close (mbfi) == -1) | 821 | if (close (mbfi) == -1) |
| 820 | { | 822 | { |
| 821 | error ("Error in close: %s", strerror (errno), 0); | 823 | error ("Error in close: %s", strerror (errno), 0); |
| 822 | return (1); | 824 | return EXIT_FAILURE; |
| 823 | } | 825 | } |
| 824 | 826 | ||
| 825 | if (! preserve) | 827 | if (! preserve) |
| @@ -829,17 +831,17 @@ popmail (mailbox, outfile, preserve, password, reverse_order) | |||
| 829 | { | 831 | { |
| 830 | error ("Error from POP server: %s", pop_error, 0); | 832 | error ("Error from POP server: %s", pop_error, 0); |
| 831 | pop_close (server); | 833 | pop_close (server); |
| 832 | return (1); | 834 | return EXIT_FAILURE; |
| 833 | } | 835 | } |
| 834 | } | 836 | } |
| 835 | 837 | ||
| 836 | if (pop_quit (server)) | 838 | if (pop_quit (server)) |
| 837 | { | 839 | { |
| 838 | error ("Error from POP server: %s", pop_error, 0); | 840 | error ("Error from POP server: %s", pop_error, 0); |
| 839 | return (1); | 841 | return EXIT_FAILURE; |
| 840 | } | 842 | } |
| 841 | 843 | ||
| 842 | return (0); | 844 | return EXIT_SUCCESS; |
| 843 | } | 845 | } |
| 844 | 846 | ||
| 845 | int | 847 | int |
| @@ -957,3 +959,5 @@ strerror (errnum) | |||
| 957 | 959 | ||
| 958 | /* arch-tag: 1c323112-41fe-4fe5-8de9-494de631f73f | 960 | /* arch-tag: 1c323112-41fe-4fe5-8de9-494de631f73f |
| 959 | (do not change this comment) */ | 961 | (do not change this comment) */ |
| 962 | |||
| 963 | /* movemail.c ends here */ | ||
diff --git a/lib-src/profile.c b/lib-src/profile.c index ec77936f74d..8d924532b87 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c | |||
| @@ -55,7 +55,7 @@ char * | |||
| 55 | get_time () | 55 | get_time () |
| 56 | { | 56 | { |
| 57 | if (watch_not_started) | 57 | if (watch_not_started) |
| 58 | exit (1); /* call reset_watch first ! */ | 58 | exit (EXIT_FAILURE); /* call reset_watch first ! */ |
| 59 | EMACS_GET_TIME (TV2); | 59 | EMACS_GET_TIME (TV2); |
| 60 | EMACS_SUB_TIME (TV2, TV2, TV1); | 60 | EMACS_SUB_TIME (TV2, TV2, TV1); |
| 61 | sprintf (time_string, "%lu.%06lu", (unsigned long)EMACS_SECS (TV2), (unsigned long)EMACS_USECS (TV2)); | 61 | sprintf (time_string, "%lu.%06lu", (unsigned long)EMACS_SECS (TV2), (unsigned long)EMACS_USECS (TV2)); |
| @@ -94,14 +94,16 @@ main () | |||
| 94 | puts (get_time ()); | 94 | puts (get_time ()); |
| 95 | break; | 95 | break; |
| 96 | case 'q': | 96 | case 'q': |
| 97 | exit (0); | 97 | exit (EXIT_SUCCESS); |
| 98 | } | 98 | } |
| 99 | /* Anything remaining on the line is ignored. */ | 99 | /* Anything remaining on the line is ignored. */ |
| 100 | while (c != '\n' && c != EOF) | 100 | while (c != '\n' && c != EOF) |
| 101 | c = getchar (); | 101 | c = getchar (); |
| 102 | } | 102 | } |
| 103 | exit (1); | 103 | exit (EXIT_FAILURE); |
| 104 | } | 104 | } |
| 105 | 105 | ||
| 106 | /* arch-tag: 8db68f7e-2322-4944-a315-dba349bdbf39 | 106 | /* arch-tag: 8db68f7e-2322-4944-a315-dba349bdbf39 |
| 107 | (do not change this comment) */ | 107 | (do not change this comment) */ |
| 108 | |||
| 109 | /* profile.c ends here */ | ||
diff --git a/lib-src/sorted-doc.c b/lib-src/sorted-doc.c index 05a3e69cc92..3af3276e811 100644 --- a/lib-src/sorted-doc.c +++ b/lib-src/sorted-doc.c | |||
| @@ -75,7 +75,7 @@ fatal (s1, s2) | |||
| 75 | char *s1, *s2; | 75 | char *s1, *s2; |
| 76 | { | 76 | { |
| 77 | error (s1, s2); | 77 | error (s1, s2); |
| 78 | exit (1); | 78 | exit (EXIT_FAILURE); |
| 79 | } | 79 | } |
| 80 | 80 | ||
| 81 | /* Like malloc but get fatal error if memory is exhausted. */ | 81 | /* Like malloc but get fatal error if memory is exhausted. */ |
| @@ -279,8 +279,10 @@ main () | |||
| 279 | printf ("@bye\n"); | 279 | printf ("@bye\n"); |
| 280 | } | 280 | } |
| 281 | 281 | ||
| 282 | return 0; | 282 | return EXIT_SUCCESS; |
| 283 | } | 283 | } |
| 284 | 284 | ||
| 285 | /* arch-tag: ce28f204-1e70-4b34-8210-3d54a5662071 | 285 | /* arch-tag: ce28f204-1e70-4b34-8210-3d54a5662071 |
| 286 | (do not change this comment) */ | 286 | (do not change this comment) */ |
| 287 | |||
| 288 | /* sorted-doc.c ends here */ | ||
diff --git a/lib-src/test-distrib.c b/lib-src/test-distrib.c index f7b3a8b8004..97e87695c7c 100644 --- a/lib-src/test-distrib.c +++ b/lib-src/test-distrib.c | |||
| @@ -100,11 +100,10 @@ have been corrupted in the files of Emacs, and it will not work.\n", | |||
| 100 | exit (2); | 100 | exit (2); |
| 101 | } | 101 | } |
| 102 | close (fd); | 102 | close (fd); |
| 103 | #ifdef VMS | 103 | return EXIT_SUCCESS; |
| 104 | exit (1); /* On VMS, success is 1. */ | ||
| 105 | #endif | ||
| 106 | return (0); | ||
| 107 | } | 104 | } |
| 108 | 105 | ||
| 109 | /* arch-tag: 3a89005d-df98-4c32-aa9f-33570e16a26a | 106 | /* arch-tag: 3a89005d-df98-4c32-aa9f-33570e16a26a |
| 110 | (do not change this comment) */ | 107 | (do not change this comment) */ |
| 108 | |||
| 109 | /* test-distrib.c ends here */ | ||
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index 74fa2b06920..8f7c90cad55 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c | |||
| @@ -111,7 +111,7 @@ lose (msg) | |||
| 111 | const char *msg; | 111 | const char *msg; |
| 112 | { | 112 | { |
| 113 | fprintf (stderr, "%s\n", msg); | 113 | fprintf (stderr, "%s\n", msg); |
| 114 | exit (1); | 114 | exit (EXIT_FAILURE); |
| 115 | } | 115 | } |
| 116 | 116 | ||
| 117 | void lose_syserr P_ ((const char *msg)) NO_RETURN; | 117 | void lose_syserr P_ ((const char *msg)) NO_RETURN; |
| @@ -138,7 +138,7 @@ lose_syserr (msg) | |||
| 138 | const char *msg; | 138 | const char *msg; |
| 139 | { | 139 | { |
| 140 | fprintf (stderr, "%s: %s\n", msg, strerror (errno)); | 140 | fprintf (stderr, "%s: %s\n", msg, strerror (errno)); |
| 141 | exit (1); | 141 | exit (EXIT_FAILURE); |
| 142 | } | 142 | } |
| 143 | 143 | ||
| 144 | char * | 144 | char * |
| @@ -199,7 +199,7 @@ main (argc, argv) | |||
| 199 | switch (c) | 199 | switch (c) |
| 200 | { | 200 | { |
| 201 | case 'h': | 201 | case 'h': |
| 202 | usage (0); | 202 | usage (EXIT_SUCCESS); |
| 203 | break; | 203 | break; |
| 204 | case 'd': | 204 | case 'd': |
| 205 | user_prefix = optarg; | 205 | user_prefix = optarg; |
| @@ -213,11 +213,11 @@ main (argc, argv) | |||
| 213 | max = MAX_SCORES; | 213 | max = MAX_SCORES; |
| 214 | break; | 214 | break; |
| 215 | default: | 215 | default: |
| 216 | usage (1); | 216 | usage (EXIT_FAILURE); |
| 217 | } | 217 | } |
| 218 | 218 | ||
| 219 | if (optind+3 != argc) | 219 | if (optind+3 != argc) |
| 220 | usage (1); | 220 | usage (EXIT_FAILURE); |
| 221 | 221 | ||
| 222 | running_suid = (getuid () != geteuid ()); | 222 | running_suid = (getuid () != geteuid ()); |
| 223 | 223 | ||
| @@ -266,7 +266,7 @@ main (argc, argv) | |||
| 266 | lose_syserr ("Failed to write scores file"); | 266 | lose_syserr ("Failed to write scores file"); |
| 267 | } | 267 | } |
| 268 | unlock_file (scorefile, lockstate); | 268 | unlock_file (scorefile, lockstate); |
| 269 | exit (0); | 269 | exit (EXIT_SUCCESS); |
| 270 | } | 270 | } |
| 271 | 271 | ||
| 272 | int | 272 | int |
| @@ -531,3 +531,5 @@ unlock_file (filename, state) | |||
| 531 | 531 | ||
| 532 | /* arch-tag: 2bf5c52e-4beb-463a-954e-c58b9c64736b | 532 | /* arch-tag: 2bf5c52e-4beb-463a-954e-c58b9c64736b |
| 533 | (do not change this comment) */ | 533 | (do not change this comment) */ |
| 534 | |||
| 535 | /* update-game-score.c ends here */ | ||
diff --git a/lib-src/yow.c b/lib-src/yow.c index 10f0fad1ce7..9d58ce5aecb 100644 --- a/lib-src/yow.c +++ b/lib-src/yow.c | |||
| @@ -73,7 +73,7 @@ main (argc, argv) | |||
| 73 | if ((fp = fopen(file, "r")) == NULL) { | 73 | if ((fp = fopen(file, "r")) == NULL) { |
| 74 | fprintf(stderr, "yow: "); | 74 | fprintf(stderr, "yow: "); |
| 75 | perror(file); | 75 | perror(file); |
| 76 | exit(1); | 76 | exit(EXIT_FAILURE); |
| 77 | } | 77 | } |
| 78 | 78 | ||
| 79 | /* initialize random seed */ | 79 | /* initialize random seed */ |
| @@ -82,7 +82,7 @@ main (argc, argv) | |||
| 82 | setup_yow(fp); | 82 | setup_yow(fp); |
| 83 | yow(fp); | 83 | yow(fp); |
| 84 | fclose(fp); | 84 | fclose(fp); |
| 85 | return 0; | 85 | return EXIT_SUCCESS; |
| 86 | } | 86 | } |
| 87 | 87 | ||
| 88 | static long len = -1; | 88 | static long len = -1; |
| @@ -113,7 +113,7 @@ setup_yow(fp) | |||
| 113 | 113 | ||
| 114 | if (fseek(fp, 0L, 2) == -1) { | 114 | if (fseek(fp, 0L, 2) == -1) { |
| 115 | perror("yow"); | 115 | perror("yow"); |
| 116 | exit(1); | 116 | exit(EXIT_FAILURE); |
| 117 | } | 117 | } |
| 118 | len = ftell(fp) - header_len; | 118 | len = ftell(fp) - header_len; |
| 119 | } | 119 | } |
| @@ -132,7 +132,7 @@ yow (fp) | |||
| 132 | offset = rand() % len + header_len; | 132 | offset = rand() % len + header_len; |
| 133 | if (fseek(fp, offset, 0) == -1) { | 133 | if (fseek(fp, offset, 0) == -1) { |
| 134 | perror("yow"); | 134 | perror("yow"); |
| 135 | exit(1); | 135 | exit(EXIT_FAILURE); |
| 136 | } | 136 | } |
| 137 | 137 | ||
| 138 | /* Read until SEP, read next line, print it. | 138 | /* Read until SEP, read next line, print it. |
| @@ -180,3 +180,5 @@ yow (fp) | |||
| 180 | 180 | ||
| 181 | /* arch-tag: e40fc0df-bafb-4001-af24-5c883d1c685e | 181 | /* arch-tag: e40fc0df-bafb-4001-af24-5c883d1c685e |
| 182 | (do not change this comment) */ | 182 | (do not change this comment) */ |
| 183 | |||
| 184 | /* yow.c ends here */ | ||
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9db4ad63474..c7a3ca20f00 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,57 @@ | |||
| 1 | 2004-05-08 Andreas Schwab <schwab@suse.de> | ||
| 2 | |||
| 3 | * international/subst-ksc.el: Fix references to utf-translate-cjk | ||
| 4 | into utf-translate-cjk-mode. | ||
| 5 | * international/subst-big5.el: Likewise. | ||
| 6 | * international/subst-gb2312.el: Likewise. | ||
| 7 | * international/subst-jis.el: Likewise. | ||
| 8 | * international/utf-16.el: Likewise. | ||
| 9 | * international/utf-8.el: Likewise. | ||
| 10 | |||
| 11 | 2004-05-08 John Wiegley <johnw@newartisans.com> | ||
| 12 | |||
| 13 | * iswitchb.el (iswitchb-use-virtual-buffers): Added support for | ||
| 14 | "virtual buffers" (off by default), which makes it possible to | ||
| 15 | switch to the "virtual" buffers of recently visited files. When a | ||
| 16 | buffer name search fails, and this option is on, iswitchb will | ||
| 17 | look at the list of recently visited files, and permit matching | ||
| 18 | against those names. When the user hits RET on a match, it will | ||
| 19 | revisit that file. | ||
| 20 | (iswitchb-read-buffer): Added two optional arguments, which makes | ||
| 21 | isearchb.el possible. | ||
| 22 | (iswitchb-completions, iswitchb-set-matches, iswitchb-prev-match, | ||
| 23 | iswitchb-next-match): Added support for virtual buffers. | ||
| 24 | |||
| 25 | * isearchb.el: This module extends iswitchb to provide "as you | ||
| 26 | type" buffer selection. | ||
| 27 | |||
| 28 | * textmodes/flyspell.el (flyspell-highlight-incorrect-region): | ||
| 29 | Ignore the read-only property when flyspell highlighting is on. | ||
| 30 | Not ignoring it leads to a series of confusing errors. | ||
| 31 | (flyspell-highlight-duplicate-region): Ignore read-only, as above, | ||
| 32 | but also make sure to call flyspell-incorrect-hook. | ||
| 33 | (flyspell-maybe-correct-transposition): Perform transposition test | ||
| 34 | by bit twiddling a string, rather than using a temp buffer. | ||
| 35 | (flyspell-maybe-correct-doubling): Use a string rather than a temp | ||
| 36 | buffer. This is also the original version of the code, which | ||
| 37 | could not be checked in before due to a previous lack of | ||
| 38 | assignment papers. This version has seen heavy usage on my system | ||
| 39 | for several years now. | ||
| 40 | |||
| 41 | * calendar/cal-bahai.el: New file, which adds support for the | ||
| 42 | Baha'i calendar to Emacs. This calendar is based on a solar year | ||
| 43 | of 19 months of 19 days, with 4 intercalary days. Each year | ||
| 44 | begins on March 21, with the calendar starting in 1844. | ||
| 45 | |||
| 46 | * calendar/cal-menu.el, calendar/calendar.el, | ||
| 47 | calendar/diary-lib.el, calendar/holidays.el: Added support for | ||
| 48 | using cal-bahai.el. | ||
| 49 | |||
| 50 | * eshell/em-glob.el (eshell-glob-initialize): Move initialization | ||
| 51 | of `eshell-glob-chars-regexp' into `eshell-glob-regexp', so that | ||
| 52 | function can be used outside of eshell buffers. | ||
| 53 | (eshell-glob-regexp): Initialize `eshell-glob-chars-regexp' here. | ||
| 54 | |||
| 1 | 2004-05-08 Juanma Barranquero <lektu@terra.es> | 55 | 2004-05-08 Juanma Barranquero <lektu@terra.es> |
| 2 | 56 | ||
| 3 | * help-fns.el (help-do-arg-highlight): Temporarily set ?\- to be a | 57 | * help-fns.el (help-do-arg-highlight): Temporarily set ?\- to be a |
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el new file mode 100644 index 00000000000..4dfd8eb16e5 --- /dev/null +++ b/lisp/calendar/cal-bahai.el | |||
| @@ -0,0 +1,507 @@ | |||
| 1 | ;;; cal-bahai.el --- calendar functions for the Baha'i calendar. | ||
| 2 | |||
| 3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@gnu.org> | ||
| 6 | ;; Keywords: calendar | ||
| 7 | ;; Human-Keywords: Baha'i calendar, Baha'i, Bahai, calendar, diary | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 24 | ;; Boston, MA 02111-1307, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; This collection of functions implements the features of calendar.el | ||
| 29 | ;; and diary.el that deal with the Baha'i calendar. | ||
| 30 | |||
| 31 | ;; The Baha'i (http://www.bahai.org) calendar system is based on a | ||
| 32 | ;; solar cycle of 19 months with 19 days each. The four remaining | ||
| 33 | ;; "intercalary" days are called the Ayyam-i-Ha (days of Ha), and are | ||
| 34 | ;; placed between the 18th and 19th months. They are meant as a time | ||
| 35 | ;; of festivals preceding the 19th month, which is the month of | ||
| 36 | ;; fasting. In Gregorian leap years, there are 5 of these days (Ha | ||
| 37 | ;; has the numerical value of 5 in the arabic abjad, or | ||
| 38 | ;; letter-to-number, reckoning). | ||
| 39 | |||
| 40 | ;; Each month is named after an attribute of God, as are the 19 days | ||
| 41 | ;; -- which have the same names as the months. There is also a name | ||
| 42 | ;; for each year in every 19 year cycle. These cycles are called | ||
| 43 | ;; Vahids. A cycle of 19 Vahids (361 years) is called a Kullu-Shay, | ||
| 44 | ;; which means "all things". | ||
| 45 | |||
| 46 | ;; The calendar was named the "Badi calendar" by its author, the Bab. | ||
| 47 | ;; It uses a week of seven days, corresponding to the Gregorian week, | ||
| 48 | ;; each of which has its own name, again patterned after the | ||
| 49 | ;; attributes of God. | ||
| 50 | |||
| 51 | ;; Note: The days of Ayyam-i-Ha are encoded as zero and negative | ||
| 52 | ;; offsets from the first day of the final month. So, (19 -3 157) is | ||
| 53 | ;; the first day of Ayyam-i-Ha, in the year 157 BE. | ||
| 54 | |||
| 55 | ;;; Code: | ||
| 56 | |||
| 57 | (require 'cal-julian) | ||
| 58 | |||
| 59 | (defvar bahai-calendar-month-name-array | ||
| 60 | ["Baha" "Jalal" "Jamal" "`Azamat" "Nur" "Rahmat" "Kalimat" "Kamal" | ||
| 61 | "Asma" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masa'il" | ||
| 62 | "Sharaf" "Sultan" "Mulk" "`Ala"]) | ||
| 63 | |||
| 64 | (defvar calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) | ||
| 65 | "Absolute date of start of Baha'i calendar = March 19, 622 A.D. (Julian).") | ||
| 66 | |||
| 67 | (defun bahai-calendar-leap-year-p (year) | ||
| 68 | "True if YEAR is a leap year on the Baha'i calendar." | ||
| 69 | (calendar-leap-year-p (+ year 1844))) | ||
| 70 | |||
| 71 | (defvar bahai-calendar-leap-base | ||
| 72 | (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))) | ||
| 73 | |||
| 74 | (defun calendar-absolute-from-bahai (date) | ||
| 75 | "Compute absolute date from Baha'i date DATE. | ||
| 76 | The absolute date is the number of days elapsed since the (imaginary) | ||
| 77 | Gregorian date Sunday, December 31, 1 BC." | ||
| 78 | (let* ((month (extract-calendar-month date)) | ||
| 79 | (day (extract-calendar-day date)) | ||
| 80 | (year (extract-calendar-year date)) | ||
| 81 | (prior-years (+ (1- year) 1844)) | ||
| 82 | (leap-days (- (+ (/ prior-years 4) ; Leap days in prior years. | ||
| 83 | (- (/ prior-years 100)) | ||
| 84 | (/ prior-years 400)) | ||
| 85 | bahai-calendar-leap-base))) | ||
| 86 | (+ (1- calendar-bahai-epoch) ; Days before epoch | ||
| 87 | (* 365 (1- year)) ; Days in prior years. | ||
| 88 | leap-days | ||
| 89 | (calendar-sum m 1 (< m month) 19) | ||
| 90 | (if (= month 19) 4 0) | ||
| 91 | day))) ; Days so far this month. | ||
| 92 | |||
| 93 | (defun calendar-bahai-from-absolute (date) | ||
| 94 | "Baha'i year corresponding to the absolute DATE." | ||
| 95 | (if (< date calendar-bahai-epoch) | ||
| 96 | (list 0 0 0) ;; pre-Baha'i date | ||
| 97 | (let* ((greg (calendar-gregorian-from-absolute date)) | ||
| 98 | (year (+ (- (extract-calendar-year greg) 1844) | ||
| 99 | (if (or (> (extract-calendar-month greg) 3) | ||
| 100 | (and (= (extract-calendar-month greg) 3) | ||
| 101 | (>= (extract-calendar-day greg) 21))) | ||
| 102 | 1 0))) | ||
| 103 | (month ;; Search forward from Baha. | ||
| 104 | (1+ (calendar-sum m 1 | ||
| 105 | (> date | ||
| 106 | (calendar-absolute-from-bahai | ||
| 107 | (list m 19 year))) | ||
| 108 | 1))) | ||
| 109 | (day ;; Calculate the day by subtraction. | ||
| 110 | (- date | ||
| 111 | (1- (calendar-absolute-from-bahai (list month 1 year)))))) | ||
| 112 | (list month day year)))) | ||
| 113 | |||
| 114 | (defun calendar-bahai-date-string (&optional date) | ||
| 115 | "String of Baha'i date of Gregorian DATE. | ||
| 116 | Defaults to today's date if DATE is not given." | ||
| 117 | (let* ((bahai-date (calendar-bahai-from-absolute | ||
| 118 | (calendar-absolute-from-gregorian | ||
| 119 | (or date (calendar-current-date))))) | ||
| 120 | (y (extract-calendar-year bahai-date)) | ||
| 121 | (m (extract-calendar-month bahai-date)) | ||
| 122 | (d (extract-calendar-day bahai-date))) | ||
| 123 | (let ((monthname | ||
| 124 | (if (and (= m 19) | ||
| 125 | (<= d 0)) | ||
| 126 | "Ayyam-i-Ha" | ||
| 127 | (aref bahai-calendar-month-name-array (1- m)))) | ||
| 128 | (day (int-to-string | ||
| 129 | (if (<= d 0) | ||
| 130 | (if (bahai-calendar-leap-year-p y) | ||
| 131 | (+ d 5) | ||
| 132 | (+ d 4)) | ||
| 133 | d))) | ||
| 134 | (dayname nil) | ||
| 135 | (month (int-to-string m)) | ||
| 136 | (year (int-to-string y))) | ||
| 137 | (mapconcat 'eval calendar-date-display-form "")))) | ||
| 138 | |||
| 139 | (defun calendar-print-bahai-date () | ||
| 140 | "Show the Baha'i calendar equivalent of the selected date." | ||
| 141 | (interactive) | ||
| 142 | (message "Baha'i date: %s" | ||
| 143 | (calendar-bahai-date-string (calendar-cursor-to-date t)))) | ||
| 144 | |||
| 145 | (defun calendar-goto-bahai-date (date &optional noecho) | ||
| 146 | "Move cursor to Baha'i date DATE. | ||
| 147 | Echo Baha'i date unless NOECHO is t." | ||
| 148 | (interactive (bahai-prompt-for-date)) | ||
| 149 | (calendar-goto-date (calendar-gregorian-from-absolute | ||
| 150 | (calendar-absolute-from-bahai date))) | ||
| 151 | (or noecho (calendar-print-bahai-date))) | ||
| 152 | |||
| 153 | (defun bahai-prompt-for-date () | ||
| 154 | "Ask for a Baha'i date." | ||
| 155 | (let* ((today (calendar-current-date)) | ||
| 156 | (year (calendar-read | ||
| 157 | "Baha'i calendar year (not 0): " | ||
| 158 | '(lambda (x) (/= x 0)) | ||
| 159 | (int-to-string | ||
| 160 | (extract-calendar-year | ||
| 161 | (calendar-bahai-from-absolute | ||
| 162 | (calendar-absolute-from-gregorian today)))))) | ||
| 163 | (completion-ignore-case t) | ||
| 164 | (month (cdr (assoc | ||
| 165 | (completing-read | ||
| 166 | "Baha'i calendar month name: " | ||
| 167 | (mapcar 'list | ||
| 168 | (append bahai-calendar-month-name-array nil)) | ||
| 169 | nil t) | ||
| 170 | (calendar-make-alist bahai-calendar-month-name-array | ||
| 171 | 1)))) | ||
| 172 | (day (calendar-read "Baha'i calendar day (1-19): " | ||
| 173 | '(lambda (x) (and (< 0 x) (<= x 19)))))) | ||
| 174 | (list (list month day year)))) | ||
| 175 | |||
| 176 | (defun diary-bahai-date () | ||
| 177 | "Baha'i calendar equivalent of date diary entry." | ||
| 178 | (format "Baha'i date: %s" (calendar-bahai-date-string date))) | ||
| 179 | |||
| 180 | (defun holiday-bahai (month day string) | ||
| 181 | "Holiday on MONTH, DAY (Baha'i) called STRING. | ||
| 182 | If MONTH, DAY (Baha'i) is visible, the value returned is corresponding | ||
| 183 | Gregorian date in the form of the list (((month day year) STRING)). Returns | ||
| 184 | nil if it is not visible in the current calendar window." | ||
| 185 | (let* ((bahai-date (calendar-bahai-from-absolute | ||
| 186 | (calendar-absolute-from-gregorian | ||
| 187 | (list displayed-month 15 displayed-year)))) | ||
| 188 | (m (extract-calendar-month bahai-date)) | ||
| 189 | (y (extract-calendar-year bahai-date)) | ||
| 190 | (date)) | ||
| 191 | (if (< m 1) | ||
| 192 | nil ;; Baha'i calendar doesn't apply. | ||
| 193 | (increment-calendar-month m y (- 10 month)) | ||
| 194 | (if (> m 7) ;; Baha'i date might be visible | ||
| 195 | (let ((date (calendar-gregorian-from-absolute | ||
| 196 | (calendar-absolute-from-bahai (list month day y))))) | ||
| 197 | (if (calendar-date-is-visible-p date) | ||
| 198 | (list (list date string)))))))) | ||
| 199 | |||
| 200 | (defun list-bahai-diary-entries () | ||
| 201 | "Add any Baha'i date entries from the diary file to `diary-entries-list'. | ||
| 202 | Baha'i date diary entries must be prefaced by an | ||
| 203 | `bahai-diary-entry-symbol' (normally a `B'). The same diary date | ||
| 204 | forms govern the style of the Baha'i calendar entries, except that the | ||
| 205 | Baha'i month names must be given numerically. The Baha'i months are | ||
| 206 | numbered from 1 to 19 with Baha being 1 and 19 being `Ala. If a | ||
| 207 | Baha'i date diary entry begins with a `diary-nonmarking-symbol', the | ||
| 208 | entry will appear in the diary listing, but will not be marked in the | ||
| 209 | calendar. This function is provided for use with the | ||
| 210 | `nongregorian-diary-listing-hook'." | ||
| 211 | (if (< 0 number) | ||
| 212 | (let ((buffer-read-only nil) | ||
| 213 | (diary-modified (buffer-modified-p)) | ||
| 214 | (gdate original-date) | ||
| 215 | (mark (regexp-quote diary-nonmarking-symbol))) | ||
| 216 | (calendar-for-loop i from 1 to number do | ||
| 217 | (let* ((d diary-date-forms) | ||
| 218 | (bdate (calendar-bahai-from-absolute | ||
| 219 | (calendar-absolute-from-gregorian gdate))) | ||
| 220 | (month (extract-calendar-month bdate)) | ||
| 221 | (day (extract-calendar-day bdate)) | ||
| 222 | (year (extract-calendar-year bdate))) | ||
| 223 | (while d | ||
| 224 | (let* | ||
| 225 | ((date-form (if (equal (car (car d)) 'backup) | ||
| 226 | (cdr (car d)) | ||
| 227 | (car d))) | ||
| 228 | (backup (equal (car (car d)) 'backup)) | ||
| 229 | (dayname | ||
| 230 | (concat | ||
| 231 | (calendar-day-name gdate) "\\|" | ||
| 232 | (substring (calendar-day-name gdate) 0 3) ".?")) | ||
| 233 | (calendar-month-name-array | ||
| 234 | bahai-calendar-month-name-array) | ||
| 235 | (monthname | ||
| 236 | (concat | ||
| 237 | "\\*\\|" | ||
| 238 | (calendar-month-name month))) | ||
| 239 | (month (concat "\\*\\|0*" (int-to-string month))) | ||
| 240 | (day (concat "\\*\\|0*" (int-to-string day))) | ||
| 241 | (year | ||
| 242 | (concat | ||
| 243 | "\\*\\|0*" (int-to-string year) | ||
| 244 | (if abbreviated-calendar-year | ||
| 245 | (concat "\\|" (int-to-string (% year 100))) | ||
| 246 | ""))) | ||
| 247 | (regexp | ||
| 248 | (concat | ||
| 249 | "\\(\\`\\|\^M\\|\n\\)" mark "?" | ||
| 250 | (regexp-quote bahai-diary-entry-symbol) | ||
| 251 | "\\(" | ||
| 252 | (mapconcat 'eval date-form "\\)\\(") | ||
| 253 | "\\)")) | ||
| 254 | (case-fold-search t)) | ||
| 255 | (goto-char (point-min)) | ||
| 256 | (while (re-search-forward regexp nil t) | ||
| 257 | (if backup (re-search-backward "\\<" nil t)) | ||
| 258 | (if (and (or (char-equal (preceding-char) ?\^M) | ||
| 259 | (char-equal (preceding-char) ?\n)) | ||
| 260 | (not (looking-at " \\|\^I"))) | ||
| 261 | ;; Diary entry that consists only of date. | ||
| 262 | (backward-char 1) | ||
| 263 | ;; Found a nonempty diary entry--make it visible and | ||
| 264 | ;; add it to the list. | ||
| 265 | (let ((entry-start (point)) | ||
| 266 | (date-start)) | ||
| 267 | (re-search-backward "\^M\\|\n\\|\\`") | ||
| 268 | (setq date-start (point)) | ||
| 269 | (re-search-forward "\^M\\|\n" nil t 2) | ||
| 270 | (while (looking-at " \\|\^I") | ||
| 271 | (re-search-forward "\^M\\|\n" nil t)) | ||
| 272 | (backward-char 1) | ||
| 273 | (subst-char-in-region date-start (point) ?\^M ?\n t) | ||
| 274 | (add-to-diary-list | ||
| 275 | gdate | ||
| 276 | (buffer-substring-no-properties entry-start (point)) | ||
| 277 | (buffer-substring-no-properties | ||
| 278 | (1+ date-start) (1- entry-start))))))) | ||
| 279 | (setq d (cdr d)))) | ||
| 280 | (setq gdate | ||
| 281 | (calendar-gregorian-from-absolute | ||
| 282 | (1+ (calendar-absolute-from-gregorian gdate))))) | ||
| 283 | (set-buffer-modified-p diary-modified)) | ||
| 284 | (goto-char (point-min)))) | ||
| 285 | |||
| 286 | (defun mark-bahai-diary-entries () | ||
| 287 | "Mark days in the calendar window that have Baha'i date diary entries. | ||
| 288 | Each entry in diary-file (or included files) visible in the calendar | ||
| 289 | window is marked. Baha'i date entries are prefaced by a | ||
| 290 | bahai-diary-entry-symbol \(normally a B`I'). The same | ||
| 291 | diary-date-forms govern the style of the Baha'i calendar entries, | ||
| 292 | except that the Baha'i month names must be spelled in full. The | ||
| 293 | Baha'i months are numbered from 1 to 12 with Baha being 1 and 12 being | ||
| 294 | `Ala. Baha'i date diary entries that begin with a | ||
| 295 | diary-nonmarking-symbol will not be marked in the calendar. This | ||
| 296 | function is provided for use as part of the | ||
| 297 | nongregorian-diary-marking-hook." | ||
| 298 | (let ((d diary-date-forms)) | ||
| 299 | (while d | ||
| 300 | (let* | ||
| 301 | ((date-form (if (equal (car (car d)) 'backup) | ||
| 302 | (cdr (car d)) | ||
| 303 | (car d)));; ignore 'backup directive | ||
| 304 | (dayname (diary-name-pattern calendar-day-name-array)) | ||
| 305 | (monthname | ||
| 306 | (concat | ||
| 307 | (diary-name-pattern bahai-calendar-month-name-array t) | ||
| 308 | "\\|\\*")) | ||
| 309 | (month "[0-9]+\\|\\*") | ||
| 310 | (day "[0-9]+\\|\\*") | ||
| 311 | (year "[0-9]+\\|\\*") | ||
| 312 | (l (length date-form)) | ||
| 313 | (d-name-pos (- l (length (memq 'dayname date-form)))) | ||
| 314 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) | ||
| 315 | (m-name-pos (- l (length (memq 'monthname date-form)))) | ||
| 316 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) | ||
| 317 | (d-pos (- l (length (memq 'day date-form)))) | ||
| 318 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) | ||
| 319 | (m-pos (- l (length (memq 'month date-form)))) | ||
| 320 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) | ||
| 321 | (y-pos (- l (length (memq 'year date-form)))) | ||
| 322 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) | ||
| 323 | (regexp | ||
| 324 | (concat | ||
| 325 | "\\(\\`\\|\^M\\|\n\\)" | ||
| 326 | (regexp-quote bahai-diary-entry-symbol) | ||
| 327 | "\\(" | ||
| 328 | (mapconcat 'eval date-form "\\)\\(") | ||
| 329 | "\\)")) | ||
| 330 | (case-fold-search t)) | ||
| 331 | (goto-char (point-min)) | ||
| 332 | (while (re-search-forward regexp nil t) | ||
| 333 | (let* ((dd-name | ||
| 334 | (if d-name-pos | ||
| 335 | (buffer-substring | ||
| 336 | (match-beginning d-name-pos) | ||
| 337 | (match-end d-name-pos)))) | ||
| 338 | (mm-name | ||
| 339 | (if m-name-pos | ||
| 340 | (buffer-substring | ||
| 341 | (match-beginning m-name-pos) | ||
| 342 | (match-end m-name-pos)))) | ||
| 343 | (mm (string-to-int | ||
| 344 | (if m-pos | ||
| 345 | (buffer-substring | ||
| 346 | (match-beginning m-pos) | ||
| 347 | (match-end m-pos)) | ||
| 348 | ""))) | ||
| 349 | (dd (string-to-int | ||
| 350 | (if d-pos | ||
| 351 | (buffer-substring | ||
| 352 | (match-beginning d-pos) | ||
| 353 | (match-end d-pos)) | ||
| 354 | ""))) | ||
| 355 | (y-str (if y-pos | ||
| 356 | (buffer-substring | ||
| 357 | (match-beginning y-pos) | ||
| 358 | (match-end y-pos)))) | ||
| 359 | (yy (if (not y-str) | ||
| 360 | 0 | ||
| 361 | (if (and (= (length y-str) 2) | ||
| 362 | abbreviated-calendar-year) | ||
| 363 | (let* ((current-y | ||
| 364 | (extract-calendar-year | ||
| 365 | (calendar-bahai-from-absolute | ||
| 366 | (calendar-absolute-from-gregorian | ||
| 367 | (calendar-current-date))))) | ||
| 368 | (y (+ (string-to-int y-str) | ||
| 369 | (* 100 (/ current-y 100))))) | ||
| 370 | (if (> (- y current-y) 50) | ||
| 371 | (- y 100) | ||
| 372 | (if (> (- current-y y) 50) | ||
| 373 | (+ y 100) | ||
| 374 | y))) | ||
| 375 | (string-to-int y-str))))) | ||
| 376 | (if dd-name | ||
| 377 | (mark-calendar-days-named | ||
| 378 | (cdr (assoc-ignore-case (substring dd-name 0 3) | ||
| 379 | (calendar-make-alist | ||
| 380 | calendar-day-name-array | ||
| 381 | 0 | ||
| 382 | '(lambda (x) (substring x 0 3)))))) | ||
| 383 | (if mm-name | ||
| 384 | (if (string-equal mm-name "*") | ||
| 385 | (setq mm 0) | ||
| 386 | (setq mm | ||
| 387 | (cdr (assoc-ignore-case | ||
| 388 | mm-name | ||
| 389 | (calendar-make-alist | ||
| 390 | bahai-calendar-month-name-array)))))) | ||
| 391 | (mark-bahai-calendar-date-pattern mm dd yy))))) | ||
| 392 | (setq d (cdr d))))) | ||
| 393 | |||
| 394 | (defun mark-bahai-calendar-date-pattern (month day year) | ||
| 395 | "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR. | ||
| 396 | A value of 0 in any position is a wildcard." | ||
| 397 | (save-excursion | ||
| 398 | (set-buffer calendar-buffer) | ||
| 399 | (if (and (/= 0 month) (/= 0 day)) | ||
| 400 | (if (/= 0 year) | ||
| 401 | ;; Fully specified Baha'i date. | ||
| 402 | (let ((date (calendar-gregorian-from-absolute | ||
| 403 | (calendar-absolute-from-bahai | ||
| 404 | (list month day year))))) | ||
| 405 | (if (calendar-date-is-visible-p date) | ||
| 406 | (mark-visible-calendar-date date))) | ||
| 407 | ;; Month and day in any year--this taken from the holiday stuff. | ||
| 408 | (let* ((bahai-date (calendar-bahai-from-absolute | ||
| 409 | (calendar-absolute-from-gregorian | ||
| 410 | (list displayed-month 15 displayed-year)))) | ||
| 411 | (m (extract-calendar-month bahai-date)) | ||
| 412 | (y (extract-calendar-year bahai-date)) | ||
| 413 | (date)) | ||
| 414 | (if (< m 1) | ||
| 415 | nil;; Baha'i calendar doesn't apply. | ||
| 416 | (increment-calendar-month m y (- 10 month)) | ||
| 417 | (if (> m 7);; Baha'i date might be visible | ||
| 418 | (let ((date (calendar-gregorian-from-absolute | ||
| 419 | (calendar-absolute-from-bahai | ||
| 420 | (list month day y))))) | ||
| 421 | (if (calendar-date-is-visible-p date) | ||
| 422 | (mark-visible-calendar-date date))))))) | ||
| 423 | ;; Not one of the simple cases--check all visible dates for match. | ||
| 424 | ;; Actually, the following code takes care of ALL of the cases, but | ||
| 425 | ;; it's much too slow to be used for the simple (common) cases. | ||
| 426 | (let ((m displayed-month) | ||
| 427 | (y displayed-year) | ||
| 428 | (first-date) | ||
| 429 | (last-date)) | ||
| 430 | (increment-calendar-month m y -1) | ||
| 431 | (setq first-date | ||
| 432 | (calendar-absolute-from-gregorian | ||
| 433 | (list m 1 y))) | ||
| 434 | (increment-calendar-month m y 2) | ||
| 435 | (setq last-date | ||
| 436 | (calendar-absolute-from-gregorian | ||
| 437 | (list m (calendar-last-day-of-month m y) y))) | ||
| 438 | (calendar-for-loop date from first-date to last-date do | ||
| 439 | (let* ((b-date (calendar-bahai-from-absolute date)) | ||
| 440 | (i-month (extract-calendar-month b-date)) | ||
| 441 | (i-day (extract-calendar-day b-date)) | ||
| 442 | (i-year (extract-calendar-year b-date))) | ||
| 443 | (and (or (zerop month) | ||
| 444 | (= month i-month)) | ||
| 445 | (or (zerop day) | ||
| 446 | (= day i-day)) | ||
| 447 | (or (zerop year) | ||
| 448 | (= year i-year)) | ||
| 449 | (mark-visible-calendar-date | ||
| 450 | (calendar-gregorian-from-absolute date))))))))) | ||
| 451 | |||
| 452 | (defun insert-bahai-diary-entry (arg) | ||
| 453 | "Insert a diary entry. | ||
| 454 | For the Baha'i date corresponding to the date indicated by point. | ||
| 455 | Prefix arg will make the entry nonmarking." | ||
| 456 | (interactive "P") | ||
| 457 | (let* ((calendar-month-name-array bahai-calendar-month-name-array)) | ||
| 458 | (make-diary-entry | ||
| 459 | (concat | ||
| 460 | bahai-diary-entry-symbol | ||
| 461 | (calendar-date-string | ||
| 462 | (calendar-bahai-from-absolute | ||
| 463 | (calendar-absolute-from-gregorian | ||
| 464 | (calendar-cursor-to-date t))) | ||
| 465 | nil t)) | ||
| 466 | arg))) | ||
| 467 | |||
| 468 | (defun insert-monthly-bahai-diary-entry (arg) | ||
| 469 | "Insert a monthly diary entry. | ||
| 470 | For the day of the Baha'i month corresponding to the date indicated by point. | ||
| 471 | Prefix arg will make the entry nonmarking." | ||
| 472 | (interactive "P") | ||
| 473 | (let* ((calendar-date-display-form | ||
| 474 | (if european-calendar-style '(day " * ") '("* " day ))) | ||
| 475 | (calendar-month-name-array bahai-calendar-month-name-array)) | ||
| 476 | (make-diary-entry | ||
| 477 | (concat | ||
| 478 | bahai-diary-entry-symbol | ||
| 479 | (calendar-date-string | ||
| 480 | (calendar-bahai-from-absolute | ||
| 481 | (calendar-absolute-from-gregorian | ||
| 482 | (calendar-cursor-to-date t))))) | ||
| 483 | arg))) | ||
| 484 | |||
| 485 | (defun insert-yearly-bahai-diary-entry (arg) | ||
| 486 | "Insert an annual diary entry. | ||
| 487 | For the day of the Baha'i year corresponding to the date indicated by point. | ||
| 488 | Prefix arg will make the entry nonmarking." | ||
| 489 | (interactive "P") | ||
| 490 | (let* ((calendar-date-display-form | ||
| 491 | (if european-calendar-style | ||
| 492 | '(day " " monthname) | ||
| 493 | '(monthname " " day))) | ||
| 494 | (calendar-month-name-array bahai-calendar-month-name-array)) | ||
| 495 | (make-diary-entry | ||
| 496 | (concat | ||
| 497 | bahai-diary-entry-symbol | ||
| 498 | (calendar-date-string | ||
| 499 | (calendar-bahai-from-absolute | ||
| 500 | (calendar-absolute-from-gregorian | ||
| 501 | (calendar-cursor-to-date t))))) | ||
| 502 | arg))) | ||
| 503 | |||
| 504 | (provide 'cal-bahai) | ||
| 505 | |||
| 506 | ;;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14 | ||
| 507 | ;;; cal-bahai.el ends here | ||
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 3c6cc78eb7b..a652e7ca768 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el | |||
| @@ -66,6 +66,8 @@ | |||
| 66 | '("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry)) | 66 | '("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry)) |
| 67 | (define-key calendar-mode-map [menu-bar diary isl] | 67 | (define-key calendar-mode-map [menu-bar diary isl] |
| 68 | '("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry)) | 68 | '("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry)) |
| 69 | (define-key calendar-mode-map [menu-bar diary baha] | ||
| 70 | '("Insert Baha'i" . calendar-mouse-insert-bahai-diary-entry)) | ||
| 69 | (define-key calendar-mode-map [menu-bar diary cyc] | 71 | (define-key calendar-mode-map [menu-bar diary cyc] |
| 70 | '("Insert Cyclic" . insert-cyclic-diary-entry)) | 72 | '("Insert Cyclic" . insert-cyclic-diary-entry)) |
| 71 | (define-key calendar-mode-map [menu-bar diary blk] | 73 | (define-key calendar-mode-map [menu-bar diary blk] |
| @@ -110,6 +112,8 @@ | |||
| 110 | (define-key calendar-mode-map [menu-bar goto islamic] | 112 | (define-key calendar-mode-map [menu-bar goto islamic] |
| 111 | '("Islamic Date" . calendar-goto-islamic-date)) | 113 | '("Islamic Date" . calendar-goto-islamic-date)) |
| 112 | (define-key calendar-mode-map [menu-bar goto persian] | 114 | (define-key calendar-mode-map [menu-bar goto persian] |
| 115 | '("Baha'i Date" . calendar-goto-bahai-date)) | ||
| 116 | (define-key calendar-mode-map [menu-bar goto persian] | ||
| 113 | '("Persian Date" . calendar-goto-persian-date)) | 117 | '("Persian Date" . calendar-goto-persian-date)) |
| 114 | (define-key calendar-mode-map [menu-bar goto hebrew] | 118 | (define-key calendar-mode-map [menu-bar goto hebrew] |
| 115 | '("Hebrew Date" . calendar-goto-hebrew-date)) | 119 | '("Hebrew Date" . calendar-goto-hebrew-date)) |
| @@ -288,6 +292,19 @@ ERROR is t, otherwise just returns nil." | |||
| 288 | '("Yearly" . insert-yearly-islamic-diary-entry)))))) | 292 | '("Yearly" . insert-yearly-islamic-diary-entry)))))) |
| 289 | (and islamic-selection (call-interactively islamic-selection)))) | 293 | (and islamic-selection (call-interactively islamic-selection)))) |
| 290 | 294 | ||
| 295 | (defun calendar-mouse-insert-bahai-diary-entry (event) | ||
| 296 | "Pop up menu to insert an Baha'i-date diary entry." | ||
| 297 | (interactive "e") | ||
| 298 | (let ((bahai-selection | ||
| 299 | (x-popup-menu | ||
| 300 | event | ||
| 301 | (list "Baha'i insert menu" | ||
| 302 | (list (calendar-bahai-date-string (calendar-cursor-to-date)) | ||
| 303 | '("One time" . insert-bahai-diary-entry) | ||
| 304 | '("Monthly" . insert-monthly-bahai-diary-entry) | ||
| 305 | '("Yearly" . insert-yearly-bahai-diary-entry)))))) | ||
| 306 | (and bahai-selection (call-interactively bahai-selection)))) | ||
| 307 | |||
| 291 | (defun calendar-mouse-sunrise/sunset () | 308 | (defun calendar-mouse-sunrise/sunset () |
| 292 | "Show sunrise/sunset times for mouse-selected date." | 309 | "Show sunrise/sunset times for mouse-selected date." |
| 293 | (interactive) | 310 | (interactive) |
| @@ -496,7 +513,9 @@ The output is in landscape format, one month to a page." | |||
| 496 | (list (format "Hebrew date (before sunset): %s" | 513 | (list (format "Hebrew date (before sunset): %s" |
| 497 | (calendar-hebrew-date-string date))) | 514 | (calendar-hebrew-date-string date))) |
| 498 | (list (format "Persian date: %s" | 515 | (list (format "Persian date: %s" |
| 499 | (calendar-persian-date-string date)))) | 516 | (calendar-persian-date-string date))) |
| 517 | (list (format "Baha'i date (before sunset): %s" | ||
| 518 | (calendar-bahai-date-string date)))) | ||
| 500 | (let ((i (calendar-islamic-date-string date))) | 519 | (let ((i (calendar-islamic-date-string date))) |
| 501 | (if (not (string-equal i "")) | 520 | (if (not (string-equal i "")) |
| 502 | (list (list (format "Islamic date (before sunset): %s" i))))) | 521 | (list (list (format "Islamic date (before sunset): %s" i))))) |
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0d38563e637..43171255bbe 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el | |||
| @@ -26,26 +26,29 @@ | |||
| 26 | 26 | ||
| 27 | ;;; Commentary: | 27 | ;;; Commentary: |
| 28 | 28 | ||
| 29 | ;; This collection of functions implements a calendar window. It generates a | 29 | ;; This collection of functions implements a calendar window. It |
| 30 | ;; calendar for the current month, together with the previous and coming | 30 | ;; generates a calendar for the current month, together with the |
| 31 | ;; months, or for any other three-month period. The calendar can be scrolled | 31 | ;; previous and coming months, or for any other three-month period. |
| 32 | ;; forward and backward in the window to show months in the past or future; | 32 | ;; The calendar can be scrolled forward and backward in the window to |
| 33 | ;; the cursor can move forward and backward by days, weeks, or months, making | 33 | ;; show months in the past or future; the cursor can move forward and |
| 34 | ;; it possible, for instance, to jump to the date a specified number of days, | 34 | ;; backward by days, weeks, or months, making it possible, for |
| 35 | ;; weeks, or months from the date under the cursor. The user can display a | 35 | ;; instance, to jump to the date a specified number of days, weeks, or |
| 36 | ;; list of holidays and other notable days for the period shown; the notable | 36 | ;; months from the date under the cursor. The user can display a list |
| 37 | ;; days can be marked on the calendar, if desired. The user can also specify | 37 | ;; of holidays and other notable days for the period shown; the |
| 38 | ;; that dates having corresponding diary entries (in a file that the user | 38 | ;; notable days can be marked on the calendar, if desired. The user |
| 39 | ;; specifies) be marked; the diary entries for any date can be viewed in a | 39 | ;; can also specify that dates having corresponding diary entries (in |
| 40 | ;; separate window. The diary and the notable days can be viewed | 40 | ;; a file that the user specifies) be marked; the diary entries for |
| 41 | ;; independently of the calendar. Dates can be translated from the (usual) | 41 | ;; any date can be viewed in a separate window. The diary and the |
| 42 | ;; Gregorian calendar to the day of the year/days remaining in year, to the | 42 | ;; notable days can be viewed independently of the calendar. Dates |
| 43 | ;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew | 43 | ;; can be translated from the (usual) Gregorian calendar to the day of |
| 44 | ;; calendar, to the Islamic calendar, to the French Revolutionary calendar, to | 44 | ;; the year/days remaining in year, to the ISO commercial calendar, to |
| 45 | ;; the Mayan calendar, to the Chinese calendar, to the Coptic calendar, to the | 45 | ;; the Julian (old style) calendar, to the Hebrew calendar, to the |
| 46 | ;; Ethiopic calendar, and to the astronomical (Julian) day number. When | 46 | ;; Islamic calendar, to the Baha'i calendar, to the French |
| 47 | ;; floating point is available, times of sunrise/sunset can be displayed, as | 47 | ;; Revolutionary calendar, to the Mayan calendar, to the Chinese |
| 48 | ;; can the phases of the moon. Appointment notification for diary entries is | 48 | ;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to |
| 49 | ;; the astronomical (Julian) day number. When floating point is | ||
| 50 | ;; available, times of sunrise/sunset can be displayed, as can the | ||
| 51 | ;; phases of the moon. Appointment notification for diary entries is | ||
| 49 | ;; available. Calendar printing via LaTeX is available. | 52 | ;; available. Calendar printing via LaTeX is available. |
| 50 | 53 | ||
| 51 | ;; The following files are part of the calendar/diary code: | 54 | ;; The following files are part of the calendar/diary code: |
| @@ -56,6 +59,7 @@ | |||
| 56 | ;; cal-dst.el Daylight savings time rules | 59 | ;; cal-dst.el Daylight savings time rules |
| 57 | ;; cal-hebrew.el Hebrew calendar | 60 | ;; cal-hebrew.el Hebrew calendar |
| 58 | ;; cal-islam.el Islamic calendar | 61 | ;; cal-islam.el Islamic calendar |
| 62 | ;; cal-bahai.el Baha'i calendar | ||
| 59 | ;; cal-iso.el ISO calendar | 63 | ;; cal-iso.el ISO calendar |
| 60 | ;; cal-julian.el Julian/astronomical calendars | 64 | ;; cal-julian.el Julian/astronomical calendars |
| 61 | ;; cal-mayan.el Mayan calendars | 65 | ;; cal-mayan.el Mayan calendars |
| @@ -317,6 +321,16 @@ calendar." | |||
| 317 | :group 'diary) | 321 | :group 'diary) |
| 318 | 322 | ||
| 319 | ;;;###autoload | 323 | ;;;###autoload |
| 324 | (defcustom all-bahai-calendar-holidays nil | ||
| 325 | "*If nil, show only major holidays from the Baha'i calendar. | ||
| 326 | These are the days on which work and school must be suspended. | ||
| 327 | |||
| 328 | If t, show all the holidays that would appear in a complete Baha'i | ||
| 329 | calendar." | ||
| 330 | :type 'boolean | ||
| 331 | :group 'holidays) | ||
| 332 | |||
| 333 | ;;;###autoload | ||
| 320 | (defcustom calendar-load-hook nil | 334 | (defcustom calendar-load-hook nil |
| 321 | "*List of functions to be called after the calendar is first loaded. | 335 | "*List of functions to be called after the calendar is first loaded. |
| 322 | This is the place to add key bindings to `calendar-mode-map'." | 336 | This is the place to add key bindings to `calendar-mode-map'." |
| @@ -463,21 +477,23 @@ Diary entries can be based on Lisp sexps. For example, the diary entry | |||
| 463 | 477 | ||
| 464 | %%(diary-block 11 1 1990 11 10 1990) Vacation | 478 | %%(diary-block 11 1 1990 11 10 1990) Vacation |
| 465 | 479 | ||
| 466 | causes the diary entry \"Vacation\" to appear from November 1 through November | 480 | causes the diary entry \"Vacation\" to appear from November 1 through |
| 467 | 10, 1990. Other functions available are `diary-float', `diary-anniversary', | 481 | November 10, 1990. Other functions available are `diary-float', |
| 468 | `diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', | 482 | `diary-anniversary', `diary-cyclic', `diary-day-of-year', |
| 469 | `diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', | 483 | `diary-iso-date', `diary-french-date', `diary-hebrew-date', |
| 484 | `diary-islamic-date', `diary-bahai-date', `diary-mayan-date', | ||
| 470 | `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', | 485 | `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date', |
| 471 | `diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset', | 486 | `diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset', |
| 472 | `diary-phases-of-moon', `diary-parasha', `diary-omer', `diary-rosh-hodesh', | 487 | `diary-phases-of-moon', `diary-parasha', `diary-omer', |
| 473 | and `diary-sabbath-candles'. See the documentation for the function | 488 | `diary-rosh-hodesh', and `diary-sabbath-candles'. See the |
| 474 | `list-sexp-diary-entries' for more details. | 489 | documentation for the function `list-sexp-diary-entries' for more |
| 490 | details. | ||
| 475 | 491 | ||
| 476 | Diary entries based on the Hebrew and/or the Islamic calendar are also | 492 | Diary entries based on the Hebrew, the Islamic and/or the Baha'i |
| 477 | possible, but because these are somewhat slow, they are ignored | 493 | calendar are also possible, but because these are somewhat slow, they |
| 478 | unless you set the `nongregorian-diary-listing-hook' and the | 494 | are ignored unless you set the `nongregorian-diary-listing-hook' and |
| 479 | `nongregorian-diary-marking-hook' appropriately. See the documentation | 495 | the `nongregorian-diary-marking-hook' appropriately. See the |
| 480 | for these functions for details. | 496 | documentation for these functions for details. |
| 481 | 497 | ||
| 482 | Diary files can contain directives to include the contents of other files; for | 498 | Diary files can contain directives to include the contents of other files; for |
| 483 | details, see the documentation for the variable `list-diary-entries-hook'." | 499 | details, see the documentation for the variable `list-diary-entries-hook'." |
| @@ -503,6 +519,12 @@ details, see the documentation for the variable `list-diary-entries-hook'." | |||
| 503 | :group 'diary) | 519 | :group 'diary) |
| 504 | 520 | ||
| 505 | ;;;###autoload | 521 | ;;;###autoload |
| 522 | (defcustom bahai-diary-entry-symbol "B" | ||
| 523 | "*Symbol indicating a diary entry according to the Baha'i calendar." | ||
| 524 | :type 'string | ||
| 525 | :group 'diary) | ||
| 526 | |||
| 527 | ;;;###autoload | ||
| 506 | (defcustom diary-include-string "#include" | 528 | (defcustom diary-include-string "#include" |
| 507 | "*The string indicating inclusion of another file of diary entries. | 529 | "*The string indicating inclusion of another file of diary entries. |
| 508 | See the documentation for the function `include-other-diary-files'." | 530 | See the documentation for the function `include-other-diary-files'." |
| @@ -554,8 +576,9 @@ See the documentation for the function `list-sexp-diary-entries'." | |||
| 554 | ;;;###autoload | 576 | ;;;###autoload |
| 555 | (defcustom abbreviated-calendar-year t | 577 | (defcustom abbreviated-calendar-year t |
| 556 | "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. | 578 | "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. |
| 557 | For the Gregorian calendar; similarly for the Hebrew and Islamic calendars. | 579 | For the Gregorian calendar; similarly for the Hebrew, Islamic and |
| 558 | If this variable is nil, years must be written in full." | 580 | Baha'i calendars. If this variable is nil, years must be written in |
| 581 | full." | ||
| 559 | :type 'boolean | 582 | :type 'boolean |
| 560 | :group 'diary) | 583 | :group 'diary) |
| 561 | 584 | ||
| @@ -796,12 +819,15 @@ diary buffer, set the variable `diary-list-include-blanks' to t." | |||
| 796 | ;;;###autoload | 819 | ;;;###autoload |
| 797 | (defcustom nongregorian-diary-listing-hook nil | 820 | (defcustom nongregorian-diary-listing-hook nil |
| 798 | "*List of functions called for listing diary file and included files. | 821 | "*List of functions called for listing diary file and included files. |
| 799 | As the files are processed for diary entries, these functions are used to cull | 822 | As the files are processed for diary entries, these functions are used |
| 800 | relevant entries. You can use either or both of `list-hebrew-diary-entries' | 823 | to cull relevant entries. You can use either or both of |
| 801 | and `list-islamic-diary-entries'. The documentation for these functions | 824 | `list-hebrew-diary-entries', `list-islamic-diary-entries' and |
| 825 | `list-bahai-diary-entries'. The documentation for these functions | ||
| 802 | describes the style of such diary entries." | 826 | describes the style of such diary entries." |
| 803 | :type 'hook | 827 | :type 'hook |
| 804 | :options '(list-hebrew-diary-entries list-islamic-diary-entries) | 828 | :options '(list-hebrew-diary-entries |
| 829 | list-islamic-diary-entries | ||
| 830 | list-bahai-diary-entries) | ||
| 805 | :group 'diary) | 831 | :group 'diary) |
| 806 | 832 | ||
| 807 | ;;;###autoload | 833 | ;;;###autoload |
| @@ -825,12 +851,15 @@ function `include-other-diary-files' as part of `list-diary-entries-hook'." | |||
| 825 | ;;;###autoload | 851 | ;;;###autoload |
| 826 | (defcustom nongregorian-diary-marking-hook nil | 852 | (defcustom nongregorian-diary-marking-hook nil |
| 827 | "*List of functions called for marking diary file and included files. | 853 | "*List of functions called for marking diary file and included files. |
| 828 | As the files are processed for diary entries, these functions are used to cull | 854 | As the files are processed for diary entries, these functions are used |
| 829 | relevant entries. You can use either or both of `mark-hebrew-diary-entries' | 855 | to cull relevant entries. You can use either or both of |
| 830 | and `mark-islamic-diary-entries'. The documentation for these functions | 856 | `mark-hebrew-diary-entries', `mark-islamic-diary-entries' and |
| 857 | `mark-bahai-diary-entries'. The documentation for these functions | ||
| 831 | describes the style of such diary entries." | 858 | describes the style of such diary entries." |
| 832 | :type 'hook | 859 | :type 'hook |
| 833 | :options '(mark-hebrew-diary-entries mark-islamic-diary-entries) | 860 | :options '(mark-hebrew-diary-entries |
| 861 | mark-islamic-diary-entries | ||
| 862 | mark-bahai-diary-entries) | ||
| 834 | :group 'diary) | 863 | :group 'diary) |
| 835 | 864 | ||
| 836 | ;;;###autoload | 865 | ;;;###autoload |
| @@ -1068,6 +1097,48 @@ See the documentation for `calendar-holidays' for details." | |||
| 1068 | :group 'holidays) | 1097 | :group 'holidays) |
| 1069 | 1098 | ||
| 1070 | ;;;###autoload | 1099 | ;;;###autoload |
| 1100 | (put 'bahai-holidays 'risky-local-variable t) | ||
| 1101 | ;;;###autoload | ||
| 1102 | (defcustom bahai-holidays | ||
| 1103 | '((holiday-fixed | ||
| 1104 | 3 21 | ||
| 1105 | (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844)))) | ||
| 1106 | (holiday-fixed 4 21 "First Day of Ridvan") | ||
| 1107 | (if all-bahai-calendar-holidays | ||
| 1108 | (holiday-fixed 4 22 "Second Day of Ridvan")) | ||
| 1109 | (if all-bahai-calendar-holidays | ||
| 1110 | (holiday-fixed 4 23 "Third Day of Ridvan")) | ||
| 1111 | (if all-bahai-calendar-holidays | ||
| 1112 | (holiday-fixed 4 24 "Fourth Day of Ridvan")) | ||
| 1113 | (if all-bahai-calendar-holidays | ||
| 1114 | (holiday-fixed 4 25 "Fifth Day of Ridvan")) | ||
| 1115 | (if all-bahai-calendar-holidays | ||
| 1116 | (holiday-fixed 4 26 "Sixth Day of Ridvan")) | ||
| 1117 | (if all-bahai-calendar-holidays | ||
| 1118 | (holiday-fixed 4 27 "Seventh Day of Ridvan")) | ||
| 1119 | (if all-bahai-calendar-holidays | ||
| 1120 | (holiday-fixed 4 28 "Eighth Day of Ridvan")) | ||
| 1121 | (holiday-fixed 4 29 "Ninth Day of Ridvan") | ||
| 1122 | (if all-bahai-calendar-holidays | ||
| 1123 | (holiday-fixed 4 30 "Tenth Day of Ridvan")) | ||
| 1124 | (if all-bahai-calendar-holidays | ||
| 1125 | (holiday-fixed 5 1 "Eleventh Day of Ridvan")) | ||
| 1126 | (holiday-fixed 5 2 "Twelfth Day of Ridvan") | ||
| 1127 | (holiday-fixed 5 23 "Declaration of the Bab") | ||
| 1128 | (holiday-fixed 5 29 "Ascension of Baha'u'llah") | ||
| 1129 | (holiday-fixed 7 9 "Martyrdom of the Bab") | ||
| 1130 | (holiday-fixed 10 20 "Birth of the Bab") | ||
| 1131 | (holiday-fixed 11 12 "Birth of Baha'u'llah") | ||
| 1132 | (if all-bahai-calendar-holidays | ||
| 1133 | (holiday-fixed 11 26 "Day of the Covenant")) | ||
| 1134 | (if all-bahai-calendar-holidays | ||
| 1135 | (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))) | ||
| 1136 | "*Baha'i holidays. | ||
| 1137 | See the documentation for `calendar-holidays' for details." | ||
| 1138 | :type 'sexp | ||
| 1139 | :group 'holidays) | ||
| 1140 | |||
| 1141 | ;;;###autoload | ||
| 1071 | (put 'solar-holidays 'risky-local-variable t) | 1142 | (put 'solar-holidays 'risky-local-variable t) |
| 1072 | ;;;###autoload | 1143 | ;;;###autoload |
| 1073 | (defcustom solar-holidays | 1144 | (defcustom solar-holidays |
| @@ -1104,15 +1175,16 @@ See the documentation for `calendar-holidays' for details." | |||
| 1104 | (defcustom calendar-holidays | 1175 | (defcustom calendar-holidays |
| 1105 | (append general-holidays local-holidays other-holidays | 1176 | (append general-holidays local-holidays other-holidays |
| 1106 | christian-holidays hebrew-holidays islamic-holidays | 1177 | christian-holidays hebrew-holidays islamic-holidays |
| 1107 | oriental-holidays solar-holidays) | 1178 | bahai-holidays oriental-holidays solar-holidays) |
| 1108 | "*List of notable days for the command \\[holidays]. | 1179 | "*List of notable days for the command \\[holidays]. |
| 1109 | 1180 | ||
| 1110 | Additional holidays are easy to add to the list, just put them in the list | 1181 | Additional holidays are easy to add to the list, just put them in the |
| 1111 | `other-holidays' in your .emacs file. Similarly, by setting any of | 1182 | list `other-holidays' in your .emacs file. Similarly, by setting any |
| 1112 | `general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays', | 1183 | of `general-holidays', `local-holidays' `christian-holidays', |
| 1113 | `islamic-holidays', `oriental-holidays', or `solar-holidays' to nil in your | 1184 | `hebrew-holidays', `islamic-holidays', `bahai-holidays', |
| 1114 | .emacs file, you can eliminate unwanted categories of holidays. The intention | 1185 | `oriental-holidays', or `solar-holidays' to nil in your .emacs file, |
| 1115 | is that (in the US) `local-holidays' be set in site-init.el and | 1186 | you can eliminate unwanted categories of holidays. The intention is |
| 1187 | that (in the US) `local-holidays' be set in site-init.el and | ||
| 1116 | `other-holidays' be set by the user. | 1188 | `other-holidays' be set by the user. |
| 1117 | 1189 | ||
| 1118 | Entries on the list are expressions that return (possibly empty) lists of | 1190 | Entries on the list are expressions that return (possibly empty) lists of |
| @@ -1128,6 +1200,7 @@ Several basic functions are provided for this purpose: | |||
| 1128 | DAYNAME after/before MONTH DAY. | 1200 | DAYNAME after/before MONTH DAY. |
| 1129 | (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar | 1201 | (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar |
| 1130 | (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar | 1202 | (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar |
| 1203 | (holiday-bahai MONTH DAY STRING) a fixed date on the Baha'i calendar | ||
| 1131 | (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar | 1204 | (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar |
| 1132 | (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression | 1205 | (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression |
| 1133 | in the variable `year'; if it evaluates to | 1206 | in the variable `year'; if it evaluates to |
| @@ -1155,6 +1228,11 @@ add the Islamic feast celebrating Mohammed's birthday use | |||
| 1155 | (holiday-islamic 3 12 \"Mohammed's Birthday\") | 1228 | (holiday-islamic 3 12 \"Mohammed's Birthday\") |
| 1156 | 1229 | ||
| 1157 | since the Islamic months are numbered from 1 starting with Muharram. To | 1230 | since the Islamic months are numbered from 1 starting with Muharram. To |
| 1231 | add an entry for the Baha'i festival of Ridvan, use | ||
| 1232 | |||
| 1233 | (holiday-bahai 2 13 \"Festival of Ridvan\") | ||
| 1234 | |||
| 1235 | since the Baha'i months are numbered from 1 starting with Baha. To | ||
| 1158 | add Thomas Jefferson's birthday, April 2, 1743 (Julian), use | 1236 | add Thomas Jefferson's birthday, April 2, 1743 (Julian), use |
| 1159 | 1237 | ||
| 1160 | (holiday-julian 4 2 \"Jefferson's Birthday\") | 1238 | (holiday-julian 4 2 \"Jefferson's Birthday\") |
| @@ -1680,6 +1758,14 @@ Driven by the variable `calendar-date-display-form'.") | |||
| 1680 | "String of Islamic date of Gregorian date." | 1758 | "String of Islamic date of Gregorian date." |
| 1681 | t) | 1759 | t) |
| 1682 | 1760 | ||
| 1761 | (autoload 'calendar-print-bahai-date "cal-bahai" | ||
| 1762 | "Show the Baha'i date equivalents of date." | ||
| 1763 | t) | ||
| 1764 | |||
| 1765 | (autoload 'calendar-bahai-date-string "cal-bahai" | ||
| 1766 | "String of Baha'i date of Gregorian date." | ||
| 1767 | t) | ||
| 1768 | |||
| 1683 | (autoload 'calendar-goto-hebrew-date "cal-hebrew" | 1769 | (autoload 'calendar-goto-hebrew-date "cal-hebrew" |
| 1684 | "Move cursor to Hebrew date date." | 1770 | "Move cursor to Hebrew date date." |
| 1685 | t) | 1771 | t) |
| @@ -1803,6 +1889,21 @@ to the date indicated by point." | |||
| 1803 | to the date indicated by point." | 1889 | to the date indicated by point." |
| 1804 | t) | 1890 | t) |
| 1805 | 1891 | ||
| 1892 | (autoload 'insert-bahai-diary-entry "cal-bahai" | ||
| 1893 | "Insert a diary entry for the Baha'i date corresponding to the date | ||
| 1894 | indicated by point." | ||
| 1895 | t) | ||
| 1896 | |||
| 1897 | (autoload 'insert-monthly-bahai-diary-entry "cal-bahai" | ||
| 1898 | "Insert a monthly diary entry for the day of the Baha'i month corresponding | ||
| 1899 | to the date indicated by point." | ||
| 1900 | t) | ||
| 1901 | |||
| 1902 | (autoload 'insert-yearly-bahai-diary-entry "cal-bahai" | ||
| 1903 | "Insert an annual diary entry for the day of the Baha'i year corresponding | ||
| 1904 | to the date indicated by point." | ||
| 1905 | t) | ||
| 1906 | |||
| 1806 | (autoload 'list-calendar-holidays "holidays" | 1907 | (autoload 'list-calendar-holidays "holidays" |
| 1807 | "Create a buffer containing the holidays for the current calendar window. | 1908 | "Create a buffer containing the holidays for the current calendar window. |
| 1808 | The holidays are those in the list `calendar-notable-days'. Returns t if any | 1909 | The holidays are those in the list `calendar-notable-days'. Returns t if any |
| @@ -2066,6 +2167,7 @@ the inserted text. Value is always t." | |||
| 2066 | (define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number) | 2167 | (define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number) |
| 2067 | (define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date) | 2168 | (define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date) |
| 2068 | (define-key calendar-mode-map "gi" 'calendar-goto-islamic-date) | 2169 | (define-key calendar-mode-map "gi" 'calendar-goto-islamic-date) |
| 2170 | (define-key calendar-mode-map "gb" 'calendar-goto-bahai-date) | ||
| 2069 | (define-key calendar-mode-map "gC" 'calendar-goto-chinese-date) | 2171 | (define-key calendar-mode-map "gC" 'calendar-goto-chinese-date) |
| 2070 | (define-key calendar-mode-map "gk" 'calendar-goto-coptic-date) | 2172 | (define-key calendar-mode-map "gk" 'calendar-goto-coptic-date) |
| 2071 | (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date) | 2173 | (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date) |
| @@ -2106,6 +2208,7 @@ the inserted text. Value is always t." | |||
| 2106 | (define-key calendar-mode-map "pa" 'calendar-print-astro-day-number) | 2208 | (define-key calendar-mode-map "pa" 'calendar-print-astro-day-number) |
| 2107 | (define-key calendar-mode-map "ph" 'calendar-print-hebrew-date) | 2209 | (define-key calendar-mode-map "ph" 'calendar-print-hebrew-date) |
| 2108 | (define-key calendar-mode-map "pi" 'calendar-print-islamic-date) | 2210 | (define-key calendar-mode-map "pi" 'calendar-print-islamic-date) |
| 2211 | (define-key calendar-mode-map "pb" 'calendar-print-bahai-date) | ||
| 2109 | (define-key calendar-mode-map "pf" 'calendar-print-french-date) | 2212 | (define-key calendar-mode-map "pf" 'calendar-print-french-date) |
| 2110 | (define-key calendar-mode-map "pm" 'calendar-print-mayan-date) | 2213 | (define-key calendar-mode-map "pm" 'calendar-print-mayan-date) |
| 2111 | (define-key calendar-mode-map "po" 'calendar-print-other-dates) | 2214 | (define-key calendar-mode-map "po" 'calendar-print-other-dates) |
| @@ -2122,6 +2225,9 @@ the inserted text. Value is always t." | |||
| 2122 | (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry) | 2225 | (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry) |
| 2123 | (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry) | 2226 | (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry) |
| 2124 | (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry) | 2227 | (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry) |
| 2228 | (define-key calendar-mode-map "iBd" 'insert-bahai-diary-entry) | ||
| 2229 | (define-key calendar-mode-map "iBm" 'insert-monthly-bahai-diary-entry) | ||
| 2230 | (define-key calendar-mode-map "iBy" 'insert-yearly-bahai-diary-entry) | ||
| 2125 | (define-key calendar-mode-map "?" 'calendar-goto-info-node) | 2231 | (define-key calendar-mode-map "?" 'calendar-goto-info-node) |
| 2126 | (define-key calendar-mode-map "tm" 'cal-tex-cursor-month) | 2232 | (define-key calendar-mode-map "tm" 'cal-tex-cursor-month) |
| 2127 | (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape) | 2233 | (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape) |
| @@ -2907,6 +3013,9 @@ Defaults to today's date if DATE is not given." | |||
| 2907 | (let ((i (calendar-islamic-date-string date))) | 3013 | (let ((i (calendar-islamic-date-string date))) |
| 2908 | (if (not (string-equal i "")) | 3014 | (if (not (string-equal i "")) |
| 2909 | (format "Islamic date (before sunset): %s" i))) | 3015 | (format "Islamic date (before sunset): %s" i))) |
| 3016 | (let ((b (calendar-bahai-date-string date))) | ||
| 3017 | (if (not (string-equal b "")) | ||
| 3018 | (format "Baha'i date (before sunset): %s" b))) | ||
| 2910 | (format "Chinese date: %s" | 3019 | (format "Chinese date: %s" |
| 2911 | (calendar-chinese-date-string date)) | 3020 | (calendar-chinese-date-string date)) |
| 2912 | (let ((c (calendar-coptic-date-string date))) | 3021 | (let ((c (calendar-coptic-date-string date))) |
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index b8a1d958e0d..45bb3c0e4c0 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el | |||
| @@ -123,6 +123,22 @@ The holidays are those in the list `calendar-holidays'.") | |||
| 123 | (autoload 'mark-islamic-calendar-date-pattern "cal-islam" | 123 | (autoload 'mark-islamic-calendar-date-pattern "cal-islam" |
| 124 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") | 124 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") |
| 125 | 125 | ||
| 126 | (autoload 'diary-bahai-date "cal-bahai" | ||
| 127 | "Baha'i calendar equivalent of date diary entry." | ||
| 128 | t) | ||
| 129 | |||
| 130 | (autoload 'list-bahai-diary-entries "cal-bahai" | ||
| 131 | "Add any Baha'i date entries from the diary file to `diary-entries-list'." | ||
| 132 | t) | ||
| 133 | |||
| 134 | (autoload 'mark-bahai-diary-entries "cal-bahai" | ||
| 135 | "Mark days in the calendar window that have Baha'i date diary entries." | ||
| 136 | t) | ||
| 137 | |||
| 138 | (autoload 'mark-bahai-calendar-date-pattern "cal-bahai" | ||
| 139 | "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR." | ||
| 140 | t) | ||
| 141 | |||
| 126 | (autoload 'diary-hebrew-date "cal-hebrew" | 142 | (autoload 'diary-hebrew-date "cal-hebrew" |
| 127 | "Hebrew calendar equivalent of date diary entry.") | 143 | "Hebrew calendar equivalent of date diary entry.") |
| 128 | 144 | ||
| @@ -1129,6 +1145,8 @@ be used instead of a colon (:) to separate the hour and minute parts." | |||
| 1129 | 0 1200))) | 1145 | 0 1200))) |
| 1130 | (t diary-unknown-time)))) ; Unrecognizable | 1146 | (t diary-unknown-time)))) ; Unrecognizable |
| 1131 | 1147 | ||
| 1148 | ;; Unrecognizable | ||
| 1149 | |||
| 1132 | (defun list-sexp-diary-entries (date) | 1150 | (defun list-sexp-diary-entries (date) |
| 1133 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. | 1151 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. |
| 1134 | Also, Make them visible in the diary file. Returns t if any entries were | 1152 | Also, Make them visible in the diary file. Returns t if any entries were |
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index b262ac50a38..71f73f24b75 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el | |||
| @@ -84,6 +84,10 @@ | |||
| 84 | "Holiday on MONTH, DAY (Islamic) called STRING." | 84 | "Holiday on MONTH, DAY (Islamic) called STRING." |
| 85 | t) | 85 | t) |
| 86 | 86 | ||
| 87 | (autoload 'holiday-bahai "cal-bahai" | ||
| 88 | "Holiday on MONTH, DAY (Baha'i) called STRING." | ||
| 89 | t) | ||
| 90 | |||
| 87 | (autoload 'holiday-chinese-new-year "cal-china" | 91 | (autoload 'holiday-chinese-new-year "cal-china" |
| 88 | "Date of Chinese New Year." | 92 | "Date of Chinese New Year." |
| 89 | t) | 93 | t) |
| @@ -141,6 +145,7 @@ The optional LABEL is used to label the buffer created." | |||
| 141 | (if christian-holidays (cons "Christian" christian-holidays)) | 145 | (if christian-holidays (cons "Christian" christian-holidays)) |
| 142 | (if hebrew-holidays (cons "Hebrew" hebrew-holidays)) | 146 | (if hebrew-holidays (cons "Hebrew" hebrew-holidays)) |
| 143 | (if islamic-holidays (cons "Islamic" islamic-holidays)) | 147 | (if islamic-holidays (cons "Islamic" islamic-holidays)) |
| 148 | (if bahai-holidays (cons "Baha'i" bahai-holidays)) | ||
| 144 | (if oriental-holidays (cons "Oriental" oriental-holidays)) | 149 | (if oriental-holidays (cons "Oriental" oriental-holidays)) |
| 145 | (if solar-holidays (cons "Solar" solar-holidays)) | 150 | (if solar-holidays (cons "Solar" solar-holidays)) |
| 146 | (cons "Ask" nil))) | 151 | (cons "Ask" nil))) |
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 24447c3e66d..c84962e66b0 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el | |||
| @@ -122,10 +122,6 @@ This option slows down recursive glob processing by quite a bit." | |||
| 122 | :type '(repeat (cons character (choice regexp function))) | 122 | :type '(repeat (cons character (choice regexp function))) |
| 123 | :group 'eshell-glob) | 123 | :group 'eshell-glob) |
| 124 | 124 | ||
| 125 | ;;; Internal Variables: | ||
| 126 | |||
| 127 | (defvar eshell-glob-chars-regexp nil) | ||
| 128 | |||
| 129 | ;;; Functions: | 125 | ;;; Functions: |
| 130 | 126 | ||
| 131 | (defun eshell-glob-initialize () | 127 | (defun eshell-glob-initialize () |
| @@ -134,8 +130,6 @@ This option slows down recursive glob processing by quite a bit." | |||
| 134 | (when (boundp 'eshell-special-chars-outside-quoting) | 130 | (when (boundp 'eshell-special-chars-outside-quoting) |
| 135 | (set (make-local-variable 'eshell-special-chars-outside-quoting) | 131 | (set (make-local-variable 'eshell-special-chars-outside-quoting) |
| 136 | (append eshell-glob-chars-list eshell-special-chars-outside-quoting))) | 132 | (append eshell-glob-chars-list eshell-special-chars-outside-quoting))) |
| 137 | (set (make-local-variable 'eshell-glob-chars-regexp) | ||
| 138 | (format "[%s]+" (apply 'string eshell-glob-chars-list))) | ||
| 139 | (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t) | 133 | (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t) |
| 140 | (add-hook 'eshell-pre-rewrite-command-hook | 134 | (add-hook 'eshell-pre-rewrite-command-hook |
| 141 | 'eshell-no-command-globbing nil t)) | 135 | 'eshell-no-command-globbing nil t)) |
| @@ -184,6 +178,8 @@ interpretation." | |||
| 184 | (buffer-substring-no-properties (1- (point)) (1+ end)) | 178 | (buffer-substring-no-properties (1- (point)) (1+ end)) |
| 185 | (goto-char (1+ end)))))))))) | 179 | (goto-char (1+ end)))))))))) |
| 186 | 180 | ||
| 181 | (defvar eshell-glob-chars-regexp nil) | ||
| 182 | |||
| 187 | (defun eshell-glob-regexp (pattern) | 183 | (defun eshell-glob-regexp (pattern) |
| 188 | "Convert glob-pattern PATTERN to a regular expression. | 184 | "Convert glob-pattern PATTERN to a regular expression. |
| 189 | The basic syntax is: | 185 | The basic syntax is: |
| @@ -204,8 +200,11 @@ set to true, then these characters will match themselves in the | |||
| 204 | resulting regular expression." | 200 | resulting regular expression." |
| 205 | (let ((matched-in-pattern 0) ; How much of PATTERN handled | 201 | (let ((matched-in-pattern 0) ; How much of PATTERN handled |
| 206 | regexp) | 202 | regexp) |
| 207 | (while (string-match eshell-glob-chars-regexp | 203 | (while (string-match |
| 208 | pattern matched-in-pattern) | 204 | (or eshell-glob-chars-regexp |
| 205 | (set (make-local-variable 'eshell-glob-chars-regexp) | ||
| 206 | (format "[%s]+" (apply 'string eshell-glob-chars-list)))) | ||
| 207 | pattern matched-in-pattern) | ||
| 209 | (let* ((op-begin (match-beginning 0)) | 208 | (let* ((op-begin (match-beginning 0)) |
| 210 | (op-char (aref pattern op-begin))) | 209 | (op-char (aref pattern op-begin))) |
| 211 | (setq regexp | 210 | (setq regexp |
diff --git a/lisp/international/subst-big5.el b/lisp/international/subst-big5.el index 4f3bbdd6d67..f2004b07544 100644 --- a/lisp/international/subst-big5.el +++ b/lisp/international/subst-big5.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; subst-big5.el --- Unicode/GB2312 translation -*-coding: big5;-*- | 1 | ;;; subst-big5.el --- Unicode/GB2312 translation -*-coding: big5;-*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Dave Love <fx@gnu.org> | 5 | ;; Author: Dave Love <fx@gnu.org> |
| 6 | ;; Keywords: i18n | 6 | ;; Keywords: i18n |
| @@ -23,7 +23,7 @@ | |||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; Provides translation tables between Unicode and chinese-big5 for | 25 | ;; Provides translation tables between Unicode and chinese-big5 for |
| 26 | ;; use by the `utf-translate-cjk' option. See subst-jis.el for the | 26 | ;; use by the `utf-translate-cjk-mode' option. See subst-jis.el for the |
| 27 | ;; method used. | 27 | ;; method used. |
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
diff --git a/lisp/international/subst-gb2312.el b/lisp/international/subst-gb2312.el index 2b02af1f86c..dba26c9bd5c 100644 --- a/lisp/international/subst-gb2312.el +++ b/lisp/international/subst-gb2312.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; subst-gb2312.el --- Unicode/GB2312 translation -*-coding: euc-china;-*- | 1 | ;;; subst-gb2312.el --- Unicode/GB2312 translation -*-coding: euc-china;-*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Dave Love <fx@gnu.org> | 5 | ;; Author: Dave Love <fx@gnu.org> |
| 6 | ;; Keywords: i18n | 6 | ;; Keywords: i18n |
| @@ -23,7 +23,7 @@ | |||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; Provides translation tables between Unicode and chinese-gb2312 for | 25 | ;; Provides translation tables between Unicode and chinese-gb2312 for |
| 26 | ;; use by the `utf-translate-cjk' option. See subst-jis.el for the | 26 | ;; use by the `utf-translate-cjk-mode' option. See subst-jis.el for the |
| 27 | ;; method used. | 27 | ;; method used. |
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
diff --git a/lisp/international/subst-jis.el b/lisp/international/subst-jis.el index 7e1c0bd5df8..edd01c0a0b3 100644 --- a/lisp/international/subst-jis.el +++ b/lisp/international/subst-jis.el | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; subst-jis.el --- Unicode/JISX translation -*-coding: euc-jp;-*- | 1 | ;;; subst-jis.el --- Unicode/JISX translation -*-coding: euc-jp;-*- |
| 2 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 2 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. |
| 3 | 3 | ||
| 4 | ;; Author: Dave Love <fx@gnu.org> | 4 | ;; Author: Dave Love <fx@gnu.org> |
| 5 | ;; Keywords: i18n | 5 | ;; Keywords: i18n |
| @@ -23,7 +23,7 @@ | |||
| 23 | 23 | ||
| 24 | ;; Provides translation tables between Unicode and | 24 | ;; Provides translation tables between Unicode and |
| 25 | ;; japanese-jisx0208/japanese-jisx0212 charsets for use by the | 25 | ;; japanese-jisx0208/japanese-jisx0212 charsets for use by the |
| 26 | ;; `utf-translate-cjk' option. | 26 | ;; `utf-translate-cjk-mode' option. |
| 27 | 27 | ||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
diff --git a/lisp/international/subst-ksc.el b/lisp/international/subst-ksc.el index b5641e360f1..9f4b329b675 100644 --- a/lisp/international/subst-ksc.el +++ b/lisp/international/subst-ksc.el | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; subst-ksc.el --- Unicode/KSC-5601 translation -*-coding: euc-kr;-*- | 1 | ;;; subst-ksc.el --- Unicode/KSC-5601 translation -*-coding: euc-kr;-*- |
| 2 | ;; Copyright (C) 2002 Free Software Foundation, Inc. | 2 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. |
| 3 | 3 | ||
| 4 | ;; Author: Dave Love <fx@gnu.org> | 4 | ;; Author: Dave Love <fx@gnu.org> |
| 5 | ;; Keywords: i18n | 5 | ;; Keywords: i18n |
| @@ -22,7 +22,7 @@ | |||
| 22 | ;;; Commentary: | 22 | ;;; Commentary: |
| 23 | 23 | ||
| 24 | ;; Provides translation tables between Unicode and korean-ksc5601 for | 24 | ;; Provides translation tables between Unicode and korean-ksc5601 for |
| 25 | ;; use by the `utf-translate-cjk' option. See subst-jis.el for the | 25 | ;; use by the `utf-translate-cjk-mode' option. See subst-jis.el for the |
| 26 | ;; method used. | 26 | ;; method used. |
| 27 | 27 | ||
| 28 | ;;; Code: | 28 | ;;; Code: |
diff --git a/lisp/international/utf-16.el b/lisp/international/utf-16.el index 0d58bf14716..d924512b634 100644 --- a/lisp/international/utf-16.el +++ b/lisp/international/utf-16.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; utf-16.el --- UTF-16 encoding/decoding | 1 | ;;; utf-16.el --- UTF-16 encoding/decoding |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Dave Love <fx@gnu.org> | 5 | ;; Author: Dave Love <fx@gnu.org> |
| 6 | ;; Keywords: Unicode, UTF-16, i18n | 6 | ;; Keywords: Unicode, UTF-16, i18n |
| @@ -351,7 +351,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER).")) | |||
| 351 | (dependency unify-8859-on-encoding-mode | 351 | (dependency unify-8859-on-encoding-mode |
| 352 | unify-8859-on-decoding-mode | 352 | unify-8859-on-decoding-mode |
| 353 | utf-fragment-on-decoding | 353 | utf-fragment-on-decoding |
| 354 | utf-translate-cjk))) | 354 | utf-translate-cjk-mode))) |
| 355 | 355 | ||
| 356 | (make-coding-system | 356 | (make-coding-system |
| 357 | 'mule-utf-16be 4 ?u | 357 | 'mule-utf-16be 4 ?u |
| @@ -372,7 +372,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER).")) | |||
| 372 | (dependency unify-8859-on-encoding-mode | 372 | (dependency unify-8859-on-encoding-mode |
| 373 | unify-8859-on-decoding-mode | 373 | unify-8859-on-decoding-mode |
| 374 | utf-fragment-on-decoding | 374 | utf-fragment-on-decoding |
| 375 | utf-translate-cjk))) | 375 | utf-translate-cjk-mode))) |
| 376 | 376 | ||
| 377 | (make-coding-system | 377 | (make-coding-system |
| 378 | 'mule-utf-16le-with-signature 4 ?u | 378 | 'mule-utf-16le-with-signature 4 ?u |
| @@ -396,7 +396,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER).")) | |||
| 396 | (dependency unify-8859-on-encoding-mode | 396 | (dependency unify-8859-on-encoding-mode |
| 397 | unify-8859-on-decoding-mode | 397 | unify-8859-on-decoding-mode |
| 398 | utf-fragment-on-decoding | 398 | utf-fragment-on-decoding |
| 399 | utf-translate-cjk))) | 399 | utf-translate-cjk-mode))) |
| 400 | 400 | ||
| 401 | (make-coding-system | 401 | (make-coding-system |
| 402 | 'mule-utf-16be-with-signature 4 ?u | 402 | 'mule-utf-16be-with-signature 4 ?u |
| @@ -419,7 +419,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER).")) | |||
| 419 | (dependency unify-8859-on-encoding-mode | 419 | (dependency unify-8859-on-encoding-mode |
| 420 | unify-8859-on-decoding-mode | 420 | unify-8859-on-decoding-mode |
| 421 | utf-fragment-on-decoding | 421 | utf-fragment-on-decoding |
| 422 | utf-translate-cjk))) | 422 | utf-translate-cjk-mode))) |
| 423 | 423 | ||
| 424 | (make-coding-system | 424 | (make-coding-system |
| 425 | 'mule-utf-16 4 ?u | 425 | 'mule-utf-16 4 ?u |
| @@ -442,7 +442,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER).")) | |||
| 442 | (dependency unify-8859-on-encoding-mode | 442 | (dependency unify-8859-on-encoding-mode |
| 443 | unify-8859-on-decoding-mode | 443 | unify-8859-on-decoding-mode |
| 444 | utf-fragment-on-decoding | 444 | utf-fragment-on-decoding |
| 445 | utf-translate-cjk) | 445 | utf-translate-cjk-mode) |
| 446 | (post-read-conversion . mule-utf-16-post-read-conversion))) | 446 | (post-read-conversion . mule-utf-16-post-read-conversion))) |
| 447 | ) | 447 | ) |
| 448 | 448 | ||
diff --git a/lisp/international/utf-8.el b/lisp/international/utf-8.el index c2227005dd4..d4dd7b6c882 100644 --- a/lisp/international/utf-8.el +++ b/lisp/international/utf-8.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*- | 1 | ;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001 Electrotechnical Laboratory, JAPAN. | 3 | ;; Copyright (C) 2001, 2004 Electrotechnical Laboratory, JAPAN. |
| 4 | ;; Licensed to the Free Software Foundation. | 4 | ;; Licensed to the Free Software Foundation. |
| 5 | ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. | 5 | ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. |
| 6 | 6 | ||
| @@ -97,7 +97,7 @@ translation-table named `utf-translation-table-for-encode'") | |||
| 97 | (defvar ucs-mule-cjk-to-unicode (make-hash-table :test 'eq) | 97 | (defvar ucs-mule-cjk-to-unicode (make-hash-table :test 'eq) |
| 98 | "Hash table mapping Emacs CJK character sets to Unicode code points. | 98 | "Hash table mapping Emacs CJK character sets to Unicode code points. |
| 99 | 99 | ||
| 100 | If `utf-translate-cjk' is non-nil, this table populates the | 100 | If `utf-translate-cjk-mode' is non-nil, this table populates the |
| 101 | translation-hash-table named `utf-subst-table-for-encode'.") | 101 | translation-hash-table named `utf-subst-table-for-encode'.") |
| 102 | 102 | ||
| 103 | (define-translation-hash-table 'utf-subst-table-for-encode | 103 | (define-translation-hash-table 'utf-subst-table-for-encode |
| @@ -106,7 +106,7 @@ translation-hash-table named `utf-subst-table-for-encode'.") | |||
| 106 | (defvar ucs-unicode-to-mule-cjk (make-hash-table :test 'eq) | 106 | (defvar ucs-unicode-to-mule-cjk (make-hash-table :test 'eq) |
| 107 | "Hash table mapping Unicode code points to Emacs CJK character sets. | 107 | "Hash table mapping Unicode code points to Emacs CJK character sets. |
| 108 | 108 | ||
| 109 | If `utf-translate-cjk' is non-nil, this table populates the | 109 | If `utf-translate-cjk-mode' is non-nil, this table populates the |
| 110 | translation-hash-table named `utf-subst-table-for-decode'.") | 110 | translation-hash-table named `utf-subst-table-for-decode'.") |
| 111 | 111 | ||
| 112 | (define-translation-hash-table 'utf-subst-table-for-decode | 112 | (define-translation-hash-table 'utf-subst-table-for-decode |
| @@ -814,7 +814,7 @@ sequence representing U+FFFD (REPLACEMENT CHARACTER)." | |||
| 814 | (dependency unify-8859-on-encoding-mode | 814 | (dependency unify-8859-on-encoding-mode |
| 815 | unify-8859-on-decoding-mode | 815 | unify-8859-on-decoding-mode |
| 816 | utf-fragment-on-decoding | 816 | utf-fragment-on-decoding |
| 817 | utf-translate-cjk))) | 817 | utf-translate-cjk-mode))) |
| 818 | 818 | ||
| 819 | (define-coding-system-alias 'utf-8 'mule-utf-8) | 819 | (define-coding-system-alias 'utf-8 'mule-utf-8) |
| 820 | 820 | ||
diff --git a/lisp/isearchb.el b/lisp/isearchb.el new file mode 100644 index 00000000000..9714701944f --- /dev/null +++ b/lisp/isearchb.el | |||
| @@ -0,0 +1,227 @@ | |||
| 1 | ;;; isearchb --- a marriage between iswitchb and isearch | ||
| 2 | |||
| 3 | ;; Copyright (C) 2004 John Wiegley | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@gnu.org> | ||
| 6 | ;; Created: 16 Apr 2004 | ||
| 7 | ;; Version: 1.5 | ||
| 8 | ;; Keywords: lisp | ||
| 9 | ;; X-URL: http://www.newartisans.com/johnw/emacs.html | ||
| 10 | |||
| 11 | ;; This file is part of GNU Emacs. | ||
| 12 | |||
| 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 16 | ;; any later version. | ||
| 17 | |||
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 25 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 26 | ;; Boston, MA 02111-1307, USA. | ||
| 27 | |||
| 28 | ;;; Commentary: | ||
| 29 | |||
| 30 | ;; This module allows you to switch to buffers even faster than with | ||
| 31 | ;; iswitchb! It is not intended to replace it, however, as it works | ||
| 32 | ;; well only with buffers whose names don't typically overlap. You'll | ||
| 33 | ;; have to try it first, and see how your mileage varies. | ||
| 34 | ;; | ||
| 35 | ;; The first way to use isearchb is by holding down a modifier key, in | ||
| 36 | ;; which case every letter you type while holding it searches for any | ||
| 37 | ;; buffer matching what you're typing (using the same ordering scheme | ||
| 38 | ;; employed by iswitchb). To use it this way, add to your .emacs: | ||
| 39 | ;; | ||
| 40 | ;; (isearchb-set-keybindings 'super) ; s-x s-y s-z now finds "xyz" | ||
| 41 | ;; | ||
| 42 | ;; The other way is by using a command that puts you into "search" | ||
| 43 | ;; mode, just like with isearch. I use C-z for this. The binding in | ||
| 44 | ;; my .emacs looks like: | ||
| 45 | ;; | ||
| 46 | ;; (define-key global-map [(control ?z)] 'isearchb-activate) | ||
| 47 | ;; | ||
| 48 | ;; Now, after pressing C-z (for example), each self-inserting | ||
| 49 | ;; character thereafter will search for a buffer containing those | ||
| 50 | ;; characters. For instance, typing "C-z xyz" will switch to the | ||
| 51 | ;; first buffer containing "xyz". Once you press a non-self-inserting | ||
| 52 | ;; character (such as any control key sequence), the search will end. | ||
| 53 | ;; | ||
| 54 | ;; C-z after C-z toggles between the previously selected buffer and | ||
| 55 | ;; the current one. | ||
| 56 | ;; | ||
| 57 | ;; C-g aborts the search and returns you to your original buffer. | ||
| 58 | ;; | ||
| 59 | ;; TAB, after typing in a few characters (after C-z), will jump into | ||
| 60 | ;; iswitchb, using the prefix you've typed so far. This is handy when | ||
| 61 | ;; you realize that isearchb is not powerful enough to find the buffer | ||
| 62 | ;; you're looking for. | ||
| 63 | ;; | ||
| 64 | ;; C-s and C-r move forward and backward in the buffer list. If | ||
| 65 | ;; `isearchb-show-completions' is non-nil (the default), the list of | ||
| 66 | ;; possible completions is shown in the minibuffer. | ||
| 67 | ;; | ||
| 68 | ;; If `isearchb-idle-timeout' is set to a number, isearchb will quit | ||
| 69 | ;; after that many seconds of idle time. I recommend trying it set to | ||
| 70 | ;; one or two seconds. Then, if you switch to a buffer and wait for | ||
| 71 | ;; that amount of time, you can start typing without manually exiting | ||
| 72 | ;; isearchb. | ||
| 73 | |||
| 74 | ;; TODO: | ||
| 75 | ;; C-z C-z is broken | ||
| 76 | ;; killing iswitchb.el and then trying to switch back is broken | ||
| 77 | ;; make sure TAB isn't broken | ||
| 78 | |||
| 79 | (require 'iswitchb) | ||
| 80 | |||
| 81 | (defgroup isearchb nil | ||
| 82 | "Switch between buffers using a mechanism like isearch." | ||
| 83 | :group 'iswitchb) | ||
| 84 | |||
| 85 | (defcustom isearchb-idle-timeout nil | ||
| 86 | "*Number of idle seconds before isearchb turns itself off. | ||
| 87 | If nil, don't use a timeout." | ||
| 88 | :type '(choice (integer :tag "Seconds") | ||
| 89 | (const :tag "Disable" nil)) | ||
| 90 | :group 'isearchb) | ||
| 91 | |||
| 92 | (defcustom isearchb-show-completions t | ||
| 93 | "*If non-nil, show possible completions in the minibuffer." | ||
| 94 | :type 'boolean | ||
| 95 | :group 'isearchb) | ||
| 96 | |||
| 97 | (defvar isearchb-start-buffer nil) | ||
| 98 | (defvar isearchb-last-buffer nil) | ||
| 99 | (defvar isearchb-idle-timer nil) | ||
| 100 | |||
| 101 | (defun isearchb-stop (&optional return-to-buffer ignore-command) | ||
| 102 | "Called by isearchb to terminate a search in progress." | ||
| 103 | (remove-hook 'pre-command-hook 'isearchb-follow-char) | ||
| 104 | (if return-to-buffer | ||
| 105 | (switch-to-buffer isearchb-start-buffer) | ||
| 106 | (setq isearchb-last-buffer isearchb-start-buffer)) | ||
| 107 | (when isearchb-idle-timer | ||
| 108 | (cancel-timer isearchb-idle-timer) | ||
| 109 | (setq isearchb-idle-timer nil)) | ||
| 110 | (if ignore-command | ||
| 111 | (setq this-command 'ignore | ||
| 112 | last-command 'ignore)) | ||
| 113 | (message nil)) | ||
| 114 | |||
| 115 | (defun isearchb-iswitchb () | ||
| 116 | "isearchb's custom version of the `iswitchb' command. | ||
| 117 | It's purpose is to pass different call arguments to | ||
| 118 | `iswitchb-read-buffer'." | ||
| 119 | (interactive) | ||
| 120 | (let* ((prompt "iswitch ") | ||
| 121 | (iswitchb-method 'samewindow) | ||
| 122 | (buf (iswitchb-read-buffer prompt nil nil iswitchb-text t))) | ||
| 123 | (if (eq iswitchb-exit 'findfile) | ||
| 124 | (call-interactively 'find-file) | ||
| 125 | (when buf | ||
| 126 | (if (get-buffer buf) | ||
| 127 | ;; buffer exists, so view it and then exit | ||
| 128 | (iswitchb-visit-buffer buf) | ||
| 129 | ;; else buffer doesn't exist | ||
| 130 | (iswitchb-possible-new-buffer buf)))))) | ||
| 131 | |||
| 132 | (defun isearchb () | ||
| 133 | "Switch to buffer matching a substring, based on chars typed." | ||
| 134 | (interactive) | ||
| 135 | (unless (eq last-command 'isearchb) | ||
| 136 | (setq iswitchb-text nil)) | ||
| 137 | (unless iswitchb-text | ||
| 138 | (setq iswitchb-text "") | ||
| 139 | (iswitchb-make-buflist nil)) | ||
| 140 | (if last-command-char | ||
| 141 | (setq iswitchb-rescan t | ||
| 142 | iswitchb-text (concat iswitchb-text | ||
| 143 | (char-to-string last-command-char)))) | ||
| 144 | (iswitchb-set-matches) | ||
| 145 | (let* ((match (car iswitchb-matches)) | ||
| 146 | (buf (and match (get-buffer match)))) | ||
| 147 | (if (null buf) | ||
| 148 | (progn | ||
| 149 | (isearchb-stop t) | ||
| 150 | (isearchb-iswitchb)) | ||
| 151 | (switch-to-buffer buf) | ||
| 152 | (if isearchb-show-completions | ||
| 153 | (message "isearchb: %s%s" iswitchb-text | ||
| 154 | (iswitchb-completions iswitchb-text nil)) | ||
| 155 | (if (= 1 (length iswitchb-matches)) | ||
| 156 | (message "isearchb: %s (only match)" iswitchb-text) | ||
| 157 | (message "isearchb: %s" iswitchb-text)))))) | ||
| 158 | |||
| 159 | (defun isearchb-set-keybindings (modifier) | ||
| 160 | "Setup isearchb on the given MODIFIER." | ||
| 161 | (dotimes (i 128) | ||
| 162 | (if (eq 'self-insert-command | ||
| 163 | (lookup-key global-map (vector i))) | ||
| 164 | (define-key global-map (vector (list modifier i)) 'isearchb)))) | ||
| 165 | |||
| 166 | (defun isearchb-follow-char () | ||
| 167 | "Function added to post-command-hook to handle the isearchb \"mode\"." | ||
| 168 | (let (keys) | ||
| 169 | (if (not (and (memq last-command '(isearchb isearchb-activate)) | ||
| 170 | (setq keys (this-command-keys)) | ||
| 171 | (= 1 (length keys)))) | ||
| 172 | (isearchb-stop) | ||
| 173 | (cond | ||
| 174 | ((or (equal keys "\C-h") (equal keys "\C-?") | ||
| 175 | (equal keys [backspace]) (equal keys [delete])) | ||
| 176 | (setq iswitchb-text | ||
| 177 | (substring iswitchb-text 0 (1- (length iswitchb-text)))) | ||
| 178 | (if (= 0 (length iswitchb-text)) | ||
| 179 | (isearchb-stop t t) | ||
| 180 | (setq last-command-char nil) | ||
| 181 | (setq this-command 'isearchb))) | ||
| 182 | ((or (equal keys "\C-i") (equal keys [tab])) | ||
| 183 | (setq this-command 'isearchb-iswitchb)) | ||
| 184 | ((equal keys "\C-s") | ||
| 185 | (iswitchb-next-match) | ||
| 186 | (setq last-command-char nil) | ||
| 187 | (setq this-command 'isearchb)) | ||
| 188 | ((equal keys "\C-r") | ||
| 189 | (iswitchb-prev-match) | ||
| 190 | (setq last-command-char nil) | ||
| 191 | (setq this-command 'isearchb)) | ||
| 192 | ((equal keys "\C-g") | ||
| 193 | (ding) | ||
| 194 | (isearchb-stop t t)) | ||
| 195 | ((eq (lookup-key global-map keys) 'self-insert-command) | ||
| 196 | (setq this-command 'isearchb))) | ||
| 197 | (if (and isearchb-idle-timeout | ||
| 198 | (null isearchb-idle-timer)) | ||
| 199 | (setq isearchb-idle-timer | ||
| 200 | (run-with-idle-timer isearchb-idle-timeout nil | ||
| 201 | 'isearchb-stop)))))) | ||
| 202 | |||
| 203 | ;;;###autoload | ||
| 204 | (defun isearchb-activate () | ||
| 205 | "Active isearchb mode for subsequent alphanumeric keystrokes. | ||
| 206 | Executing this command again will terminate the search; or, if | ||
| 207 | the search has not yet begun, will toggle to the last buffer | ||
| 208 | accessed via isearchb." | ||
| 209 | (interactive) | ||
| 210 | (cond | ||
| 211 | ((eq last-command 'isearchb) | ||
| 212 | (isearchb-stop nil t)) | ||
| 213 | ((eq last-command 'isearchb-activate) | ||
| 214 | (if isearchb-last-buffer | ||
| 215 | (switch-to-buffer isearchb-last-buffer) | ||
| 216 | (error "isearchb: There is no previous buffer to toggle to.")) | ||
| 217 | (isearchb-stop nil t)) | ||
| 218 | (t | ||
| 219 | (message "isearchb: ") | ||
| 220 | (setq iswitchb-text nil | ||
| 221 | isearchb-start-buffer (current-buffer)) | ||
| 222 | (add-hook 'pre-command-hook 'isearchb-follow-char)))) | ||
| 223 | |||
| 224 | (provide 'isearchb) | ||
| 225 | |||
| 226 | ;;; arch-tag: 9277523f-a624-4aa0-ba10-b89eeb7b6e99 | ||
| 227 | ;;; isearchb.el ends here | ||
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 7bada72310c..9b124848b18 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el | |||
| @@ -307,6 +307,20 @@ multitude of buffers open." | |||
| 307 | :type '(choice (const :tag "Show all" nil) integer) | 307 | :type '(choice (const :tag "Show all" nil) integer) |
| 308 | :group 'iswitchb) | 308 | :group 'iswitchb) |
| 309 | 309 | ||
| 310 | (defcustom iswitchb-use-virtual-buffers nil | ||
| 311 | "*If non-nil, refer to past buffers when none match. | ||
| 312 | This feature relies upon the `recentf' package, which will be | ||
| 313 | enabled if this variable is configured to a non-nil value." | ||
| 314 | :type 'boolean | ||
| 315 | :require 'recentf | ||
| 316 | :set (function | ||
| 317 | (lambda (sym value) | ||
| 318 | (recentf-mode value) | ||
| 319 | (set sym value))) | ||
| 320 | :group 'iswitchb) | ||
| 321 | |||
| 322 | (defvar iswitchb-virtual-buffers nil) | ||
| 323 | |||
| 310 | (defcustom iswitchb-cannot-complete-hook 'iswitchb-completion-help | 324 | (defcustom iswitchb-cannot-complete-hook 'iswitchb-completion-help |
| 311 | "*Hook run when `iswitchb-complete' can't complete any more. | 325 | "*Hook run when `iswitchb-complete' can't complete any more. |
| 312 | The most useful values are `iswitchb-completion-help', which pops up a | 326 | The most useful values are `iswitchb-completion-help', which pops up a |
| @@ -571,12 +585,18 @@ in a separate window. | |||
| 571 | (iswitchb-possible-new-buffer buf))) | 585 | (iswitchb-possible-new-buffer buf))) |
| 572 | )))) | 586 | )))) |
| 573 | 587 | ||
| 574 | (defun iswitchb-read-buffer (prompt &optional default require-match) | 588 | (defun iswitchb-read-buffer (prompt &optional default require-match |
| 589 | start matches-set) | ||
| 575 | "Replacement for the built-in `read-buffer'. | 590 | "Replacement for the built-in `read-buffer'. |
| 576 | Return the name of a buffer selected. | 591 | Return the name of a buffer selected. |
| 577 | PROMPT is the prompt to give to the user. DEFAULT if given is the default | 592 | PROMPT is the prompt to give to the user. |
| 578 | buffer to be selected, which will go to the front of the list. | 593 | DEFAULT if given is the default buffer to be selected, which will |
| 579 | If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." | 594 | go to the front of the list. |
| 595 | If REQUIRE-MATCH is non-nil, an existing-buffer must be selected. | ||
| 596 | If START is a string, the selection process is started with that | ||
| 597 | string. | ||
| 598 | If MATCHES-SET is non-nil, the buflist is not updated before | ||
| 599 | the selection process begins. Used by isearchb.el." | ||
| 580 | (let | 600 | (let |
| 581 | ( | 601 | ( |
| 582 | buf-sel | 602 | buf-sel |
| @@ -589,14 +609,15 @@ If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." | |||
| 589 | 609 | ||
| 590 | (iswitchb-define-mode-map) | 610 | (iswitchb-define-mode-map) |
| 591 | (setq iswitchb-exit nil) | 611 | (setq iswitchb-exit nil) |
| 592 | (setq iswitchb-rescan t) | ||
| 593 | (setq iswitchb-text "") | ||
| 594 | (setq iswitchb-default | 612 | (setq iswitchb-default |
| 595 | (if (bufferp default) | 613 | (if (bufferp default) |
| 596 | (buffer-name default) | 614 | (buffer-name default) |
| 597 | default)) | 615 | default)) |
| 598 | (iswitchb-make-buflist iswitchb-default) | 616 | (setq iswitchb-text (or start "")) |
| 599 | (iswitchb-set-matches) | 617 | (unless matches-set |
| 618 | (setq iswitchb-rescan t) | ||
| 619 | (iswitchb-make-buflist iswitchb-default) | ||
| 620 | (iswitchb-set-matches)) | ||
| 600 | (let | 621 | (let |
| 601 | ((minibuffer-local-completion-map iswitchb-mode-map) | 622 | ((minibuffer-local-completion-map iswitchb-mode-map) |
| 602 | ;; Record the minibuffer depth that we expect to find once | 623 | ;; Record the minibuffer depth that we expect to find once |
| @@ -605,32 +626,41 @@ If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." | |||
| 605 | (iswitchb-require-match require-match)) | 626 | (iswitchb-require-match require-match)) |
| 606 | ;; prompt the user for the buffer name | 627 | ;; prompt the user for the buffer name |
| 607 | (setq iswitchb-final-text (completing-read | 628 | (setq iswitchb-final-text (completing-read |
| 608 | prompt ;the prompt | 629 | prompt ;the prompt |
| 609 | '(("dummy" . 1)) ;table | 630 | '(("dummy" . 1)) ;table |
| 610 | nil ;predicate | 631 | nil ;predicate |
| 611 | nil ;require-match [handled elsewhere] | 632 | nil ;require-match [handled elsewhere] |
| 612 | nil ;initial-contents | 633 | start ;initial-contents |
| 613 | 'iswitchb-history))) | 634 | 'iswitchb-history))) |
| 614 | (if (and (not (eq iswitchb-exit 'usefirst)) | 635 | (if (and (not (eq iswitchb-exit 'usefirst)) |
| 615 | (get-buffer iswitchb-final-text)) | 636 | (get-buffer iswitchb-final-text)) |
| 616 | ;; This happens for example if the buffer was chosen with the mouse. | 637 | ;; This happens for example if the buffer was chosen with the mouse. |
| 617 | (setq iswitchb-matches (list iswitchb-final-text))) | 638 | (setq iswitchb-matches (list iswitchb-final-text) |
| 639 | iswitchb-virtual-buffers nil)) | ||
| 640 | |||
| 641 | ;; If no buffer matched, but a virtual buffer was selected, visit | ||
| 642 | ;; that file now and act as though that buffer had been selected. | ||
| 643 | (if (and iswitchb-virtual-buffers | ||
| 644 | (not (iswitchb-existing-buffer-p))) | ||
| 645 | (let ((virt (car iswitchb-virtual-buffers))) | ||
| 646 | (find-file-noselect (cdr virt)) | ||
| 647 | (setq iswitchb-matches (list (car virt)) | ||
| 648 | iswitchb-virtual-buffers nil))) | ||
| 618 | 649 | ||
| 619 | ;; Handling the require-match must be done in a better way. | 650 | ;; Handling the require-match must be done in a better way. |
| 620 | (if (and require-match (not (iswitchb-existing-buffer-p))) | 651 | (if (and require-match |
| 652 | (not (iswitchb-existing-buffer-p))) | ||
| 621 | (error "Must specify valid buffer")) | 653 | (error "Must specify valid buffer")) |
| 622 | 654 | ||
| 623 | (if (or | 655 | (if (or (eq iswitchb-exit 'takeprompt) |
| 624 | (eq iswitchb-exit 'takeprompt) | 656 | (null iswitchb-matches)) |
| 625 | (null iswitchb-matches)) | ||
| 626 | (setq buf-sel iswitchb-final-text) | 657 | (setq buf-sel iswitchb-final-text) |
| 627 | ;; else take head of list | 658 | ;; else take head of list |
| 628 | (setq buf-sel (car iswitchb-matches))) | 659 | (setq buf-sel (car iswitchb-matches))) |
| 629 | 660 | ||
| 630 | ;; Or possibly choose the default buffer | 661 | ;; Or possibly choose the default buffer |
| 631 | (if (equal iswitchb-final-text "") | 662 | (if (equal iswitchb-final-text "") |
| 632 | (setq buf-sel | 663 | (setq buf-sel (car iswitchb-matches))) |
| 633 | (car iswitchb-matches))) | ||
| 634 | 664 | ||
| 635 | buf-sel)) | 665 | buf-sel)) |
| 636 | 666 | ||
| @@ -731,18 +761,29 @@ If no buffer exactly matching the prompt exists, maybe create a new one." | |||
| 731 | (setq iswitchb-exit 'findfile) | 761 | (setq iswitchb-exit 'findfile) |
| 732 | (exit-minibuffer)) | 762 | (exit-minibuffer)) |
| 733 | 763 | ||
| 764 | (eval-when-compile | ||
| 765 | (defvar recentf-list)) | ||
| 766 | |||
| 734 | (defun iswitchb-next-match () | 767 | (defun iswitchb-next-match () |
| 735 | "Put first element of `iswitchb-matches' at the end of the list." | 768 | "Put first element of `iswitchb-matches' at the end of the list." |
| 736 | (interactive) | 769 | (interactive) |
| 737 | (let ((next (cadr iswitchb-matches))) | 770 | (let ((next (cadr iswitchb-matches))) |
| 738 | (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist next)) | 771 | (if (and (null next) iswitchb-virtual-buffers) |
| 772 | (setq recentf-list | ||
| 773 | (iswitchb-chop recentf-list | ||
| 774 | (cdr (cadr iswitchb-virtual-buffers)))) | ||
| 775 | (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist next))) | ||
| 739 | (setq iswitchb-rescan t))) | 776 | (setq iswitchb-rescan t))) |
| 740 | 777 | ||
| 741 | (defun iswitchb-prev-match () | 778 | (defun iswitchb-prev-match () |
| 742 | "Put last element of `iswitchb-matches' at the front of the list." | 779 | "Put last element of `iswitchb-matches' at the front of the list." |
| 743 | (interactive) | 780 | (interactive) |
| 744 | (let ((prev (car (last iswitchb-matches)))) | 781 | (let ((prev (car (last iswitchb-matches)))) |
| 745 | (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist prev)) | 782 | (if (and (null prev) iswitchb-virtual-buffers) |
| 783 | (setq recentf-list | ||
| 784 | (iswitchb-chop recentf-list | ||
| 785 | (cdr (car (last iswitchb-virtual-buffers))))) | ||
| 786 | (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist prev))) | ||
| 746 | (setq iswitchb-rescan t))) | 787 | (setq iswitchb-rescan t))) |
| 747 | 788 | ||
| 748 | (defun iswitchb-chop (list elem) | 789 | (defun iswitchb-chop (list elem) |
| @@ -834,7 +875,8 @@ current frame, rather than all frames, regardless of value of | |||
| 834 | (setq iswitchb-matches | 875 | (setq iswitchb-matches |
| 835 | (let* ((buflist iswitchb-buflist)) | 876 | (let* ((buflist iswitchb-buflist)) |
| 836 | (iswitchb-get-matched-buffers iswitchb-text iswitchb-regexp | 877 | (iswitchb-get-matched-buffers iswitchb-text iswitchb-regexp |
| 837 | buflist))))) | 878 | buflist)) |
| 879 | iswitchb-virtual-buffers nil))) | ||
| 838 | 880 | ||
| 839 | (defun iswitchb-get-matched-buffers (regexp | 881 | (defun iswitchb-get-matched-buffers (regexp |
| 840 | &optional string-format buffer-list) | 882 | &optional string-format buffer-list) |
| @@ -1188,6 +1230,10 @@ Copied from `icomplete-exhibit' with two changes: | |||
| 1188 | contents | 1230 | contents |
| 1189 | (not minibuffer-completion-confirm))))))) | 1231 | (not minibuffer-completion-confirm))))))) |
| 1190 | 1232 | ||
| 1233 | (eval-when-compile | ||
| 1234 | (defvar most-len) | ||
| 1235 | (defvar most-is-exact)) | ||
| 1236 | |||
| 1191 | (defun iswitchb-output-completion (com) | 1237 | (defun iswitchb-output-completion (com) |
| 1192 | (if (= (length com) most-len) | 1238 | (if (= (length com) most-len) |
| 1193 | ;; Most is one exact match, | 1239 | ;; Most is one exact match, |
| @@ -1221,6 +1267,35 @@ Modified from `icomplete-completions'." | |||
| 1221 | first) | 1267 | first) |
| 1222 | (setq comps (cons first (cdr comps))))) | 1268 | (setq comps (cons first (cdr comps))))) |
| 1223 | 1269 | ||
| 1270 | ;; If no buffers matched, and virtual buffers are being used, then | ||
| 1271 | ;; consult the list of past visited files, to see if we can find | ||
| 1272 | ;; the file which the user might thought was still open. | ||
| 1273 | (when (and iswitchb-use-virtual-buffers (null comps) | ||
| 1274 | recentf-list) | ||
| 1275 | (setq iswitchb-virtual-buffers nil) | ||
| 1276 | (let ((head recentf-list) name) | ||
| 1277 | (while head | ||
| 1278 | (if (and (setq name (file-name-nondirectory (car head))) | ||
| 1279 | (string-match (if iswitchb-regexp | ||
| 1280 | iswitchb-text | ||
| 1281 | (regexp-quote iswitchb-text)) name) | ||
| 1282 | (null (get-file-buffer (car head))) | ||
| 1283 | (not (assoc name iswitchb-virtual-buffers)) | ||
| 1284 | (not (iswitchb-ignore-buffername-p name)) | ||
| 1285 | (file-exists-p (car head))) | ||
| 1286 | (setq iswitchb-virtual-buffers | ||
| 1287 | (cons (cons name (car head)) | ||
| 1288 | iswitchb-virtual-buffers))) | ||
| 1289 | (setq head (cdr head))) | ||
| 1290 | (setq iswitchb-virtual-buffers (nreverse iswitchb-virtual-buffers) | ||
| 1291 | comps (mapcar 'car iswitchb-virtual-buffers)) | ||
| 1292 | (let ((comp comps)) | ||
| 1293 | (while comp | ||
| 1294 | (put-text-property 0 (length (car comp)) | ||
| 1295 | 'face 'font-lock-builtin-face | ||
| 1296 | (car comp)) | ||
| 1297 | (setq comp (cdr comp)))))) | ||
| 1298 | |||
| 1224 | (cond ((null comps) (format " %sNo match%s" | 1299 | (cond ((null comps) (format " %sNo match%s" |
| 1225 | open-bracket-determined | 1300 | open-bracket-determined |
| 1226 | close-bracket-determined)) | 1301 | close-bracket-determined)) |
| @@ -1255,10 +1330,9 @@ Modified from `icomplete-completions'." | |||
| 1255 | (most nil) | 1330 | (most nil) |
| 1256 | (most-len (length most)) | 1331 | (most-len (length most)) |
| 1257 | most-is-exact | 1332 | most-is-exact |
| 1258 | (alternatives (if most | 1333 | (alternatives |
| 1259 | (mapconcat 'iswitchb-output-completion | 1334 | (mapconcat (if most 'iswitchb-output-completion |
| 1260 | comps ",") | 1335 | 'identity) comps ","))) |
| 1261 | (mapconcat 'identity comps ",")))) | ||
| 1262 | 1336 | ||
| 1263 | (concat | 1337 | (concat |
| 1264 | 1338 | ||
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 3d41042e8d7..5d21fda6a9a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el | |||
| @@ -1516,46 +1516,51 @@ for the overlay." | |||
| 1516 | ;*---------------------------------------------------------------------*/ | 1516 | ;*---------------------------------------------------------------------*/ |
| 1517 | (defun flyspell-highlight-incorrect-region (beg end poss) | 1517 | (defun flyspell-highlight-incorrect-region (beg end poss) |
| 1518 | "Set up an overlay on a misspelled word, in the buffer from BEG to END." | 1518 | "Set up an overlay on a misspelled word, in the buffer from BEG to END." |
| 1519 | (unless (run-hook-with-args-until-success | 1519 | (let ((inhibit-read-only t)) |
| 1520 | 'flyspell-incorrect-hook beg end poss) | 1520 | (unless (run-hook-with-args-until-success |
| 1521 | (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) | 1521 | 'flyspell-incorrect-hook beg end poss) |
| 1522 | (progn | 1522 | (if (or flyspell-highlight-properties |
| 1523 | ;; we cleanup current overlay at the same position | 1523 | (not (flyspell-properties-at-p beg))) |
| 1524 | (if (and (not flyspell-persistent-highlight) | 1524 | (progn |
| 1525 | (overlayp flyspell-overlay)) | 1525 | ;; we cleanup current overlay at the same position |
| 1526 | (delete-overlay flyspell-overlay) | 1526 | (if (and (not flyspell-persistent-highlight) |
| 1527 | (let ((overlays (overlays-at beg))) | 1527 | (overlayp flyspell-overlay)) |
| 1528 | (while (consp overlays) | 1528 | (delete-overlay flyspell-overlay) |
| 1529 | (if (flyspell-overlay-p (car overlays)) | 1529 | (let ((overlays (overlays-at beg))) |
| 1530 | (delete-overlay (car overlays))) | 1530 | (while (consp overlays) |
| 1531 | (setq overlays (cdr overlays))))) | 1531 | (if (flyspell-overlay-p (car overlays)) |
| 1532 | ;; now we can use a new overlay | 1532 | (delete-overlay (car overlays))) |
| 1533 | (setq flyspell-overlay | 1533 | (setq overlays (cdr overlays))))) |
| 1534 | (make-flyspell-overlay beg end | 1534 | ;; now we can use a new overlay |
| 1535 | 'flyspell-incorrect-face | 1535 | (setq flyspell-overlay |
| 1536 | 'highlight)))))) | 1536 | (make-flyspell-overlay |
| 1537 | beg end 'flyspell-incorrect-face 'highlight))))))) | ||
| 1537 | 1538 | ||
| 1538 | ;*---------------------------------------------------------------------*/ | 1539 | ;*---------------------------------------------------------------------*/ |
| 1539 | ;* flyspell-highlight-duplicate-region ... */ | 1540 | ;* flyspell-highlight-duplicate-region ... */ |
| 1540 | ;*---------------------------------------------------------------------*/ | 1541 | ;*---------------------------------------------------------------------*/ |
| 1541 | (defun flyspell-highlight-duplicate-region (beg end) | 1542 | (defun flyspell-highlight-duplicate-region (beg end) |
| 1542 | "Set up an overlay on a duplicated word, in the buffer from BEG to END." | 1543 | "Set up an overlay on a duplicated word, in the buffer from BEG to END." |
| 1543 | (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) | 1544 | (let ((inhibit-read-only t)) |
| 1544 | (progn | 1545 | (unless (run-hook-with-args-until-success |
| 1545 | ;; we cleanup current overlay at the same position | 1546 | 'flyspell-incorrect-hook beg end poss) |
| 1546 | (if (and (not flyspell-persistent-highlight) | 1547 | (if (or flyspell-highlight-properties |
| 1547 | (overlayp flyspell-overlay)) | 1548 | (not (flyspell-properties-at-p beg))) |
| 1548 | (delete-overlay flyspell-overlay) | 1549 | (progn |
| 1549 | (let ((overlays (overlays-at beg))) | 1550 | ;; we cleanup current overlay at the same position |
| 1550 | (while (consp overlays) | 1551 | (if (and (not flyspell-persistent-highlight) |
| 1551 | (if (flyspell-overlay-p (car overlays)) | 1552 | (overlayp flyspell-overlay)) |
| 1552 | (delete-overlay (car overlays))) | 1553 | (delete-overlay flyspell-overlay) |
| 1553 | (setq overlays (cdr overlays))))) | 1554 | (let ((overlays (overlays-at beg))) |
| 1554 | ;; now we can use a new overlay | 1555 | (while (consp overlays) |
| 1555 | (setq flyspell-overlay | 1556 | (if (flyspell-overlay-p (car overlays)) |
| 1556 | (make-flyspell-overlay beg end | 1557 | (delete-overlay (car overlays))) |
| 1557 | 'flyspell-duplicate-face | 1558 | (setq overlays (cdr overlays))))) |
| 1558 | 'highlight))))) | 1559 | ;; now we can use a new overlay |
| 1560 | (setq flyspell-overlay | ||
| 1561 | (make-flyspell-overlay beg end | ||
| 1562 | 'flyspell-duplicate-face | ||
| 1563 | 'highlight))))))) | ||
| 1559 | 1564 | ||
| 1560 | ;*---------------------------------------------------------------------*/ | 1565 | ;*---------------------------------------------------------------------*/ |
| 1561 | ;* flyspell-auto-correct-cache ... */ | 1566 | ;* flyspell-auto-correct-cache ... */ |
| @@ -2061,23 +2066,23 @@ possible corrections as returned by 'ispell-parse-output'. | |||
| 2061 | 2066 | ||
| 2062 | This function is meant to be added to 'flyspell-incorrect-hook'." | 2067 | This function is meant to be added to 'flyspell-incorrect-hook'." |
| 2063 | (when (consp poss) | 2068 | (when (consp poss) |
| 2064 | (let ((temp-buffer (get-buffer-create " *flyspell-temp*")) | 2069 | (catch 'done |
| 2065 | found) | 2070 | (let ((str (buffer-substring beg end)) |
| 2066 | (save-excursion | 2071 | (i 0) (len (- end beg)) tmp) |
| 2067 | (copy-to-buffer temp-buffer beg end) | 2072 | (while (< (1+ i) len) |
| 2068 | (set-buffer temp-buffer) | 2073 | (setq tmp (aref str i)) |
| 2069 | (goto-char (1+ (point-min))) | 2074 | (aset str i (aref str (1+ i))) |
| 2070 | (while (and (not (eobp)) (not found)) | 2075 | (aset str (1+ i) tmp) |
| 2071 | (transpose-chars 1) | 2076 | (when (member str (nth 2 poss)) |
| 2072 | (if (member (buffer-string) (nth 2 poss)) | 2077 | (save-excursion |
| 2073 | (setq found (point)) | 2078 | (goto-char (+ beg i 1)) |
| 2074 | (transpose-chars -1) | 2079 | (transpose-chars 1)) |
| 2075 | (forward-char)))) | 2080 | (throw 'done t)) |
| 2076 | (when found | 2081 | (setq tmp (aref str i)) |
| 2077 | (save-excursion | 2082 | (aset str i (aref str (1+ i))) |
| 2078 | (goto-char (+ beg found -1)) | 2083 | (aset str (1+ i) tmp) |
| 2079 | (transpose-chars -1) | 2084 | (setq i (1+ i)))) |
| 2080 | t))))) | 2085 | nil))) |
| 2081 | 2086 | ||
| 2082 | (defun flyspell-maybe-correct-doubling (beg end poss) | 2087 | (defun flyspell-maybe-correct-doubling (beg end poss) |
| 2083 | "Check replacements for doubled characters. | 2088 | "Check replacements for doubled characters. |
| @@ -2091,24 +2096,19 @@ possible corrections as returned by 'ispell-parse-output'. | |||
| 2091 | 2096 | ||
| 2092 | This function is meant to be added to 'flyspell-incorrect-hook'." | 2097 | This function is meant to be added to 'flyspell-incorrect-hook'." |
| 2093 | (when (consp poss) | 2098 | (when (consp poss) |
| 2094 | (let ((temp-buffer (get-buffer-create " *flyspell-temp*")) | 2099 | (catch 'done |
| 2095 | found) | 2100 | (let ((str (buffer-substring beg end)) |
| 2096 | (save-excursion | 2101 | (i 0) (len (- end beg))) |
| 2097 | (copy-to-buffer temp-buffer beg end) | 2102 | (while (< (1+ i) len) |
| 2098 | (set-buffer temp-buffer) | 2103 | (when (and (= (aref str i) (aref str (1+ i))) |
| 2099 | (goto-char (1+ (point-min))) | 2104 | (member (concat (substring str 0 (1+ i)) |
| 2100 | (while (and (not (eobp)) (not found)) | 2105 | (substring str (+ i 2))) |
| 2101 | (when (char-equal (char-after) (char-before)) | 2106 | (nth 2 poss))) |
| 2102 | (delete-char 1) | 2107 | (goto-char (+ beg i)) |
| 2103 | (if (member (buffer-string) (nth 2 poss)) | 2108 | (delete-char 1) |
| 2104 | (setq found (point)) | 2109 | (throw 'done t)) |
| 2105 | (insert-char (char-before) 1))) | 2110 | (setq i (1+ i)))) |
| 2106 | (forward-char))) | 2111 | nil))) |
| 2107 | (when found | ||
| 2108 | (save-excursion | ||
| 2109 | (goto-char (+ beg found -1)) | ||
| 2110 | (delete-char 1) | ||
| 2111 | t))))) | ||
| 2112 | 2112 | ||
| 2113 | ;*---------------------------------------------------------------------*/ | 2113 | ;*---------------------------------------------------------------------*/ |
| 2114 | ;* flyspell-already-abbrevp ... */ | 2114 | ;* flyspell-already-abbrevp ... */ |
diff --git a/src/ChangeLog b/src/ChangeLog index 673ebc5a1ed..5168e9126e1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,5 +1,19 @@ | |||
| 1 | 2004-05-08 Peter Whaite <emacs@whaite.ca> (tiny change) | ||
| 2 | |||
| 3 | * data.c (Fquo): If any argument is float, do the computation in | ||
| 4 | floating point. | ||
| 5 | |||
| 1 | 2004-05-08 Juanma Barranquero <lektu@terra.es> | 6 | 2004-05-08 Juanma Barranquero <lektu@terra.es> |
| 2 | 7 | ||
| 8 | * process.c (Fwaiting_for_user_input_p, Fmake_network_process) | ||
| 9 | (Fset_process_query_on_exit_flag, Vprocess_adaptive_read_buffering): | ||
| 10 | Fix spelling of Emacs on docstring. | ||
| 11 | (Fset_process_coding_system, Fprocess_coding_system) | ||
| 12 | (Fset_process_filter_multibyte, Fprocess_filter_multibyte_p): | ||
| 13 | Make argument names match their use in docstring. | ||
| 14 | (Fprocess_id, Fprocess_query_on_exit_flag, Finterrupt_process): | ||
| 15 | Fix docstring. | ||
| 16 | |||
| 3 | * editfns.c (Finsert_buffer_substring): Make argument names match their | 17 | * editfns.c (Finsert_buffer_substring): Make argument names match their |
| 4 | use in docstring. | 18 | use in docstring. |
| 5 | 19 | ||
diff --git a/src/data.c b/src/data.c index 6ce9a5d37aa..1a66e52632a 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2698,6 +2698,12 @@ usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) | |||
| 2698 | int nargs; | 2698 | int nargs; |
| 2699 | Lisp_Object *args; | 2699 | Lisp_Object *args; |
| 2700 | { | 2700 | { |
| 2701 | int argnum; | ||
| 2702 | if (nargs == 2) | ||
| 2703 | return arith_driver (Adiv, nargs, args); | ||
| 2704 | for (argnum = 0; argnum < nargs; argnum++) | ||
| 2705 | if (FLOATP (args[argnum])) | ||
| 2706 | return float_arith_driver (0, 0, Adiv, nargs, args); | ||
| 2701 | return arith_driver (Adiv, nargs, args); | 2707 | return arith_driver (Adiv, nargs, args); |
| 2702 | } | 2708 | } |
| 2703 | 2709 | ||
diff --git a/src/process.c b/src/process.c index 3e4b5dbc673..db7e31dd244 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -532,7 +532,7 @@ allocate_pty () | |||
| 532 | three failures in a row before deciding that we've reached the | 532 | three failures in a row before deciding that we've reached the |
| 533 | end of the ptys. */ | 533 | end of the ptys. */ |
| 534 | int failed_count = 0; | 534 | int failed_count = 0; |
| 535 | 535 | ||
| 536 | if (stat (pty_name, &stb) < 0) | 536 | if (stat (pty_name, &stb) < 0) |
| 537 | { | 537 | { |
| 538 | failed_count++; | 538 | failed_count++; |
| @@ -842,7 +842,7 @@ If PROCESS has not yet exited or died, return 0. */) | |||
| 842 | 842 | ||
| 843 | DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, | 843 | DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, |
| 844 | doc: /* Return the process id of PROCESS. | 844 | doc: /* Return the process id of PROCESS. |
| 845 | This is the pid of the Unix process which PROCESS uses or talks to. | 845 | This is the pid of the external process which PROCESS uses or talks to. |
| 846 | For a network connection, this value is nil. */) | 846 | For a network connection, this value is nil. */) |
| 847 | (process) | 847 | (process) |
| 848 | register Lisp_Object process; | 848 | register Lisp_Object process; |
| @@ -1081,7 +1081,7 @@ DEFUN ("set-process-query-on-exit-flag", | |||
| 1081 | Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag, | 1081 | Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag, |
| 1082 | 2, 2, 0, | 1082 | 2, 2, 0, |
| 1083 | doc: /* Specify if query is needed for PROCESS when Emacs is exited. | 1083 | doc: /* Specify if query is needed for PROCESS when Emacs is exited. |
| 1084 | If the second argument FLAG is non-nil, emacs will query the user before | 1084 | If the second argument FLAG is non-nil, Emacs will query the user before |
| 1085 | exiting if PROCESS is running. */) | 1085 | exiting if PROCESS is running. */) |
| 1086 | (process, flag) | 1086 | (process, flag) |
| 1087 | register Lisp_Object process, flag; | 1087 | register Lisp_Object process, flag; |
| @@ -1094,7 +1094,7 @@ exiting if PROCESS is running. */) | |||
| 1094 | DEFUN ("process-query-on-exit-flag", | 1094 | DEFUN ("process-query-on-exit-flag", |
| 1095 | Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag, | 1095 | Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag, |
| 1096 | 1, 1, 0, | 1096 | 1, 1, 0, |
| 1097 | doc: /* Return the current value of query on exit flag for PROCESS. */) | 1097 | doc: /* Return the current value of query-on-exit flag for PROCESS. */) |
| 1098 | (process) | 1098 | (process) |
| 1099 | register Lisp_Object process; | 1099 | register Lisp_Object process; |
| 1100 | { | 1100 | { |
| @@ -2608,7 +2608,7 @@ successful) or "failed" when the connect completes. Default is to use | |||
| 2608 | a blocking connect (i.e. wait) for stream type connections. | 2608 | a blocking connect (i.e. wait) for stream type connections. |
| 2609 | 2609 | ||
| 2610 | :noquery BOOL -- Query the user unless BOOL is non-nil, and process is | 2610 | :noquery BOOL -- Query the user unless BOOL is non-nil, and process is |
| 2611 | running when emacs is exited. | 2611 | running when Emacs is exited. |
| 2612 | 2612 | ||
| 2613 | :stop BOOL -- Start process in the `stopped' state if BOOL non-nil. | 2613 | :stop BOOL -- Start process in the `stopped' state if BOOL non-nil. |
| 2614 | In the stopped state, a server process does not accept new | 2614 | In the stopped state, a server process does not accept new |
| @@ -2954,7 +2954,7 @@ usage: (make-network-process &rest ARGS) */) | |||
| 2954 | struct hostent *host_info_ptr; | 2954 | struct hostent *host_info_ptr; |
| 2955 | 2955 | ||
| 2956 | /* gethostbyname may fail with TRY_AGAIN, but we don't honour that, | 2956 | /* gethostbyname may fail with TRY_AGAIN, but we don't honour that, |
| 2957 | as it may `hang' emacs for a very long time. */ | 2957 | as it may `hang' Emacs for a very long time. */ |
| 2958 | immediate_quit = 1; | 2958 | immediate_quit = 1; |
| 2959 | QUIT; | 2959 | QUIT; |
| 2960 | host_info_ptr = gethostbyname (SDATA (host)); | 2960 | host_info_ptr = gethostbyname (SDATA (host)); |
| @@ -3634,7 +3634,7 @@ deactivate_process (proc) | |||
| 3634 | p->read_output_skip = Qnil; | 3634 | p->read_output_skip = Qnil; |
| 3635 | } | 3635 | } |
| 3636 | #endif | 3636 | #endif |
| 3637 | 3637 | ||
| 3638 | if (inchannel >= 0) | 3638 | if (inchannel >= 0) |
| 3639 | { | 3639 | { |
| 3640 | /* Beware SIGCHLD hereabouts. */ | 3640 | /* Beware SIGCHLD hereabouts. */ |
| @@ -3964,7 +3964,7 @@ server_accept_connection (server, channel) | |||
| 3964 | 3964 | ||
| 3965 | /* This variable is different from waiting_for_input in keyboard.c. | 3965 | /* This variable is different from waiting_for_input in keyboard.c. |
| 3966 | It is used to communicate to a lisp process-filter/sentinel (via the | 3966 | It is used to communicate to a lisp process-filter/sentinel (via the |
| 3967 | function Fwaiting_for_user_input_p below) whether emacs was waiting | 3967 | function Fwaiting_for_user_input_p below) whether Emacs was waiting |
| 3968 | for user-input when that process-filter was called. | 3968 | for user-input when that process-filter was called. |
| 3969 | waiting_for_input cannot be used as that is by definition 0 when | 3969 | waiting_for_input cannot be used as that is by definition 0 when |
| 3970 | lisp code is being evalled. | 3970 | lisp code is being evalled. |
| @@ -5060,7 +5060,7 @@ read_process_output (proc, channel) | |||
| 5060 | 5060 | ||
| 5061 | DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, | 5061 | DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, |
| 5062 | 0, 0, 0, | 5062 | 0, 0, 0, |
| 5063 | doc: /* Returns non-nil if emacs is waiting for input from the user. | 5063 | doc: /* Returns non-nil if Emacs is waiting for input from the user. |
| 5064 | This is intended for use by asynchronous process output filters and sentinels. */) | 5064 | This is intended for use by asynchronous process output filters and sentinels. */) |
| 5065 | () | 5065 | () |
| 5066 | { | 5066 | { |
| @@ -5443,7 +5443,7 @@ emacs_get_tty_pgrp (p) | |||
| 5443 | { | 5443 | { |
| 5444 | int gid = -1; | 5444 | int gid = -1; |
| 5445 | 5445 | ||
| 5446 | #ifdef TIOCGPGRP | 5446 | #ifdef TIOCGPGRP |
| 5447 | if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) | 5447 | if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) |
| 5448 | { | 5448 | { |
| 5449 | int fd; | 5449 | int fd; |
| @@ -5640,7 +5640,7 @@ process_send_signal (process, signo, current_group, nomsg) | |||
| 5640 | we should just assume that p->pid is also the process group id. */ | 5640 | we should just assume that p->pid is also the process group id. */ |
| 5641 | 5641 | ||
| 5642 | gid = emacs_get_tty_pgrp (p); | 5642 | gid = emacs_get_tty_pgrp (p); |
| 5643 | 5643 | ||
| 5644 | if (gid == -1) | 5644 | if (gid == -1) |
| 5645 | /* If we can't get the information, assume | 5645 | /* If we can't get the information, assume |
| 5646 | the shell owns the tty. */ | 5646 | the shell owns the tty. */ |
| @@ -5723,7 +5723,7 @@ process_send_signal (process, signo, current_group, nomsg) | |||
| 5723 | DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, | 5723 | DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, |
| 5724 | doc: /* Interrupt process PROCESS. | 5724 | doc: /* Interrupt process PROCESS. |
| 5725 | PROCESS may be a process, a buffer, or the name of a process or buffer. | 5725 | PROCESS may be a process, a buffer, or the name of a process or buffer. |
| 5726 | nil or no arg means current buffer's process. | 5726 | No arg or nil means current buffer's process. |
| 5727 | Second arg CURRENT-GROUP non-nil means send signal to | 5727 | Second arg CURRENT-GROUP non-nil means send signal to |
| 5728 | the current process-group of the process's controlling terminal | 5728 | the current process-group of the process's controlling terminal |
| 5729 | rather than to the process's own process group. | 5729 | rather than to the process's own process group. |
| @@ -6468,13 +6468,13 @@ DEFUN ("set-process-coding-system", Fset_process_coding_system, | |||
| 6468 | doc: /* Set coding systems of PROCESS to DECODING and ENCODING. | 6468 | doc: /* Set coding systems of PROCESS to DECODING and ENCODING. |
| 6469 | DECODING will be used to decode subprocess output and ENCODING to | 6469 | DECODING will be used to decode subprocess output and ENCODING to |
| 6470 | encode subprocess input. */) | 6470 | encode subprocess input. */) |
| 6471 | (proc, decoding, encoding) | 6471 | (process, decoding, encoding) |
| 6472 | register Lisp_Object proc, decoding, encoding; | 6472 | register Lisp_Object process, decoding, encoding; |
| 6473 | { | 6473 | { |
| 6474 | register struct Lisp_Process *p; | 6474 | register struct Lisp_Process *p; |
| 6475 | 6475 | ||
| 6476 | CHECK_PROCESS (proc); | 6476 | CHECK_PROCESS (process); |
| 6477 | p = XPROCESS (proc); | 6477 | p = XPROCESS (process); |
| 6478 | if (XINT (p->infd) < 0) | 6478 | if (XINT (p->infd) < 0) |
| 6479 | error ("Input file descriptor of %s closed", SDATA (p->name)); | 6479 | error ("Input file descriptor of %s closed", SDATA (p->name)); |
| 6480 | if (XINT (p->outfd) < 0) | 6480 | if (XINT (p->outfd) < 0) |
| @@ -6484,7 +6484,7 @@ encode subprocess input. */) | |||
| 6484 | 6484 | ||
| 6485 | p->decode_coding_system = decoding; | 6485 | p->decode_coding_system = decoding; |
| 6486 | p->encode_coding_system = encoding; | 6486 | p->encode_coding_system = encoding; |
| 6487 | setup_process_coding_systems (proc); | 6487 | setup_process_coding_systems (process); |
| 6488 | 6488 | ||
| 6489 | return Qnil; | 6489 | return Qnil; |
| 6490 | } | 6490 | } |
| @@ -6492,12 +6492,12 @@ encode subprocess input. */) | |||
| 6492 | DEFUN ("process-coding-system", | 6492 | DEFUN ("process-coding-system", |
| 6493 | Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0, | 6493 | Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0, |
| 6494 | doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */) | 6494 | doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */) |
| 6495 | (proc) | 6495 | (process) |
| 6496 | register Lisp_Object proc; | 6496 | register Lisp_Object process; |
| 6497 | { | 6497 | { |
| 6498 | CHECK_PROCESS (proc); | 6498 | CHECK_PROCESS (process); |
| 6499 | return Fcons (XPROCESS (proc)->decode_coding_system, | 6499 | return Fcons (XPROCESS (process)->decode_coding_system, |
| 6500 | XPROCESS (proc)->encode_coding_system); | 6500 | XPROCESS (process)->encode_coding_system); |
| 6501 | } | 6501 | } |
| 6502 | 6502 | ||
| 6503 | DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte, | 6503 | DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte, |
| @@ -6507,15 +6507,15 @@ If FLAG is non-nil, the filter is given multibyte strings. | |||
| 6507 | If FLAG is nil, the filter is given unibyte strings. In this case, | 6507 | If FLAG is nil, the filter is given unibyte strings. In this case, |
| 6508 | all character code conversion except for end-of-line conversion is | 6508 | all character code conversion except for end-of-line conversion is |
| 6509 | suppressed. */) | 6509 | suppressed. */) |
| 6510 | (proc, flag) | 6510 | (process, flag) |
| 6511 | Lisp_Object proc, flag; | 6511 | Lisp_Object process, flag; |
| 6512 | { | 6512 | { |
| 6513 | register struct Lisp_Process *p; | 6513 | register struct Lisp_Process *p; |
| 6514 | 6514 | ||
| 6515 | CHECK_PROCESS (proc); | 6515 | CHECK_PROCESS (process); |
| 6516 | p = XPROCESS (proc); | 6516 | p = XPROCESS (process); |
| 6517 | p->filter_multibyte = flag; | 6517 | p->filter_multibyte = flag; |
| 6518 | setup_process_coding_systems (proc); | 6518 | setup_process_coding_systems (process); |
| 6519 | 6519 | ||
| 6520 | return Qnil; | 6520 | return Qnil; |
| 6521 | } | 6521 | } |
| @@ -6523,13 +6523,13 @@ suppressed. */) | |||
| 6523 | DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, | 6523 | DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, |
| 6524 | Sprocess_filter_multibyte_p, 1, 1, 0, | 6524 | Sprocess_filter_multibyte_p, 1, 1, 0, |
| 6525 | doc: /* Return t if a multibyte string is given to PROCESS's filter.*/) | 6525 | doc: /* Return t if a multibyte string is given to PROCESS's filter.*/) |
| 6526 | (proc) | 6526 | (process) |
| 6527 | Lisp_Object proc; | 6527 | Lisp_Object process; |
| 6528 | { | 6528 | { |
| 6529 | register struct Lisp_Process *p; | 6529 | register struct Lisp_Process *p; |
| 6530 | 6530 | ||
| 6531 | CHECK_PROCESS (proc); | 6531 | CHECK_PROCESS (process); |
| 6532 | p = XPROCESS (proc); | 6532 | p = XPROCESS (process); |
| 6533 | 6533 | ||
| 6534 | return (NILP (p->filter_multibyte) ? Qnil : Qt); | 6534 | return (NILP (p->filter_multibyte) ? Qnil : Qt); |
| 6535 | } | 6535 | } |
| @@ -6747,11 +6747,11 @@ The value takes effect when `start-process' is called. */); | |||
| 6747 | #ifdef ADAPTIVE_READ_BUFFERING | 6747 | #ifdef ADAPTIVE_READ_BUFFERING |
| 6748 | DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering, | 6748 | DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering, |
| 6749 | doc: /* If non-nil, improve receive buffering by delaying after short reads. | 6749 | doc: /* If non-nil, improve receive buffering by delaying after short reads. |
| 6750 | On some systems, when emacs reads the output from a subprocess, the output data | 6750 | On some systems, when Emacs reads the output from a subprocess, the output data |
| 6751 | is read in very small blocks, potentially resulting in very poor performance. | 6751 | is read in very small blocks, potentially resulting in very poor performance. |
| 6752 | This behaviour can be remedied to some extent by setting this variable to a | 6752 | This behaviour can be remedied to some extent by setting this variable to a |
| 6753 | non-nil value, as it will automatically delay reading from such processes, to | 6753 | non-nil value, as it will automatically delay reading from such processes, to |
| 6754 | allowing them to produce more output before emacs tries to read it. | 6754 | allowing them to produce more output before Emacs tries to read it. |
| 6755 | If the value is t, the delay is reset after each write to the process; any other | 6755 | If the value is t, the delay is reset after each write to the process; any other |
| 6756 | non-nil value means that the delay is not reset on write. | 6756 | non-nil value means that the delay is not reset on write. |
| 6757 | The variable takes effect when `start-process' is called. */); | 6757 | The variable takes effect when `start-process' is called. */); |