;;; cal-xemacs.el --- calendar functions for menu bar and popup menu support
;;; Original file is cal-menu.el.

;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.

;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;;	Lara Rios <lrios@coewl.cen.uiuc.edu>
;; Ported to XEmacs by Chuck Thompson <cthomp@cs.uiuc.edu>
;; Keywords: calendar
;; Human-Keywords: calendar, popup menus, menu bar

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
 
;;; Synched up with: cal-menu.el in Emacs 20.3

;;; Commentary:

;; This collection of functions implements menu bar and popup menu support for
;; calendar.el.

;; Comments, corrections, and improvements should be sent to
;;  Edward M. Reingold               Department of Computer Science
;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
;;                                   Urbana, Illinois 61801

;;; Code:

(eval-when-compile (require 'calendar))
(require 'easymenu)
 
(defconst calendar-popup-menu-3
  '("Calendar"
    ["Scroll forward" scroll-calendar-left-three-months t]
    ["Scroll backward" scroll-calendar-right-three-months t]
    ["Mark diary entries" mark-diary-entries t]
    ["List holidays" list-calendar-holidays t]
    ["Mark holidays" mark-calendar-holidays t]
    ["Unmark" calendar-unmark t]
    ["Lunar phases" calendar-phases-of-moon t]
    ["Show diary" show-all-diary-entries t]
    ["Exit calendar" exit-calendar t]
    ))

(defun calendar-popup-menu-3 (e)
  (interactive "@e")
  (popup-menu calendar-popup-menu-3))
(define-key calendar-mode-map 'button3 'calendar-popup-menu-3)

(define-key calendar-mode-map 'button2 'calendar-mouse-2-date-menu)


(defun cal-tex-mouse-filofax (e) 
  "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date."
  (interactive "e")
  (let* ((date (calendar-event-to-date t))
	 (menu (list (calendar-date-string date t nil)
		     "-----"
		     ["Filofax Daily (One-day-per-page)"   
		      cal-tex-mouse-filofax-daily]
		     ["Filofax Weekly (2-weeks-at-a-glance)"   
		      cal-tex-mouse-filofax-2week]
		     ["Filofax Weekly (week-at-a-glance)" 
		      cal-tex-mouse-filofax-week]
		     ["Filofax Yearly"  cal-tex-mouse-filofax-year]
		     )))
    (popup-menu menu)
    ))

(defconst calendar-scroll-menu
  '("Scroll"
    ["Forward 1 Month" scroll-calendar-left t]
    ["Forward 3 Months" scroll-calendar-left-three-months t]
    ["Forward 1 Year" (scroll-calendar-left-three-months 4) t]
    ["Backward 1 Month" scroll-calendar-right t]
    ["Backward 3 Months" scroll-calendar-right-three-months t]
    ["Backward 1 Year" (scroll-calendar-right-three-months 4) t]))

(defconst calendar-goto-menu
  '("Goto"
    ["Today" calendar-goto-today t]
    ["Beginning of week" calendar-beginning-of-week (calendar-cursor-to-date)]
    ["End of week" calendar-end-of-week (calendar-cursor-to-date)]
    ["Beginning of month" calendar-beginning-of-month (calendar-cursor-to-date)]
    ["End of month" calendar-end-of-month (calendar-cursor-to-date)]
    ["Beginning of year" calendar-beginning-of-year (calendar-cursor-to-date)]
    ["End of year" calendar-end-of-year (calendar-cursor-to-date)]
    ["Other date" calendar-goto-date t]
    ["ISO date" calendar-goto-iso-date t]
    ["Astronomical date" calendar-goto-astro-day-number t]
    ["Hebrew date" calendar-goto-hebrew-date t]
    ["Persian date" calendar-goto-persian-date t]
    ["Islamic date" calendar-goto-islamic-date t]
    ["Julian date" calendar-goto-julian-date t]
    ["Chinese date" calendar-goto-chinese-date t]
    ["Coptic date" calendar-goto-coptic-date t]
    ["Ethiopic date" calendar-goto-ethiopic-date t]
    ("Mayan date"
     ["Next Tzolkin" calendar-next-tzolkin-date t]
     ["Previous Tzolkin" calendar-previous-tzolkin-date t]
     ["Next Haab" calendar-next-haab-date t]
     ["Previous Haab" calendar-previous-haab-date t]
     ["Next Round" calendar-next-calendar-round-date t]
     ["Previous Round" calendar-previous-calendar-round-date t])
    ["French date" calendar-goto-french-date t]))

(defconst calendar-holidays-menu
  '("Holidays"
    ["One day" calendar-cursor-holidays (calendar-cursor-to-date)]
    ["3 months" list-calendar-holidays t]
    ["Year" cal-menu-list-holidays-year t]
    ["Following year"  cal-menu-list-holidays-following-year]
    ["Previous year"  cal-menu-list-holidays-previous-year]
    ["Mark" mark-calendar-holidays t]
    ["Unmark" calendar-unmark t]))

(defconst calendar-diary-menu
  '("Diary"
    ["Other file" view-other-diary-entries (calendar-cursor-to-date)]
    ["Cursor date" view-diary-entries (calendar-cursor-to-date)]
    ["Mark all" mark-diary-entries t]
    ["Show all" show-all-diary-entries t]
    ["Insert daily"insert-diary-entry t]
    ["Insert weekly" insert-weekly-diary-entry (calendar-cursor-to-date)]
    ["Insert monthly" insert-monthly-diary-entry (calendar-cursor-to-date)]
    ["Insert yearly" insert-yearly-diary-entry (calendar-cursor-to-date)]
    ["Insert anniversary" insert-anniversary-diary-entry (calendar-cursor-to-date)]
    ["Insert block" insert-block-diary-entry (calendar-cursor-to-date)]
    ["Insert cyclic" insert-cyclic-diary-entry (calendar-cursor-to-date)]
    ["Insert Islamic" calendar-mouse-insert-islamic-diary-entry (calendar-cursor-to-date)]
    ["Insert Hebrew" calendar-mouse-insert-hebrew-diary-entry (calendar-cursor-to-date)]))

(defun calendar-add-menus ()
  (set-buffer-menubar (copy-sequence current-menubar))
  (if (assoc "Calendar" current-menubar)
      nil
    (add-submenu nil '("Calendar"))
    (if (not (assoc "Scroll" current-menubar))
	(add-submenu '("Calendar") calendar-scroll-menu))
    (if (not (assoc "Goto" current-menubar))
	(add-submenu '("Calendar") calendar-goto-menu))
    (if (not (assoc "Holidays" current-menubar))
	(add-submenu '("Calendar") calendar-holidays-menu))
    (if (not (assoc "Diary" current-menubar))
	(add-submenu '("Calendar") calendar-diary-menu))
    (if (not (assoc "Moon" current-menubar))
	(add-menu-button '("Calendar") ["Moon" calendar-phases-of-moon t]))))

(defun cal-menu-list-holidays-year ()
  "Display a list of the holidays of the selected date's year."
  (interactive)
  (let ((year (extract-calendar-year (calendar-cursor-to-date))))
    (list-holidays year year)))

(defun cal-menu-list-holidays-following-year ()
  "Display a list of the holidays of the following year."
  (interactive)
  (let ((year (1+ (extract-calendar-year (calendar-cursor-to-date)))))
    (list-holidays year year)))

(defun cal-menu-list-holidays-previous-year ()
  "Display a list of the holidays of the previous year."
  (interactive)
  (let ((year (1- (extract-calendar-year (calendar-cursor-to-date)))))
    (list-holidays year year)))

(defun cal-menu-update ()
  ;; Update the holiday part of calendar menu bar for the current display.
  (interactive)
  (condition-case nil
      (if (eq major-mode 'calendar-mode)
          (let ((l))
	    (let ((date (calendar-cursor-to-date)))
              (if date
		  (setq l (cons (vector
				 (format "For Date (%s)"
					 (calendar-date-string date)) 
				 'cal-menu-today-holidays t) l))))
	    (let ((title
                   (let ((m1 displayed-month)
                         (y1 displayed-year)
                         (m2 displayed-month)
                         (y2 displayed-year))
                     (increment-calendar-month m1 y1 -1)
                     (increment-calendar-month m2 y2 1)
                     (if (= y1 y2)
                         (format "%s-%s, %d"
                                 (calendar-month-name m1 3)
                                 (calendar-month-name m2 3)
                                 y2)
                       (format "%s, %d-%s, %d"
                               (calendar-month-name m1 3)
                               y1
                               (calendar-month-name m2 3)
                               y2)))))
	      (setq l (cons (vector
			     (format "For Window (%s)" title )
			     'list-calendar-holidays t) l)))
	    (setq l (cons (vector
			   (format "For Today (%s)"
				   (calendar-date-string 
				    (calendar-current-date) t t))
			   'cal-menu-today-holidays t) l))
	    (setq l (cons "---" l))
	    (calendar-for-loop;; Show 11 years--5 before, 5 after year of
	     ;; middle month    (calendar-mouse-goto-date (calendar-event-to-date))

             i from (- displayed-year 5) to (+ displayed-year 5) do
             (setq l (cons (vector (format "For Year %s" i)
                                   (list (list 'lambda 'nil '(interactive)
                                               (list 'list-holidays i i)))
                                   t)
                           l)))
            (setq l (cons ["Mark Holidays" mark-calendar-holidays t]
                          (cons ["Unmark Calendar" calendar-unmark t]
                                (cons ["--" '("--") t] l))))
            (easy-menu-change '("Calendar") "Holidays" (nreverse l))
	    ))
    (error (ding))))

(defun calendar-event-to-date (&optional error)
  "Date of last event.
If event is not on a specific date, signals an error if optional parameter
ERROR is t, otherwise just returns nil."
  (save-excursion
    ;; we keep a copy of the last button press event.  This makes it easier
    ;; to mimic the Emacs version.  Otherwise, on the next call, we get
    ;; a misc-user-event when a menu item is selected.  Then we lose the 
    ;; buffer and point information
    (if (button-event-p last-input-event)
	(progn
	  (setq last-calendar-button-event (allocate-event))
	  (copy-event last-input-event last-calendar-button-event))
      )
    ;;  Emacs has this.  
    ;;(set-buffer (window-buffer (posn-window (event-start last-input-event))))
    ;;(goto-char (posn-point (event-start last-input-event)))
    ;; I think this does the same thing - jmiller 
    (set-buffer (event-buffer last-calendar-button-event))
    (goto-char (event-point last-calendar-button-event))
    (calendar-cursor-to-date error)))

(defun calendar-mouse-insert-hebrew-diary-entry (event)
  "Pop up menu to insert a Hebrew-date diary entry."
  (interactive "e")
  (let ((menu (list (format "Hebrew insert menu - %s"
			    (calendar-hebrew-date-string
			     (calendar-cursor-to-date)))
		    "-----"
		    ["One time" insert-hebrew-diary-entry t]
		    ["Monthly" insert-monthly-hebrew-diary-entry t]
		    ["Yearly" insert-yearly-hebrew-diary-entry t])))
    (popup-menu menu)))

(defun calendar-mouse-insert-islamic-diary-entry (event)
  "Pop up menu to insert an Islamic-date diary entry."
  (interactive "e")
  (let ((menu (list (format "Islamic insert menu - %s"
			    (calendar-islamic-date-string
			     (calendar-cursor-to-date)))
		    "-----"
		    ["One time" insert-islamic-diary-entry t]
		    ["Monthly" insert-monthly-islamic-diary-entry t]
		    ["Yearly" insert-yearly-islamic-diary-entry t])))
    (popup-menu menu)))

(defun calendar-mouse-sunrise/sunset ()
  "Show sunrise/sunset times for mouse-selected date."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (calendar-sunrise-sunset)))

(defun cal-menu-today-holidays ()
  "Show holidays for today's date."
  (interactive)
  (save-excursion
    (calendar-cursor-to-date (calendar-current-date))
    (calendar-cursor-holidays)))

(defun calendar-mouse-holidays ()
  "Pop up menu of holidays for mouse selected date."
  (interactive)
  (save-excursion
    (let* ((date (calendar-event-to-date))
	   (l (check-calendar-holidays date))
	   (menu 
	    (cons
	     (format "Holidays for %s" (calendar-date-string date))
	     (if l l '("None")))))
      (popup-menu menu))))
  
(defun calendar-mouse-view-diary-entries ()
  "Pop up menu of diary entries for mouse selected date."
  (interactive)
  (save-excursion
    (let* ((date (calendar-event-to-date))
	   (l (mapcar '(lambda (x) (concat (car (cdr x)) ""))
		      (let ((diary-list-include-blanks nil)
			    (diary-display-hook 'ignore))
			(list-diary-entries date 1))))
	   (menu 
	    (cons
	     (format "Diary Entries for %s" (calendar-date-string date))
	     (if l l '("None")))))
      (popup-menu menu))))

(defun calendar-mouse-view-other-diary-entries ()
  "Pop up menu of diary entries from alternative file on mouse-selected date."
  (interactive)
  (save-excursion
    (let* ((date  (calendar-event-to-date))
	   (l (mapcar '(lambda (x) (concat (car (cdr x)) ""))
		      (let ((diary-list-include-blanks nil)
			    (diary-display-hook 'ignore)
			    (diary-file (read-file-name
					 "Enter diary file name: "
					 default-directory nil t)))
			(list-diary-entries date 1))))
	   (menu 
	    (cons
	     (format "Diary Entries form %s for %s" 
		     diary-file
		     (calendar-date-string date))
	     (if l l '("None")))))
      (popup-menu menu))))

(defun calendar-mouse-insert-diary-entry ()
  "Insert diary entry for mouse-selected date."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (insert-diary-entry nil)))

(defun calendar-mouse-set-mark ()
  "Mark the date under the cursor."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (calendar-set-mark nil)))

(defun cal-tex-mouse-day ()
  "Make a buffer with LaTeX commands for the day mouse is on."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-day nil)))

(defun cal-tex-mouse-week ()
  "One page calendar for week indicated by cursor.
Holidays are included if `cal-tex-holidays' is t."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-week nil)))

(defun cal-tex-mouse-week2 ()
  "Make a buffer with LaTeX commands for the week cursor is on.
The printed output will be on two pages."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-week2 nil)))

(defun cal-tex-mouse-week-iso ()
  "One page calendar for week indicated by cursor.
Holidays are included if `cal-tex-holidays' is t."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-week-iso nil)))

(defun cal-tex-mouse-week-monday ()
  "One page calendar for week indicated by cursor."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-week-monday nil)))

(defun cal-tex-mouse-filofax-daily ()
  "Day-per-page Filofax calendar for week indicated by cursor."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-filofax-daily nil)))

(defun cal-tex-mouse-filofax-2week ()
  "One page Filofax calendar for week indicated by cursor."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-filofax-2week nil)))

(defun cal-tex-mouse-filofax-week ()
  "Two page Filofax calendar for week indicated by cursor."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-filofax-week nil)))

(defun cal-tex-mouse-month ()
  "Make a buffer with LaTeX commands for the month cursor is on.
Calendar is condensed onto one page."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-month nil)))

(defun cal-tex-mouse-month-landscape ()
  "Make a buffer with LaTeX commands for the month cursor is on.
The output is in landscape format, one month to a page."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-month-landscape nil)))

(defun cal-tex-mouse-year ()
  "Make a buffer with LaTeX commands for the year cursor is on."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-year nil)))

(defun cal-tex-mouse-filofax-year ()
  "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-filofax-year nil)))

(defun cal-tex-mouse-year-landscape ()
  "Make a buffer with LaTeX commands for the year cursor is on."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (cal-tex-cursor-year-landscape nil)))

(defun calendar-mouse-print-dates ()
  "Pop up menu of equivalent dates to mouse selected date."
  (interactive)
  (let* ((date (calendar-event-to-date))
	 (menu (list (format "Date Menu - %s (Gregorian)"
			     (calendar-date-string date))
		     "-----"
		     (calendar-day-of-year-string date)
		     (format "ISO date: %s" (calendar-iso-date-string date))
		     (format "Julian date: %s"
			     (calendar-julian-date-string date))
		     (format "Astronomical (Julian) date (before noon): %s"
			     (calendar-astro-date-string date))
		     (format "Hebrew date (before sunset): %s"
			     (calendar-hebrew-date-string date))
		     (format "Persian date: %s"
			     (calendar-persian-date-string date))
		     (let ((i (calendar-islamic-date-string date)))
		       (if (not (string-equal i ""))
			   (format "Islamic date (before sunset): %s" i)))
		     (format "Chinese date: %s"
			     (calendar-chinese-date-string date))
		     (let ((c (calendar-coptic-date-string date)))
		       (if (not (string-equal c ""))
			   (format "Coptic date: %s" c)))
		     (let ((e (calendar-ethiopic-date-string date)))
		       (if (not (string-equal e ""))
			   (format "Ethiopic date: %s" e)))
		     (let ((f (calendar-french-date-string date)))
		       (if (not (string-equal f ""))
			   (format "French Revolutionary date: %s" f)))
		     (format "Mayan date: %s" 
			     (calendar-mayan-date-string date))
		     )))
    (popup-menu menu)
    ))

(defun calendar-mouse-cal-tex-menu (e) 
  "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window."
  (interactive "e")
  (let* ((date (calendar-event-to-date t))
	 (menu (list (calendar-date-string date t nil)
		     "-----"
		     ["Daily (1 page)"    cal-tex-mouse-day  ]
		     ["Weekly (1 page)"   cal-tex-mouse-week ]
		     ["Weekly (2 pages)"  cal-tex-mouse-week2]
		     ["Weekly (other style; 1 page)" cal-tex-mouse-week-iso]
		     ["Weekly (yet another style; 1 page)"
		      cal-tex-mouse-week-monday]
		     ["Monthly" cal-tex-mouse-month]
		     ["Monthly (landscape)"  cal-tex-mouse-month-landscape]
		     ["Yearly"  cal-tex-mouse-year]
		     ["Yearly (landscape)"  cal-tex-mouse-year-landscape]
		     ["Filofax styles" cal-tex-mouse-filofax]
		     )))
    (popup-menu menu)
    ))

(defun calendar-mouse-chinese-date ()
  "Show Chinese equivalent for mouse-selected date."
  (interactive)
  (save-excursion
    (calendar-mouse-goto-date (calendar-event-to-date))
    (calendar-print-chinese-date)))

(defun calendar-mouse-goto-date (date)
  (set-buffer (event-buffer  last-calendar-button-event))
  (calendar-goto-date date))

(defun calendar-mouse-2-date-menu (event)
  (interactive "@e")
  (let* ((date (calendar-event-to-date))
	(menu (list (format "Menu - %s" (calendar-date-string date) t t)
	       "-----"
	       ["Holidays" calendar-mouse-holidays t]
	       ["Mark date" calendar-mouse-set-mark t]
	       ["Sunrise/sunset" calendar-mouse-sunrise/sunset t]
	       ["Other calendars" calendar-mouse-print-dates t]
	       ["Prepare LaTeX Buffer" calendar-mouse-cal-tex-menu t]
	       ["Diary entries" calendar-mouse-view-diary-entries t]
	       ["Insert diary entry" calendar-mouse-insert-diary-entry t]
	       ["Other Diary file entries"
		calendar-mouse-view-other-diary-entries
		(calendar-cursor-to-date)]
	       )))
    (popup-menu menu)))

(run-hooks 'cal-xemacs-load-hook)

(provide 'cal-xemacs)

;;; cal-menu.el ends here
