mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-08 23:40:24 -08:00
*** empty log message ***
This commit is contained in:
parent
7e1dae733a
commit
9e2b097b26
6 changed files with 435 additions and 501 deletions
|
|
@ -325,7 +325,7 @@ case "${window_system}" in
|
|||
"" )
|
||||
echo " No window system specifed. Looking for X Windows."
|
||||
window_system=none
|
||||
if [ -r /usr/lib/libX11.a -a -d /usr/include/X11 ]; then
|
||||
if [ -r /usr/lib/libX11.a -o -d /usr/include/X11 ]; then
|
||||
window_system=x11
|
||||
fi
|
||||
;;
|
||||
|
|
|
|||
226
lib-src/timer.c
226
lib-src/timer.c
|
|
@ -1,155 +1,221 @@
|
|||
/*
|
||||
* timer.c --- daemon to provide a tagged interval timer service
|
||||
*
|
||||
* This little daemon runs forever waiting for signals. SIGIO (or SIGUSR1)
|
||||
* causes it to read an event spec from stdin; that is, a date followed by
|
||||
* colon followed by an event label. SIGALRM causes it to check its queue
|
||||
* for events attached to the current second; if one is found, its label
|
||||
* is written to stdout. SIGTERM causes it to terminate, printing a list
|
||||
* of pending events.
|
||||
*
|
||||
* This program is intended to be used with the lisp package called timer.el.
|
||||
* It was written anonymously in 1990. This version was documented and
|
||||
* rewritten for portability by esr@snark,thyrsus.com, Aug 7 1992.
|
||||
*/
|
||||
#include <stdio.h>
|
||||
#include <signal.h>
|
||||
#include <fcntl.h> /* FASYNC */
|
||||
#ifdef USG /* FASYNC for SysV */
|
||||
#include <sys/file.h>
|
||||
#endif
|
||||
#include <sys/time.h> /* itimer */
|
||||
#include <sys/types.h> /* time_t */
|
||||
|
||||
#include "../src/config.h"
|
||||
#ifdef USG
|
||||
#undef SIGIO
|
||||
#define SIGIO SIGUSR1
|
||||
#endif
|
||||
|
||||
extern int errno;
|
||||
extern char *sys_errlist[], *malloc();
|
||||
extern time_t time();
|
||||
|
||||
#define MAXEVENTS 256
|
||||
#define FS 1 /* field seperator for input */
|
||||
|
||||
struct event {
|
||||
/*
|
||||
* The field separator for input. This character shouldn't be legal in a date,
|
||||
* and should be printable so event strings are readable by people. Was
|
||||
* originally ';', then got changed to bogus `\001'.
|
||||
*/
|
||||
#define FS '@'
|
||||
|
||||
struct event
|
||||
{
|
||||
char *token;
|
||||
time_t reply_at;
|
||||
} *events[MAXEVENTS];
|
||||
}
|
||||
events[MAXEVENTS];
|
||||
|
||||
int slot; /* The next open place in the events array */
|
||||
int mevent = 0; /* 1+ the highest event number */
|
||||
char *pname; /* programme name for error messages */
|
||||
|
||||
/* Accepts a string of two fields seperated by a ';'
|
||||
/* Accepts a string of two fields seperated by FS.
|
||||
* First field is string for getdate, saying when to wake-up.
|
||||
* Second field is a token to identify the request.
|
||||
*/
|
||||
struct event *
|
||||
schedule(str)
|
||||
void schedule(str)
|
||||
char *str;
|
||||
|
||||
{
|
||||
extern time_t getdate();
|
||||
extern char *strcpy();
|
||||
time_t now;
|
||||
register char *p;
|
||||
static struct event e;
|
||||
static struct event *ep;
|
||||
|
||||
for(p = str; *p && *p != FS; p++);
|
||||
if (!*p) {
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr, "Timer sees: %s", str);
|
||||
#endif /* DEBUG */
|
||||
|
||||
/* check entry format */
|
||||
for(p = str; *p && *p != FS; p++)
|
||||
continue;
|
||||
if (!*p)
|
||||
{
|
||||
(void)fprintf(stderr, "%s: bad input format: %s", pname, str);
|
||||
return((struct event *)NULL);
|
||||
return;
|
||||
}
|
||||
*p++ = 0;
|
||||
|
||||
if ((e.reply_at = get_date(str, NULL)) - time(&now) < 0) {
|
||||
(void)fprintf(stderr, "%s: bad time spec: %s%c%s", pname, str, FS, p);
|
||||
return((struct event *)NULL);
|
||||
}
|
||||
/* allocate an event slot */
|
||||
for(ep = events; ep < events + MAXEVENTS; ep++)
|
||||
if (ep->token == (char *)NULL)
|
||||
break;
|
||||
if (ep == events + MAXEVENTS)
|
||||
(void) fprintf(stderr, "%s: too many events: %s", pname, str);
|
||||
|
||||
if ((e.token = malloc((unsigned)strlen(p) + 1)) == NULL) {
|
||||
/* don't allow users to schedule events in past time */
|
||||
else if ((ep->reply_at = get_date(str, NULL)) - time(&now) < 0)
|
||||
(void)fprintf(stderr, "%s: bad time spec: %s%c%s", pname, str, FS, p);
|
||||
|
||||
/* save the event description */
|
||||
else if ((ep->token = malloc((unsigned)strlen(p) + 1)) == NULL)
|
||||
(void)fprintf(stderr, "%s: malloc %s: %s%c%s",
|
||||
pname, sys_errlist[errno], str, FS, p);
|
||||
return((struct event *)NULL);
|
||||
}
|
||||
(void)strcpy(e.token,p);
|
||||
else
|
||||
{
|
||||
(void)strcpy(ep->token, p);
|
||||
|
||||
return(&e);
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr,
|
||||
"New event: %ld: %s", ep->reply_at, ep->token);
|
||||
#endif /* DEBUG */
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
notify()
|
||||
|
||||
{
|
||||
time_t now, tdiff;
|
||||
register int i, newmax = 0;
|
||||
/* I prefer using the interval timer rather than alarm(); the latter
|
||||
could be substituted if portability requires it. */
|
||||
struct itimerval itimer;
|
||||
time_t now, tdiff, waitfor = -1;
|
||||
register struct event *ep;
|
||||
|
||||
now = time((time_t *)NULL);
|
||||
slot = mevent;
|
||||
itimer.it_interval.tv_sec = itimer.it_interval.tv_usec = 0;
|
||||
itimer.it_value.tv_usec = 0;
|
||||
itimer.it_value.tv_sec = -1;
|
||||
|
||||
for(i=0; i < mevent; i++) {
|
||||
while (events[i] && events[i]->reply_at <= now) {
|
||||
(void)fputs(events[i]->token, stdout);
|
||||
free(events[i]->token);
|
||||
free((char *)events[i]);
|
||||
events[i] = 0;
|
||||
for(ep = events; ep < events + MAXEVENTS; ep++)
|
||||
if (ep->token)
|
||||
{
|
||||
/* any events ready to fire? */
|
||||
if (ep->reply_at <= now)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr,
|
||||
"Event %d firing: %ld @ %s",
|
||||
(ep - events), ep->reply_at, ep->token);
|
||||
#endif /* DEBUG */
|
||||
(void)fputs(ep->token, stdout);
|
||||
free(ep->token);
|
||||
ep->token = (char *)NULL;
|
||||
}
|
||||
else
|
||||
{
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr,
|
||||
"Event %d still waiting: %ld @ %s",
|
||||
(ep - events), ep->reply_at, ep->token);
|
||||
#endif /* DEBUG */
|
||||
|
||||
/* next timeout should be the soonest of any remaining */
|
||||
if ((tdiff = ep->reply_at - now) < waitfor || waitfor < 0)
|
||||
waitfor = (long)tdiff;
|
||||
}
|
||||
}
|
||||
|
||||
if (events[i]) {
|
||||
newmax = i+1;
|
||||
if ((tdiff = events[i]->reply_at - now) < (time_t)itimer.it_value.tv_sec
|
||||
|| itimer.it_value.tv_sec < 0)
|
||||
/* next timeout */
|
||||
itimer.it_value.tv_sec = (long)tdiff;
|
||||
} else {
|
||||
/* Keep slot as the lowest unused events element */
|
||||
if (i < slot) slot = i;
|
||||
}
|
||||
}
|
||||
/* if the array is full to mevent, slot should be the next available spot */
|
||||
if (slot > (mevent = newmax)) slot = mevent;
|
||||
/* If there's no more events, SIGIO should be next wake-up */
|
||||
if (mevent) (void)setitimer(ITIMER_REAL, &itimer, (struct itimerval *)NULL);
|
||||
if (waitfor != -1)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr,
|
||||
"Setting %d-second alarm\n", waitfor);
|
||||
#endif /* DEBUG */
|
||||
(void)alarm(waitfor);
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
getevent()
|
||||
|
||||
{
|
||||
extern char *fgets();
|
||||
struct event *ep;
|
||||
char buf[256];
|
||||
char buf[BUFSIZ];
|
||||
|
||||
/* in principle the itimer should be disabled on entry to this function,
|
||||
but it really doesn't make any important difference if it isn't */
|
||||
|
||||
if (fgets(buf, sizeof(buf), stdin) == NULL) exit(0);
|
||||
if (fgets(buf, sizeof(buf), stdin) == NULL)
|
||||
exit(0);
|
||||
|
||||
if (slot == MAXEVENTS)
|
||||
(void)fprintf(stderr, "%s: too many events: %s", pname, buf);
|
||||
/* register the event */
|
||||
schedule(buf);
|
||||
|
||||
else {
|
||||
if ((events[slot] = (struct event *)malloc((sizeof(struct event))))
|
||||
== NULL)
|
||||
(void)fprintf(stderr,"%s: malloc %s: %s", pname, sys_errlist[errno],buf);
|
||||
|
||||
else {
|
||||
if ((ep = schedule(buf)) == NULL)
|
||||
free((char *)events[slot]), events[slot] = 0;
|
||||
|
||||
else {
|
||||
memcpy((char *)events[slot],(char *)ep,sizeof(struct event));
|
||||
if (slot == mevent) mevent++;
|
||||
} /* schedule */
|
||||
} /* malloc */
|
||||
} /* limit events */
|
||||
/* timing, timing. Who knows what this interrupted, or if it said "now"? */
|
||||
/* Who knows what this interrupted, or if it said "now"? */
|
||||
notify();
|
||||
}
|
||||
|
||||
void
|
||||
sigcatch(sig)
|
||||
/* dispatch on incoming signal, then restore it */
|
||||
{
|
||||
struct event *ep;
|
||||
|
||||
switch(sig)
|
||||
{
|
||||
case SIGALRM:
|
||||
#ifdef DEBUG
|
||||
(void) fprintf(stderr, "Alarm signal received\n");
|
||||
#endif /* DEBUG */
|
||||
notify();
|
||||
break;
|
||||
case SIGIO:
|
||||
getevent();
|
||||
break;
|
||||
case SIGTERM:
|
||||
(void) fprintf(stderr, "Events still queued:\n");
|
||||
for (ep = events; ep < events + MAXEVENTS; ep++)
|
||||
if (ep->token)
|
||||
(void) fprintf(stderr, "%d = %ld @ %s",
|
||||
ep - events, ep->reply_at, ep->token);
|
||||
exit(0);
|
||||
break;
|
||||
}
|
||||
|
||||
/* required on older UNIXes; harmless on newer ones */
|
||||
(void) signal(sig, sigcatch);
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
int
|
||||
main(argc, argv)
|
||||
int argc;
|
||||
char **argv;
|
||||
|
||||
{
|
||||
for (pname = argv[0] + strlen(argv[0]); *pname != '/' && pname != argv[0];
|
||||
pname--);
|
||||
if (*pname == '/') pname++;
|
||||
|
||||
(void)signal(SIGIO, getevent);
|
||||
(void)signal(SIGALRM, notify);
|
||||
(void)signal(SIGIO, sigcatch);
|
||||
(void)signal(SIGALRM, sigcatch);
|
||||
(void)signal(SIGTERM, sigcatch);
|
||||
|
||||
#ifndef USG
|
||||
(void)fcntl(0, F_SETFL, FASYNC);
|
||||
#endif /* USG */
|
||||
|
||||
while (1) pause();
|
||||
}
|
||||
|
||||
/* timer.c ends here */
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
;;; diary.el --- diary functions.
|
||||
|
||||
;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
||||
;; Keyword: calendar
|
||||
;; Keywords: diary, calendar
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -76,11 +76,33 @@ calendar."
|
|||
(autoload 'check-calendar-holidays "holidays"
|
||||
"Check the list of holidays for any that occur on DATE.
|
||||
The value returned is a list of strings of relevant holiday descriptions.
|
||||
The holidays are those in the list calendar-holidays.")
|
||||
The holidays are those in the list calendar-holidays."
|
||||
t)
|
||||
|
||||
|
||||
(autoload 'calendar-holiday-list "holidays"
|
||||
"Form the list of holidays that occur on dates in the calendar window.
|
||||
The holidays are those in the list calendar-holidays.")
|
||||
The holidays are those in the list calendar-holidays."
|
||||
t)
|
||||
|
||||
(autoload 'diary-french-date "cal-french"
|
||||
"French calendar equivalent of date diary entry."
|
||||
t)
|
||||
|
||||
(autoload 'diary-mayan-date "cal-mayan"
|
||||
"Mayan calendar equivalent of date diary entry."
|
||||
t)
|
||||
|
||||
(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
|
||||
|
||||
(autoload 'diary-sunrise-sunset "solar"
|
||||
"Local time of sunrise and sunset as a diary entry."
|
||||
t)
|
||||
|
||||
(autoload 'diary-sabbath-candles "solar"
|
||||
"Local time of candle lighting diary entry--applies if date is a Friday.
|
||||
No diary entry if there is no sunset on that date."
|
||||
t)
|
||||
|
||||
(defvar diary-syntax-table
|
||||
(standard-syntax-table)
|
||||
|
|
@ -100,7 +122,7 @@ Makes all diary entries in the diary file invisible (using selective display),
|
|||
Returns a list of all relevant diary entries found, if any, in order by date.
|
||||
The list entries have the form ((month day year) string). If the variable
|
||||
`diary-list-include-blanks' is t, this list will include a dummy diary entry
|
||||
\(consisting of the empty string\) for a date with no diary entries.
|
||||
(consisting of the empty string) for a date with no diary entries.
|
||||
|
||||
After the list is prepared, the hooks `nongregorian-diary-listing-hook',
|
||||
`list-diary-entries-hook', and `diary-display-hook' are run. These hooks
|
||||
|
|
@ -273,8 +295,7 @@ changing the variable `diary-include-string'."
|
|||
(message msg)
|
||||
(set-buffer (get-buffer-create holiday-buffer))
|
||||
(setq buffer-read-only nil)
|
||||
(setq mode-line-format
|
||||
(format "--------------------------%s%%-" date-string))
|
||||
(calendar-set-mode-line date-string)
|
||||
(erase-buffer)
|
||||
(insert (mapconcat 'identity holiday-list "\n"))
|
||||
(goto-char (point-min))
|
||||
|
|
@ -282,11 +303,8 @@ changing the variable `diary-include-string'."
|
|||
(setq buffer-read-only t)
|
||||
(display-buffer holiday-buffer)
|
||||
(message "No diary entries for %s" date-string))
|
||||
(setq mode-line-format
|
||||
(format "%%*--%sDiary %s %s%s%s%%-"
|
||||
(if holiday-list "" "---------------")
|
||||
(if holiday-list "for" "entries for")
|
||||
date-string
|
||||
(calendar-set-mode-line
|
||||
(concat "Diary for " date-string
|
||||
(if holiday-list ": " "")
|
||||
(mapconcat 'identity holiday-list "; ")))
|
||||
(display-buffer (get-file-buffer d-file))
|
||||
|
|
@ -307,8 +325,7 @@ This function is provided for optional use as the `list-diary-entries-hook'."
|
|||
(message msg)
|
||||
(set-buffer (get-buffer-create holiday-buffer))
|
||||
(setq buffer-read-only nil)
|
||||
(setq mode-line-format
|
||||
(format "--------------------------%s%%-" date-string))
|
||||
(calendar-set-mode-line date-string)
|
||||
(erase-buffer)
|
||||
(insert (mapconcat 'identity holiday-list "\n"))
|
||||
(goto-char (point-min))
|
||||
|
|
@ -327,7 +344,7 @@ This function is provided for optional use as the `list-diary-entries-hook'."
|
|||
(set-buffer (get-buffer-create fancy-diary-buffer))
|
||||
(setq buffer-read-only nil)
|
||||
(make-local-variable 'mode-line-format)
|
||||
(setq mode-line-format "---------------------------Diary Entries%-")
|
||||
(calendar-set-mode-line "Diary Entries")
|
||||
(erase-buffer)
|
||||
(let ((entry-list diary-entries-list)
|
||||
(holiday-list)
|
||||
|
|
@ -386,38 +403,44 @@ This function is provided for optional use as the `list-diary-entries-hook'."
|
|||
(message "Preparing diary...done"))))
|
||||
|
||||
(defun print-diary-entries ()
|
||||
"Print a hard copy of the entries visible in the diary window.
|
||||
The hooks given by the variable `print-diary-entries-hook' are called after
|
||||
the temporary buffer of visible diary entries is prepared; it is the hooks
|
||||
that do the actual printing and kill the buffer."
|
||||
"Print a hard copy of the diary display.
|
||||
|
||||
If the simple diary display is being used, prepare a temp buffer with the
|
||||
visible lines of the diary buffer, add a heading line composed from the mode
|
||||
line, print the temp buffer, and destroy it.
|
||||
|
||||
If the fancy diary display is being used, just print the buffer.
|
||||
|
||||
The hooks given by the variable `print-diary-entries-hook' are called to do
|
||||
the actual printing."
|
||||
(interactive)
|
||||
(let ((diary-buffer (get-file-buffer (substitute-in-file-name diary-file))))
|
||||
(if (bufferp (get-buffer fancy-diary-buffer))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer fancy-diary-buffer))
|
||||
(run-hooks 'print-diary-entries-hook))
|
||||
(let ((diary-buffer
|
||||
(get-file-buffer (substitute-in-file-name diary-file))))
|
||||
(if diary-buffer
|
||||
(let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")))
|
||||
(let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
|
||||
(heading))
|
||||
(save-excursion
|
||||
(set-buffer diary-buffer)
|
||||
(setq heading
|
||||
(if (not (stringp mode-line-format))
|
||||
"All Diary Entries"
|
||||
(string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
|
||||
(substring mode-line-format
|
||||
(match-beginning 1) (match-end 1))))
|
||||
(copy-to-buffer temp-buffer (point-min) (point-max))
|
||||
(set-buffer temp-buffer)
|
||||
(while (re-search-forward "\^M.*$" nil t)
|
||||
(replace-match ""))
|
||||
(run-hooks 'print-diary-entries-hook)))
|
||||
(error "You don't have a diary buffer!"))))
|
||||
|
||||
(defun add-diary-heading ()
|
||||
"Add a heading to the diary entries for printing.
|
||||
The heading is formed from the mode line of the diary buffer. This function
|
||||
is used in the default value of the variable `print-diary-entry-hooks'."
|
||||
(save-excursion
|
||||
(let ((heading))
|
||||
(set-buffer diary-buffer)
|
||||
(setq heading mode-line-format)
|
||||
(string-match "%\\*-*\\([^-].*\\)%-$" heading)
|
||||
(setq heading
|
||||
(substring heading (match-beginning 1) (match-end 1)))
|
||||
(set-buffer temp-buffer)
|
||||
(goto-char (point-min))
|
||||
(insert heading "\n"
|
||||
(make-string (length heading) ?=) "\n"))))
|
||||
(make-string (length heading) ?=) "\n")
|
||||
(run-hooks 'print-diary-entries-hook)
|
||||
(kill-buffer temp-buffer)))
|
||||
(error "You don't have a diary buffer!")))))
|
||||
|
||||
(defun show-all-diary-entries ()
|
||||
"Show all of the diary entries in the diary-file.
|
||||
|
|
@ -438,8 +461,7 @@ is created."
|
|||
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
||||
(setq selective-display nil)
|
||||
(make-local-variable 'mode-line-format)
|
||||
(setq mode-line-format
|
||||
"%*---------------------------All Diary Entries%-")
|
||||
(setq mode-line-format default-mode-line-format)
|
||||
(display-buffer (current-buffer))
|
||||
(set-buffer-modified-p diary-modified))))
|
||||
(error "Your diary file is not readable!"))
|
||||
|
|
@ -718,6 +740,10 @@ A value of 0 in any position of the pattern is a wild-card."
|
|||
(mark-visible-calendar-date (list month i year)))
|
||||
(mark-visible-calendar-date (list month p-day year)))))
|
||||
|
||||
(defun sort-diary-entries ()
|
||||
"Sort the list of diary entries by time of day."
|
||||
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
|
||||
|
||||
(defun diary-entry-compare (e1 e2)
|
||||
"Returns t if E1 is earlier than E2."
|
||||
(or (calendar-date-compare e1 e2)
|
||||
|
|
@ -757,7 +783,7 @@ and XX:XXam or XX:XXpm."
|
|||
(defun list-hebrew-diary-entries ()
|
||||
"Add any Hebrew date entries from the diary-file to diary-entries-list.
|
||||
Hebrew date diary entries must be prefaced by a hebrew-diary-entry-symbol
|
||||
\(normally an `H'\). The same diary-date-forms govern the style of the Hebrew
|
||||
(normally an `H'). The same diary-date-forms govern the style of the Hebrew
|
||||
calendar entries, except that the Hebrew month names must be spelled in full.
|
||||
The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
|
||||
Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
|
||||
|
|
@ -841,7 +867,7 @@ nongregorian-diary-listing-hook."
|
|||
"Mark days in the calendar window that have Hebrew date diary entries.
|
||||
Each entry in diary-file (or included files) visible in the calendar window
|
||||
is marked. Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
|
||||
\(normally an `H'\). The same diary-date-forms govern the style of the Hebrew
|
||||
(normally an `H'). The same diary-date-forms govern the style of the Hebrew
|
||||
calendar entries, except that the Hebrew month names must be spelled in full.
|
||||
The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
|
||||
Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
|
||||
|
|
@ -1104,6 +1130,28 @@ A number of built-in functions are available for this type of diary entry:
|
|||
made every day. Note that since there is no text, it
|
||||
makes sense only if the fancy diary display is used.
|
||||
|
||||
%%(diary-astro-day-number) Diary entries giving the corresponding
|
||||
astronomical (Julian) day number will be made every day.
|
||||
Note that since there is no text, it makes sense only if the
|
||||
fancy diary display is used.
|
||||
|
||||
%%(diary-julian-date) Diary entries giving the corresponding
|
||||
Julian date will be made every day. Note that since
|
||||
there is no text, it makes sense only if the fancy diary
|
||||
display is used.
|
||||
|
||||
%%(diary-sunrise-sunset)
|
||||
Diary entries giving the local times of sunrise and sunset
|
||||
will be made every day. Note that since there is no text,
|
||||
it makes sense only if the fancy diary display is used.
|
||||
Floating point required.
|
||||
|
||||
%%(diary-phases-of-moon)
|
||||
Diary entries giving the times of the phases of the moon
|
||||
will be when appropriate. Note that since there is no text,
|
||||
it makes sense only if the fancy diary display is used.
|
||||
Floating point required.
|
||||
|
||||
%%(diary-yahrzeit MONTH DAY YEAR) text
|
||||
Text is assumed to be the name of the person; the date is
|
||||
the date of death on the *civil* calendar. The diary entry
|
||||
|
|
@ -1111,6 +1159,12 @@ A number of built-in functions are available for this type of diary entry:
|
|||
day before. (If `european-calendar-style' is t, the order
|
||||
of the parameters should be changed to DAY, MONTH, YEAR.)
|
||||
|
||||
%%(diary-sunrise-sunset)
|
||||
Diary entries giving the local times of Sabbath candle
|
||||
lighting will be made every day. Note that since there is
|
||||
no text, it makes sense only if the fancy diary display is
|
||||
used. Floating point required.
|
||||
|
||||
%%(diary-rosh-hodesh)
|
||||
Diary entries will be made on the dates of Rosh Hodesh on
|
||||
the Hebrew calendar. Note that since there is no text, it
|
||||
|
|
@ -1288,48 +1342,35 @@ ending of that number (that is, `st', `nd', `rd' or `th', as appropriate."
|
|||
|
||||
(defun diary-islamic-date ()
|
||||
"Islamic calendar equivalent of date diary entry."
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname " " year)
|
||||
'(monthname " " day ", " year)))
|
||||
(i-date (calendar-islamic-from-absolute
|
||||
(let* ((i-date (calendar-islamic-from-absolute
|
||||
(calendar-absolute-from-gregorian date)))
|
||||
(calendar-month-name-array calendar-islamic-month-name-array))
|
||||
(if (>= (extract-calendar-year i-date) 1)
|
||||
(format "Islamic date: %s" (calendar-date-string i-date)))))
|
||||
(format "Islamic date: %s" (calendar-date-string i-date nil t)))))
|
||||
|
||||
(defun diary-hebrew-date ()
|
||||
"Hebrew calendar equivalent of date diary entry."
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname " " year)
|
||||
'(monthname " " day ", " year)))
|
||||
(h-date (calendar-hebrew-from-absolute
|
||||
(let* ((h-date (calendar-hebrew-from-absolute
|
||||
(calendar-absolute-from-gregorian date)))
|
||||
(calendar-month-name-array
|
||||
(if (hebrew-calendar-leap-year-p
|
||||
(extract-calendar-year h-date))
|
||||
calendar-hebrew-month-name-array-leap-year
|
||||
calendar-hebrew-month-name-array-common-year)))
|
||||
(format "Hebrew date: %s" (calendar-date-string h-date))))
|
||||
(format "Hebrew date: %s" (calendar-date-string h-date nil t))))
|
||||
|
||||
(defun diary-french-date ()
|
||||
"French calendar equivalent of date diary entry."
|
||||
(let* ((french-date (calendar-french-from-absolute
|
||||
(defun diary-julian-date ()
|
||||
"Julian calendar equivalent of date diary entry."
|
||||
(format "Julian date: %s"
|
||||
(calendar-date-string
|
||||
(calendar-julian-from-absolute
|
||||
(calendar-absolute-from-gregorian date)))
|
||||
(y (extract-calendar-year french-date))
|
||||
(m (extract-calendar-month french-date))
|
||||
(d (extract-calendar-day french-date)))
|
||||
(if (> y 0)
|
||||
(if (= m 13)
|
||||
(format "Jour %s de l'Annee %d de la Revolution"
|
||||
(aref french-calendar-special-days-array (1- d))
|
||||
y)
|
||||
(format "Decade %s, %s de %s de l'Annee %d de la Revolution"
|
||||
(make-string (1+ (/ (1- d) 10)) ?I)
|
||||
(aref french-calendar-day-name-array (% (1- d) 10))
|
||||
(aref french-calendar-month-name-array (1- m))
|
||||
y)))))
|
||||
nil t))
|
||||
|
||||
(defun diary-astro-day-number ()
|
||||
"Astronomical (Julian) day number diary entry."
|
||||
(format "Astronomical (Julian) day number %d"
|
||||
(+ 1721425 (calendar-absolute-from-gregorian date))))
|
||||
|
||||
(defun diary-omer ()
|
||||
"Omer count diary entry--entry applies if date is within 50 days after
|
||||
|
|
@ -1412,7 +1453,7 @@ before, or the Saturday before."
|
|||
(if (= h-yesterday 30)
|
||||
(format "%s (second day)" this-month)
|
||||
this-month)))
|
||||
(if (= (mod d 7) 6);; Saturday--check for Shabbat Mevarhim
|
||||
(if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
|
||||
(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
|
||||
(format "Mevarhim Rosh Hodesh %s (%s)"
|
||||
(aref h-month-names
|
||||
|
|
@ -1428,7 +1469,7 @@ before, or the Saturday before."
|
|||
"tomorrow"
|
||||
(aref calendar-day-name-array (- 29 h-day)))
|
||||
(aref calendar-day-name-array
|
||||
(mod (- 30 h-day) 7)))))
|
||||
(% (- 30 h-day) 7)))))
|
||||
(if (and (= h-day 29) (/= h-month 6))
|
||||
(format "Erev Rosh Hodesh %s"
|
||||
(aref h-month-names
|
||||
|
|
@ -1525,25 +1566,25 @@ start on Tuesday.")
|
|||
|
||||
(defconst hebrew-calendar-year-Monday-complete-Thursday
|
||||
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
|
||||
23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34.35) (35.36)
|
||||
(36.37) (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
|
||||
(36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Monday,
|
||||
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
|
||||
start on Thursday.")
|
||||
|
||||
(defconst hebrew-calendar-year-Tuesday-regular-Thursday
|
||||
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
|
||||
23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34.35) (35.36)
|
||||
(36.37) (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
|
||||
(36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Tuesday,
|
||||
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
|
||||
start on Thursday.")
|
||||
|
||||
(defconst hebrew-calendar-year-Thursday-regular-Saturday
|
||||
[52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
|
||||
23 24 nil (nil . 25) (25.[26 27]) ([26 27].[28 29]) ([28 29].30) (30.31)
|
||||
([31 32].32) 33 34 35 36 37 38 39 40 [41 42]
|
||||
43 44 45 46 47 48 49 50]
|
||||
[52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23
|
||||
24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
|
||||
(30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
|
||||
49 50]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Thursday,
|
||||
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
|
||||
start on Saturday.")
|
||||
|
|
@ -1568,34 +1609,34 @@ start on Tuesday.")
|
|||
|
||||
(defconst hebrew-calendar-year-Saturday-complete-Thursday
|
||||
[nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
|
||||
23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34.35) (35.36) (36.37)
|
||||
(37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
|
||||
(36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Saturday,
|
||||
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
|
||||
start on Thursday.")
|
||||
|
||||
(defconst hebrew-calendar-year-Monday-incomplete-Thursday
|
||||
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
|
||||
23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34.35) (35.36) (36.37)
|
||||
(37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
|
||||
(36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Monday,
|
||||
is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover
|
||||
start on Thursday.")
|
||||
|
||||
(defconst hebrew-calendar-year-Monday-complete-Saturday
|
||||
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
|
||||
23 24 25 26 27 nil (nil . 28) (28.29) (29.30) (30.31) (31.32) (32.33)
|
||||
(33.34) (34.35) (35.36) (36.37) (37.38) (38.39) (39.40) (40.41) ([41 42].42)
|
||||
43 44 45 46 47 48 49 50]
|
||||
23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
|
||||
(32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
|
||||
(39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Monday,
|
||||
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
|
||||
start on Saturday.")
|
||||
|
||||
(defconst hebrew-calendar-year-Tuesday-regular-Saturday
|
||||
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
|
||||
23 24 25 26 27 nil (nil . 28) (28.29) (29.30) (30.31) (31.32) (32.33)
|
||||
(33.34) (34.35) (35.36) (36.37) (37.38) (38.39) (39.40) (40.41) ([41 42].42)
|
||||
43 44 45 46 47 48 49 50]
|
||||
23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
|
||||
(32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
|
||||
(39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
|
||||
"The structure of the parashiot in a Hebrew year that starts on Tuesday,
|
||||
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
|
||||
start on Saturday.")
|
||||
|
|
@ -1627,7 +1668,7 @@ start on Tuesday.")
|
|||
(defun list-islamic-diary-entries ()
|
||||
"Add any Islamic date entries from the diary-file to diary-entries-list.
|
||||
Islamic date diary entries must be prefaced by an islamic-diary-entry-symbol
|
||||
\(normally an `I'\). The same diary-date-forms govern the style of the Islamic
|
||||
(normally an `I'). The same diary-date-forms govern the style of the Islamic
|
||||
calendar entries, except that the Islamic month names must be spelled in full.
|
||||
The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
|
||||
Dhu al-Hijjah. If an Islamic date diary entry begins with a
|
||||
|
|
@ -1710,7 +1751,7 @@ nongregorian-diary-listing-hook."
|
|||
"Mark days in the calendar window that have Islamic date diary entries.
|
||||
Each entry in diary-file (or included files) visible in the calendar window
|
||||
is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol
|
||||
\(normally an `I'\). The same diary-date-forms govern the style of the Islamic
|
||||
(normally an `I'). The same diary-date-forms govern the style of the Islamic
|
||||
calendar entries, except that the Islamic month names must be spelled in full.
|
||||
The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
|
||||
Dhu al-Hijjah. Islamic date diary entries that begin with a
|
||||
|
|
@ -1870,246 +1911,6 @@ MONTH/DAY/YEAR. A value of 0 in any position is a wild-card."
|
|||
(mark-visible-calendar-date
|
||||
(calendar-gregorian-from-absolute date)))))))))
|
||||
|
||||
(defun make-diary-entry (string &optional nonmarking file)
|
||||
"Insert a diary entry STRING which may be NONMARKING in FILE.
|
||||
If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
|
||||
(find-file-other-window
|
||||
(substitute-in-file-name (if file file diary-file)))
|
||||
(goto-char (point-max))
|
||||
(insert
|
||||
(if (bolp) "" "\n")
|
||||
(if nonmarking diary-nonmarking-symbol "")
|
||||
string " "))
|
||||
|
||||
(defun insert-diary-entry (arg)
|
||||
"Insert a diary entry for the date indicated by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname " " year)
|
||||
'(monthname " " day ", " year))))
|
||||
(make-diary-entry
|
||||
(calendar-date-string
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))
|
||||
t)
|
||||
arg)))
|
||||
|
||||
(defun insert-weekly-diary-entry (arg)
|
||||
"Insert a weekly diary entry for the day of the week indicated by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(make-diary-entry
|
||||
(calendar-day-name
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!")))
|
||||
arg))
|
||||
|
||||
(defun insert-monthly-diary-entry (arg)
|
||||
"Insert a monthly diary entry for the day of the month indicated by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " * ")
|
||||
'("* " day))))
|
||||
(make-diary-entry
|
||||
(calendar-date-string
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))
|
||||
t)
|
||||
arg)))
|
||||
|
||||
(defun insert-yearly-diary-entry (arg)
|
||||
"Insert an annual diary entry for the day of the year indicated by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname)
|
||||
'(monthname " " day))))
|
||||
(make-diary-entry
|
||||
(calendar-date-string
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))
|
||||
t)
|
||||
arg)))
|
||||
|
||||
(defun insert-anniversary-diary-entry (arg)
|
||||
"Insert an anniversary diary entry for the date given by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " month " " year)
|
||||
'(month " " day " " year))))
|
||||
(make-diary-entry
|
||||
(format "%s(diary-anniversary %s)"
|
||||
sexp-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))
|
||||
arg)))
|
||||
|
||||
(defun insert-block-diary-entry (arg)
|
||||
"Insert a block diary entry for the days between the point and marked date.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " month " " year)
|
||||
'(month " " day " " year)))
|
||||
(cursor (or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!")))
|
||||
(mark (or (car calendar-mark-ring)
|
||||
(error "No mark set in this buffer")))
|
||||
(start)
|
||||
(end))
|
||||
(if (< (calendar-absolute-from-gregorian mark)
|
||||
(calendar-absolute-from-gregorian cursor))
|
||||
(setq start mark
|
||||
end cursor)
|
||||
(setq start cursor
|
||||
end mark))
|
||||
(make-diary-entry
|
||||
(format "%s(diary-block %s %s)"
|
||||
sexp-diary-entry-symbol
|
||||
(calendar-date-string start)
|
||||
(calendar-date-string end))
|
||||
arg)))
|
||||
|
||||
(defun insert-cyclic-diary-entry (arg)
|
||||
"Insert a cyclic diary entry starting at the date given by point.
|
||||
Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " month " " year)
|
||||
'(month " " day " " year))))
|
||||
(make-diary-entry
|
||||
(format "%s(diary-cyclic %d %s)"
|
||||
sexp-diary-entry-symbol
|
||||
(calendar-read "Repeat every how many days: "
|
||||
'(lambda (x) (> x 0)))
|
||||
(calendar-date-string
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))
|
||||
arg)))
|
||||
|
||||
(defun insert-hebrew-diary-entry (arg)
|
||||
"Insert a diary entry for the Hebrew date corresponding to the date
|
||||
indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname " " year)
|
||||
'(monthname " " day ", " year)))
|
||||
(calendar-month-name-array
|
||||
calendar-hebrew-month-name-array-leap-year))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
hebrew-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-hebrew-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(defun insert-monthly-hebrew-diary-entry (arg)
|
||||
"Insert a monthly diary entry for the day of the Hebrew month corresponding
|
||||
to the date indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style '(day " * ") '("* " day )))
|
||||
(calendar-month-name-array
|
||||
calendar-hebrew-month-name-array-leap-year))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
hebrew-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-hebrew-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(defun insert-yearly-hebrew-diary-entry (arg)
|
||||
"Insert an annual diary entry for the day of the Hebrew year corresponding
|
||||
to the date indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname)
|
||||
'(monthname " " day)))
|
||||
(calendar-month-name-array
|
||||
calendar-hebrew-month-name-array-leap-year))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
hebrew-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-hebrew-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(defun insert-islamic-diary-entry (arg)
|
||||
"Insert a diary entry for the Islamic date corresponding to the date
|
||||
indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname " " year)
|
||||
'(monthname " " day ", " year)))
|
||||
(calendar-month-name-array calendar-islamic-month-name-array))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
islamic-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-islamic-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(defun insert-monthly-islamic-diary-entry (arg)
|
||||
"Insert a monthly diary entry for the day of the Islamic month corresponding
|
||||
to the date indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style '(day " * ") '("* " day )))
|
||||
(calendar-month-name-array calendar-islamic-month-name-array))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
islamic-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-islamic-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(defun insert-yearly-islamic-diary-entry (arg)
|
||||
"Insert an annual diary entry for the day of the Islamic year corresponding
|
||||
to the date indicated by point. Prefix arg will make the entry nonmarking."
|
||||
(interactive "P")
|
||||
(let* ((calendar-date-display-form
|
||||
(if european-calendar-style
|
||||
'(day " " monthname)
|
||||
'(monthname " " day)))
|
||||
(calendar-month-name-array calendar-islamic-month-name-array))
|
||||
(make-diary-entry
|
||||
(concat
|
||||
islamic-diary-entry-symbol
|
||||
(calendar-date-string
|
||||
(calendar-islamic-from-absolute
|
||||
(calendar-absolute-from-gregorian
|
||||
(or (calendar-cursor-to-date)
|
||||
(error "Cursor is not on a date!"))))))
|
||||
arg)))
|
||||
|
||||
(provide 'diary)
|
||||
|
||||
;;; diary.el ends here
|
||||
|
|
|
|||
|
|
@ -8,7 +8,9 @@
|
|||
|
||||
;; Subsequently modified by RMS.
|
||||
|
||||
(defconst byte-compile-version "FSF 2.1")
|
||||
;;; This version incorporates changes up to version 2.08 of the
|
||||
;;; Zawinski-Furuseth compiler.
|
||||
(defconst byte-compile-version "FSF 2.08")
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -95,9 +97,13 @@
|
|||
;;; generic emacs 18.
|
||||
;;; byte-compile-single-version Normally the byte-compiler will consult the
|
||||
;;; above two variables at runtime, but if this
|
||||
;;; variable is true when the compiler itself is
|
||||
;;; is true before the compiler itself is loaded/
|
||||
;;; compiled, then the runtime checks will not be
|
||||
;;; made, and compilation will be slightly faster.
|
||||
;;; To use this, start up a fresh emacs, set this
|
||||
;;; to t, reload the compiler's .el files, and
|
||||
;;; recompile. Don't do this in an emacs that has
|
||||
;;; already had the compiler loaded.
|
||||
;;; byte-compile-overwrite-file If nil, delete old .elc files before saving.
|
||||
|
||||
;;; New Features:
|
||||
|
|
@ -242,19 +248,17 @@ If it is 'byte, then only byte-level optimizations will be logged.")
|
|||
of `message.'")
|
||||
|
||||
(defconst byte-compile-warning-types '(redefine callargs free-vars unresolved))
|
||||
(defvar byte-compile-warnings (not noninteractive)
|
||||
(defvar byte-compile-warnings t
|
||||
"*List of warnings that the byte-compiler should issue (t for all).
|
||||
Valid elements of this list are:
|
||||
`free-vars' (references to variables not in the
|
||||
current lexical scope)
|
||||
`unresolved' (calls to unknown functions)
|
||||
`callargs' (lambda calls with args that don't
|
||||
match the lambda's definition)
|
||||
`redefine' (function cell redefined from
|
||||
a macro to a lambda or vice versa,
|
||||
or redefined to take other args)
|
||||
This variable defaults to nil in -batch mode, which is
|
||||
slightly faster.")
|
||||
Elements of the list may be be:
|
||||
|
||||
free-vars references to variables not in the current lexical scope.
|
||||
unresolved calls to unknown functions.
|
||||
callargs lambda calls with args that don't match the definition.
|
||||
redefine function cell redefined from a macro to a lambda or vice
|
||||
versa, or redefined to take a different number of arguments.
|
||||
|
||||
See also the macro byte-compiler-options.")
|
||||
|
||||
(defvar byte-compile-generate-call-tree nil
|
||||
"*Non-nil means collect call-graph information when compiling.
|
||||
|
|
@ -388,7 +392,7 @@ Each element is (INDEX . VALUE)")
|
|||
(byte-defop 24 -1 byte-varbind "for binding a variable")
|
||||
(byte-defop 32 0 byte-call "for calling a function")
|
||||
(byte-defop 40 0 byte-unbind "for unbinding special bindings")
|
||||
;; codes 41-47 are consumed by the preceeding opcodes
|
||||
;; codes 8-47 are consumed by the preceeding opcodes
|
||||
|
||||
;; unused: 48-55
|
||||
|
||||
|
|
@ -684,7 +688,7 @@ otherwise pop it")
|
|||
|
||||
(defconst byte-compile-last-warned-form nil)
|
||||
|
||||
(defun byte-compile-log-1 (string)
|
||||
(defun byte-compile-log-1 (string &optional fill)
|
||||
(cond (noninteractive
|
||||
(if (or byte-compile-current-file
|
||||
(and byte-compile-last-warned-form
|
||||
|
|
@ -719,7 +723,12 @@ otherwise pop it")
|
|||
(insert " in buffer "
|
||||
(buffer-name byte-compile-current-file))))
|
||||
(insert ":\n")))
|
||||
(insert " " string "\n"))))
|
||||
(insert " " string "\n")
|
||||
(if (and fill (not (string-match "\n" string)))
|
||||
(let ((fill-prefix " ")
|
||||
(fill-column 78))
|
||||
(fill-paragraph nil)))
|
||||
)))
|
||||
(setq byte-compile-current-file nil
|
||||
byte-compile-last-warned-form byte-compile-current-form))
|
||||
|
||||
|
|
@ -727,7 +736,7 @@ otherwise pop it")
|
|||
(setq format (apply 'format format args))
|
||||
(if byte-compile-error-on-warn
|
||||
(error "%s" format) ; byte-compile-file catches and logs it
|
||||
(byte-compile-log-1 (concat "** " format))
|
||||
(byte-compile-log-1 (concat "** " format) t)
|
||||
;;; It is useless to flash warnings too fast to be read.
|
||||
;;; Besides, they will all be shown at the end.
|
||||
;;; (or noninteractive ; already written on stdout.
|
||||
|
|
@ -737,10 +746,11 @@ otherwise pop it")
|
|||
;;; This function should be used to report errors that have halted
|
||||
;;; compilation of the current file.
|
||||
(defun byte-compile-report-error (error-info)
|
||||
(setq format (format (if (cdr error-info) "%s (%s)" "%s")
|
||||
(byte-compile-log-1
|
||||
(concat "!! "
|
||||
(format (if (cdr error-info) "%s (%s)" "%s")
|
||||
(get (car error-info) 'error-message)
|
||||
(prin1-to-string (cdr error-info))))
|
||||
(byte-compile-log-1 (concat "!! " format)))
|
||||
(prin1-to-string (cdr error-info))))))
|
||||
|
||||
;;; Used by make-obsolete.
|
||||
(defun byte-compile-obsolete (form)
|
||||
|
|
@ -1036,26 +1046,49 @@ This is if a `.elc' file exists but is older than the `.el' file.
|
|||
|
||||
If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
|
||||
But a prefix argument (optional second arg) means ask user,
|
||||
for each such `.el' file, whether to compile it."
|
||||
for each such `.el' file, whether to compile it. Prefix argument 0 means
|
||||
don't ask and compile the file anyway."
|
||||
(interactive "DByte recompile directory: \nP")
|
||||
(save-some-buffers)
|
||||
(set-buffer-modified-p (buffer-modified-p)) ;Update the mode line.
|
||||
(setq directory (expand-file-name directory))
|
||||
(let ((files (directory-files directory nil emacs-lisp-file-regexp))
|
||||
(count 0)
|
||||
(let ((directories (list (expand-file-name directory)))
|
||||
(file-count 0)
|
||||
(dir-count 0)
|
||||
last-dir)
|
||||
(displaying-byte-compile-warnings
|
||||
(while directories
|
||||
(setq directory (car directories))
|
||||
(message "Checking %s..." directory)
|
||||
(let ((files (directory-files directory))
|
||||
source dest)
|
||||
(while files
|
||||
(if (and (not (auto-save-file-name-p (car files)))
|
||||
(setq source (expand-file-name (car files) directory))
|
||||
(if (and (not (member (car files) '("." ".." "RCS" "CVS")))
|
||||
(file-directory-p source))
|
||||
(if (or (null arg)
|
||||
(eq arg 0)
|
||||
(y-or-n-p (concat "Check " source "? ")))
|
||||
(setq directories
|
||||
(nconc directories (list source))))
|
||||
(if (and (string-match emacs-lisp-file-regexp source)
|
||||
(not (auto-save-file-name-p source))
|
||||
(setq dest (byte-compile-dest-file source))
|
||||
(if (file-exists-p dest)
|
||||
(file-newer-than-file-p source dest)
|
||||
(and arg (y-or-n-p (concat "Compile " source "? ")))))
|
||||
(and arg
|
||||
(or (zerop arg)
|
||||
(y-or-n-p (concat "Compile " source "? "))))))
|
||||
(progn (byte-compile-file source)
|
||||
(setq count (1+ count))))
|
||||
(setq files (cdr files)))
|
||||
(message "Done (Total of %d file%s compiled)"
|
||||
count (if (= count 1) "" "s"))))
|
||||
(setq file-count (1+ file-count))
|
||||
(if (not (eq last-dir directory))
|
||||
(setq last-dir directory
|
||||
dir-count (1+ dir-count)))
|
||||
)))
|
||||
(setq files (cdr files))))
|
||||
(setq directories (cdr directories))))
|
||||
(message "Done (Total of %d file%s compiled%s)"
|
||||
file-count (if (= file-count 1) "" "s")
|
||||
(if (> dir-count 1) (format " in %d directories" dir-count) ""))))
|
||||
|
||||
;;;###autoload
|
||||
(defun byte-compile-file (filename &optional load)
|
||||
|
|
@ -1276,7 +1309,8 @@ With argument, insert value in current buffer after the form."
|
|||
(stringp (nth 3 form)))
|
||||
(byte-compile-output-docform '("\n(" 3 ")") form)
|
||||
(let ((print-escape-newlines t)
|
||||
(print-readably t))
|
||||
(print-readably t) ; print #[] for bytecode, 'x for (quote x)
|
||||
(print-gensym nil)) ; this is too dangerous for now
|
||||
(princ "\n" outbuffer)
|
||||
(prin1 form outbuffer)
|
||||
nil)))
|
||||
|
|
@ -1289,7 +1323,8 @@ With argument, insert value in current buffer after the form."
|
|||
(insert (car info))
|
||||
(let ((docl (nthcdr (nth 1 info) form))
|
||||
(print-escape-newlines t)
|
||||
(print-readably t))
|
||||
(print-readably t) ; print #[] for bytecode, 'x for (quote x)
|
||||
(print-gensym nil)) ; this is too dangerous for now
|
||||
(prin1 (car form) outbuffer)
|
||||
(while (setq form (cdr form))
|
||||
(insert " ")
|
||||
|
|
@ -1813,6 +1848,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
((symbolp (car form))
|
||||
(let* ((fn (car form))
|
||||
(handler (get fn 'byte-compile)))
|
||||
(if (memq fn '(t nil))
|
||||
(byte-compile-warn "%s called as a function" fn))
|
||||
(if (and handler
|
||||
(or (byte-compile-version-cond
|
||||
byte-compile-compatibility)
|
||||
|
|
@ -1846,6 +1883,12 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
"Variable reference to %s %s")
|
||||
(if (symbolp var) "constant" "nonvariable")
|
||||
(prin1-to-string var))
|
||||
(if (get var 'byte-obsolete-variable)
|
||||
(let ((ob (get var 'byte-obsolete-variable)))
|
||||
(byte-compile-warn "%s is an obsolete variable; %s" var
|
||||
(if (stringp ob)
|
||||
ob
|
||||
(format "use %s instead." ob)))))
|
||||
(if (memq 'free-vars byte-compile-warnings)
|
||||
(if (eq base-op 'byte-varbind)
|
||||
(setq byte-compile-bound-variables
|
||||
|
|
@ -1933,6 +1976,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
;; be used when byte-compile-compatibility is true.
|
||||
(if (and (byte-compile-single-version)
|
||||
(not byte-compile-compatibility))
|
||||
;; #### instead of doing nothing, this should do some remprops,
|
||||
;; #### to protect against the case where a single-version compiler
|
||||
;; #### is loaded into a world that has contained a multi-version one.
|
||||
nil
|
||||
(list 'progn
|
||||
(list 'put
|
||||
|
|
@ -2020,7 +2066,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(byte-defop-compiler get 2)
|
||||
(byte-defop-compiler nth 2)
|
||||
(byte-defop-compiler substring 2-3)
|
||||
(byte-defop-compiler (move-marker byte-set-marker) 2-3)
|
||||
(byte-defop-compiler19 (move-marker byte-set-marker) 2-3)
|
||||
(byte-defop-compiler19 set-marker 2-3)
|
||||
(byte-defop-compiler19 match-beginning 1)
|
||||
(byte-defop-compiler19 match-end 1)
|
||||
|
|
@ -2028,21 +2074,21 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(byte-defop-compiler19 downcase 1)
|
||||
(byte-defop-compiler19 string= 2)
|
||||
(byte-defop-compiler19 string< 2)
|
||||
(byte-defop-compiler (string-equal byte-string=) 2)
|
||||
(byte-defop-compiler (string-lessp byte-string<) 2)
|
||||
(byte-defop-compiler19 (string-equal byte-string=) 2)
|
||||
(byte-defop-compiler19 (string-lessp byte-string<) 2)
|
||||
(byte-defop-compiler19 equal 2)
|
||||
(byte-defop-compiler19 nthcdr 2)
|
||||
(byte-defop-compiler19 elt 2)
|
||||
(byte-defop-compiler19 member 2)
|
||||
(byte-defop-compiler19 assq 2)
|
||||
(byte-defop-compiler (rplaca byte-setcar) 2)
|
||||
(byte-defop-compiler (rplacd byte-setcdr) 2)
|
||||
(byte-defop-compiler19 (rplaca byte-setcar) 2)
|
||||
(byte-defop-compiler19 (rplacd byte-setcdr) 2)
|
||||
(byte-defop-compiler19 setcar 2)
|
||||
(byte-defop-compiler19 setcdr 2)
|
||||
(byte-defop-compiler19 buffer-substring 2)
|
||||
(byte-defop-compiler19 delete-region 2)
|
||||
(byte-defop-compiler19 narrow-to-region 2)
|
||||
(byte-defop-compiler (mod byte-rem) 2)
|
||||
(byte-defop-compiler19 (mod byte-rem) 2)
|
||||
(byte-defop-compiler19 (% byte-rem) 2)
|
||||
(byte-defop-compiler aset 3)
|
||||
|
||||
|
|
@ -2903,6 +2949,13 @@ For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
|
|||
|
||||
(make-obsolete 'buffer-flush-undo 'buffer-disable-undo)
|
||||
(make-obsolete 'baud-rate "use the baud-rate variable instead")
|
||||
(make-obsolete-variable 'auto-fill-hook 'auto-fill-function)
|
||||
(make-obsolete-variable 'blink-paren-hook 'blink-paren-function)
|
||||
(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function)
|
||||
(make-obsolete-variable 'temp-buffer-show-hook
|
||||
'temp-buffer-show-function)
|
||||
(make-obsolete-variable 'inhibit-local-variables
|
||||
"use enable-local-variables (with the reversed sense.)")
|
||||
|
||||
(provide 'byte-compile)
|
||||
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ function, which should take an alist of parameters as its argument.")
|
|||
;;; The default value for this must ask for a minibuffer. There must
|
||||
;;; always exist a frame with a minibuffer, and after we delete the
|
||||
;;; terminal frame, this will be the only frame.
|
||||
(defvar initial-frame-alist '((minibuffer . nil))
|
||||
(defvar initial-frame-alist '((minibuffer . t))
|
||||
"Alist of values used when creating the initial emacs text frame.
|
||||
These may be set in your init file, like this:
|
||||
(setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55)))
|
||||
|
|
@ -286,8 +286,27 @@ If FRAME is omitted, describe the currently selected frame."
|
|||
;;;; Aliases for backward compatibility with Emacs 18.
|
||||
(fset 'screen-height 'frame-height)
|
||||
(fset 'screen-width 'frame-width)
|
||||
(fset 'set-screen-width 'set-frame-width)
|
||||
(fset 'set-screen-height 'set-frame-height)
|
||||
|
||||
(defun set-screen-width (cols &optional pretend)
|
||||
"Obsolete function to change the size of the screen to COLS columns.\n\
|
||||
Optional second arg non-nil means that redisplay should use COLS columns\n\
|
||||
but that the idea of the actual width of the frame should not be changed.\n\
|
||||
This function is provided only for compatibility with Emacs 18; new code\n\
|
||||
should use set-frame-width instead."
|
||||
(set-frame-width (selected-frame) cols pretend))
|
||||
|
||||
(defun set-screen-height (lines &optional pretend)
|
||||
"Obsolete function to change the height of the screen to LINES lines.\n\
|
||||
Optional second arg non-nil means that redisplay should use LINES lines\n\
|
||||
but that the idea of the actual height of the screen should not be changed.\n\
|
||||
This function is provided only for compatibility with Emacs 18; new code\n\
|
||||
should use set-frame-width instead."
|
||||
(set-frame-height (selected-frame) lines pretend))
|
||||
|
||||
(make-obsolete 'screen-height 'frame-height)
|
||||
(make-obsolete 'screen-width 'frame-width)
|
||||
(make-obsolete 'set-screen-width 'set-frame-width)
|
||||
(make-obsolete 'set-screen-height 'set-frame-height)
|
||||
|
||||
|
||||
;;;; Key bindings
|
||||
|
|
|
|||
|
|
@ -437,11 +437,6 @@ This returns ARGS with the arguments that have been processed removed."
|
|||
(x-open-connection (or x-display-name
|
||||
(setq x-display-name (getenv "DISPLAY"))))
|
||||
|
||||
;;; xterm.c depends on using interrupt-driven input, but we don't want
|
||||
;;; the fcntls to apply to the terminal, so we do this after opening
|
||||
;;; the display.
|
||||
(set-input-mode t nil t)
|
||||
|
||||
(setq frame-creation-function 'x-create-frame)
|
||||
(setq suspend-hook
|
||||
'(lambda ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue