view lisp/=diary-ins.el @ 1386:5845050f9d5c

* keyboard.c (Vlast_event_frame): Make this variable exist even when MULTI_FRAME isn't #defined. People might find it necessary for writing correct programs, even when the programs don't explicitly use multiple frames. (read_char, kbd_buffer_store_event, kbd_buffer_get_event): No need to test MULTI_FRAME before setting Vlast_event_frame. (syms_of_keyboard): DEFVAR Vlast_event_frame whether or not MULTI_FRAME is defined. * keyboard.c: Add switch-frame events. (Qswitch_frame): New event header symbol. (head_table): Include Qswitch_frame in the table of event heads. (kbd_buffer_get_event): Detect when a frame switch has occurred, and return a frame switch event before the enqueued event. (make_lispy_switch_frame): New function. (unread_switch_frame): New variable. (read_key_sequence): Don't throw away the key sequence if the user switches frames in the middle of the sequence. Instead, when we receive a switch-frame event in the middle of a key sequence, save it, and stuff it into unread_switch_frame when the sequence is complete. (read_char): If unread_switch_frame is set, return that value. (command_loop_1): No need to check Vlast_event_frame and select new frames here; that's taken care of by switch-frame events now. (syms_of_keyboard): Initialize and staticpro unread_switch_frame. * keyboard.c (follow_key, read_key_sequence): Call access_keymap with T_OK true. * keyboard.c (apply_modifiers): Copy the value of BASE's Qevent_kind property to the new symbol. * keyboard.c (syms_of_keyboard): Qevent_kind should be initialized to intern ("event-kind"), not intern ("event-type").

;;; diary-insert.el --- calendar functions for adding diary entries.

;; Copyright (C) 1990 Free Software Foundation, Inc.

;; Author: Edward M. Reingold <[e-mail]>
;; Keywords: diary, calendar

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:

;; This collection of functions implements the diary insertion features as
;; described in calendar.el.

;; Comments, corrections, and improvements should be sent to
;;  Edward M. Reingold               Department of Computer Science
;;  [phone]                   University of Illinois at Urbana-Champaign
;;  [e-mail]             1304 West Springfield Avenue
;;                                   Urbana, Illinois 61801

;;; Code:

(require 'diary)

(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")
  (make-diary-entry
   (calendar-date-string
    (or (calendar-cursor-to-date)
        (error "Cursor is not on a date!"))
    t 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")
  (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!"))
            nil t))
   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* ((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 nil t)
      (calendar-date-string end nil t))
     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")
  (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!"))
            nil t))
   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-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!"))))
       nil t))
     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-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!"))))
       nil t))
     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-insert)

;;; diary-insert.el ends here