1
Fork 0
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:
Jim Blandy 1992-08-12 12:57:12 +00:00
parent 7e1dae733a
commit 9e2b097b26
6 changed files with 435 additions and 501 deletions

View file

@ -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
;;

View file

@ -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 */

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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 ()