xemacs-beta: lisp/packages/time.el comparison

comparison lisp/packages/time.el @ 118:7d55a9ba150c r20-1b11

Import from CVS: tag r20-1b11

author	cvs
date	Mon, 13 Aug 2007 09:24:17 +0200
parents	9f59509498e1
children	1370575f1259

comparison

equal deleted inserted replaced

-:578fd4947a72
+:7d55a9ba150c
 ;;; time.el --- display time and load in mode line of Emacs.
 ;; Copyright (C) 1985, 86, 87, 93, 94, 1996 Free Software Foundation, Inc.
-;; Maintainer: FSF,     XEmacs add-ons (C) by Jens T. Lautenbacher
+;; Maintainer: FSF for the original version.
-;;                      mail <jens@lemming0.lem.uni-karlsruhe.de>
+;;             XEmacs add-ons and rewrite (C) by Jens Lautenbacher
-;;                      for comments/fixes about the enhancements.
+;;                            mail <jens@lemming0.lem.uni-karlsruhe.de>
+;;                            for comments/fixes about the enhancements.
 ;; 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
 ;; 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.
-;;; Version: 1.10  (I choose the version number starting at 1.1
+;;; Version: 1.13  (I choose the version number starting at 1.1
 ;;;                to indicate that 1.0 was the old version
 ;;;                before I hacked away on it -jtl)
 ;;; Synched up with: Not synched with FSF.
 ;;; Code:
 (require 'itimer)
+(defconst display-time-version-number "1.13" "Version number of time.el")
+(defconst display-time-version (format "Time.el version %s for XEmacs"
+				       display-time-version-number)
+"The full version string for time.el")
 (defgroup display-time nil
 "Facilities to display the current time/date/load and a new-mail indicator
 in the XEmacs mode line or echo area."
 :group 'applications)
+(defgroup display-time-balloon nil
+"Fancy add-ons to display-time for using the `balloon-help' feature.
+balloon-help must be loaded before these settings take effect."
+:group 'display-time)
 (defcustom display-time-mail-file nil
 "*File name of mail inbox file, for indicating existence of new mail.
 Non-nil and not a string means don't check for mail.  nil means use
 default, which is system-dependent, and is the same as used by Rmail."
 (defcustom display-time-mail-balloon 'display-time-mail-balloon
 "What to use to generate the ballon frame of the \"mail\" glyph
 if balloon-help is loaded. This can be the function
 display-time-mail-balloon, nil or a string."
-:group 'display-time
+:group 'display-time-balloon
 :type '(choice (const display-time-mail-balloon)
 		 (const nil)
 		 (string)))
 (defcustom display-time-no-mail-balloon "No mail is good mail."
 "The string used in the ballon frame of the \"no mail\" glyph
 if balloon-help is loaded. This can also be nil"
-:group 'display-time
+:group 'display-time-balloon
 :type '(choice (const nil)
 		 (string)))
 (defcustom display-time-mail-balloon-show-gnus-group nil
 "Show the mail group gnus would put this message in.
 This is only useful if you use gnus to read your mail and have set the variable
 nnmail-split-methods to split your incoming mail into different groups.
 Look at the documentation for gnus. If you don't know what we're talking about,
 don't care and leave this set to nil"
-:group 'display-time
+:group 'display-time-balloon
 :type 'boolean)
 (defface display-time-mail-balloon-enhance-face '((t (:background  "orange")))
 "Face used for entries in the mail balloon which match the regexp
 display-time-mail-balloon-enhance"
-:group 'display-time)
+:group 'display-time-balloon)
 (defface display-time-mail-balloon-gnus-group-face '((t (:foreground "blue")))
 "Face used for the gnus group entry in the mail balloon
 if display-time-mail-balloon-show-gnus-group is t (see the documentation there
 before you set it to t)"
-:group 'display-time)
+:group 'display-time-balloon)
 (defcustom display-time-mail-balloon-max-displayed 10
 "The maximum number of messaged which are displayed in the mail balloon.
 You need to have balloon-help loaded to use this."
-:group 'display-time
+:group 'display-time-balloon
 :type 'number)
 (defcustom display-time-mail-balloon-from-width 20
 "The width of the `From:' part of the mail balloon.
 You need to have ballon-help loaded to use this"
-:group 'display-time
+:group 'display-time-balloon
 :type 'number)
 (defcustom display-time-mail-balloon-subject-width 25
 "The width of the `Subject:' part of the mail balloon.
 You need to have ballon-help loaded to use this"
-:group 'display-time
+:group 'display-time-balloon
 :type 'number)
 (defcustom display-time-mail-balloon-gnus-split-width 10
 "The width of the `Gnus Mail Group' part of the mail balloon.
 This denotes the mail group gnus would decide to put this message in.
 For getting this information, it consults the relevant variables from gnus
 (nnmail-split-methods).
 You need to have ballon-help loaded to use this"
-:group 'display-time
+:group 'display-time-balloon
 :type 'number)
 (defcustom display-time-mail-balloon-enhance nil
 "A list of regular expressions describing which messages should be highlighted
 in the mail balloon. The regexp will be matched against the complete header block
 of an email. You need to load balloon-help to use this"
-:group 'display-time
+:group 'display-time-balloon
 :type '(repeat (string :tag "Regexp")))
 (defcustom display-time-mail-balloon-suppress nil
 "A list of regular expressions describing which messages should be completely suppressed
 in the mail balloon. The regexp will be matched against the complete header block
 of an email. It will only take effect if the message is not matched already
 by display-time-mail-balloon-enhance.
 You need to load balloon-help to use this"
-:group 'display-time
+:group 'display-time-balloon
 :type '(repeat (string :tag "Regexp")))
 (defcustom display-time-mail-balloon-enhance-gnus-group nil
 "A list of regular expressions describing which messages should be highlighted
 in the mail balloon. The regexp will be matched against the group gnus would stuff
 this message into. It will only take effect if the message is not matched already
 by display-time-mail-balloon-suppress.
 This requires display-time-mail-balloon-show-gnus-group to be t
 and balloon-help to be loaded"
-:group 'display-time
+:group 'display-time-balloon
 :type '(repeat (string :tag "Regexp")))
 (defcustom display-time-mail-balloon-suppress-gnus-group nil
 "A list of regular expressions describing which messages should be completely suppressed
 in the mail balloon. The regexp will be matched against the group gnus would stuff
 this message into. It will only take effect if the message is not matched already
 by display-time-mail-balloon-enhance or display-time-mail-balloon-enhance-gnus-group.
 This requires display-time-mail-balloon-show-gnus-group to be t
 and balloon-help to be loaded"
-:group 'display-time
+:group 'display-time-balloon
 :type '(repeat (string :tag "Regexp")))
 (defvar display-time-spool-file-modification nil)
 (defvar display-time-mail-header nil)
 		display-time-display-time-foreground
 		display-time-display-time-bg-old
 		display-time-display-time-background)
 	  ))))
-(if (featurep 'xpm)
+(defun display-time-init-glyphs ()
+"This is a hack to have all glyphs be displayed one time at startup.
+It helps avoiding problems with the background color of the glyphs if a
+balloon-help frame is open and a not yet displayed glyph is going to be
+displayed."
+(let ((i 0)
+	(list '("am" "pm" ":"))
+	elem mlist)
+(while (< i 10)
+(push (eval (intern-soft (concat "display-time-"
+				       (number-to-string i)
+				       "-glyph"))) mlist)
+(setq i (1+ i)))
+(setq i 0.0)
+(while (<= i 3.0)
+(push (eval (intern-soft (concat "display-time-load-"
+				       (number-to-string i)
+				       "-glyph"))) mlist)
+(setq i (+ i 0.5)))
+(while (setq elem (pop list))
+(push (eval (intern-soft (concat "display-time-"
+				       elem "-glyph"))) mlist))
+(let ((global-mode-string mlist))
+(redisplay-frame))
+))
+(if (featurep 'xpm)
 (progn
 (defvar display-time-mail-sign
 	(cons (make-extent nil nil)
 	      (make-glyph  (concat display-time-icons-dir "letter.xpm"))))
 (set-extent-property (car display-time-mail-sign) 'balloon-help
 (defvar display-time-load-2.0-glyph nil)
 (defvar display-time-load-2.5-glyph nil)
 (defvar display-time-load-3.0-glyph nil)
 (display-time-generate-time-glyphs 'force)
 (display-time-generate-load-glyphs 'force)
+(display-time-init-glyphs)
 ))
 (defun display-time-can-do-graphical-display (&optional textual)
 (and display-time-show-icons-maybe
 (not textual)
 (eq (console-type) 'x)
 				      (user-login-name))))
 	 (show-split (and display-time-mail-balloon-show-gnus-group
 			  (or (featurep 'nnmail) (require 'nnmail))))
 	 (display-time-mail-balloon-gnus-split-width
 	  (if (not show-split) 0
-	    (+ 3 display-time-mail-balloon-gnus-split-width))) ; <space>[...] -> +3
+	    (+ 3 display-time-mail-balloon-gnus-split-width))) ; -><space>... = +3
 	 (mod (nth 5 (file-attributes mail-spool-file)))
 	 header	header-ext)
 (setq header "You have mail:")
 (setq header-ext
 	  (make-extent 0 (length header) header))
 		(save-excursion
 		  (if display-time-mail-balloon-enhance
 		      (re-search-forward enhance-reg nil t))))
 	  (if show-split
 	      (save-excursion
-		(setq point (point-min))
+		(goto-char (point-min))
 		(nnmail-article-group '(lambda (name) (setq gnus-group name)))))
 	  (if enhance () ; this takes prejudice over everything else
 	    (setq suppress ; maybe set suppress only if not already enhanced
 		  (save-excursion
 	      (or (setq enhance      ;;maybe we enhance because of the gnus group name
 			(save-excursion
 			  (if (and show-split gnus-group
 				   display-time-mail-balloon-enhance-gnus-group)
 			      (string-match gnus-enhance-reg gnus-group))))
-		  (setq suppress  ;; if we didn't enhance then maybe we have to suppress it?
+		  (setq suppress  ;; if we didn't enhance then maybe we have to
+			          ;; suppress it?
 			(save-excursion
 			  (if (and show-split gnus-group
 				   display-time-mail-balloon-suppress-gnus-group)
 			      (string-match gnus-suppress-reg gnus-group)))))))
 		  (set-extent-property line-ext 'face
 				       'display-time-mail-balloon-gnus-group-face)
 		  (set-extent-property line-ext 'duplicable t)
 		  (set-extent-property line-ext 'end-open t)))
 	    (push line mail-headers-list))
-	  (setq point (point-max))
+	  (goto-char (point-max))
 	  (setq suppress nil
 		gnus-group nil
 		enhance nil)
 	  (widen)
 	  )))
+(kill-buffer display-time-temp-buffer)
 (if (> (length mail-headers-list) display-time-mail-balloon-max-displayed)
 	(setq not-displayed (- (length mail-headers-list)
 			       display-time-mail-balloon-max-displayed)))
 (while (< i display-time-mail-balloon-max-displayed)
 (setq mail-headers (concat mail-headers (pop mail-headers-list)))
 (if display-time-24hr-format 24-hours 12-hours)
 minutes
 (if display-time-24hr-format "" am-pm))
 load
 (if mail " Mail" ""))
-"*THIS IS OBSOLETE! It will only be used if display-time-compatible is t.
+"*It will only be used if display-time-compatible is t.
 A list of expressions governing display of the time in the mode line.
 This expression is a list of expressions that can involve the keywords
 `load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
 `seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
 and `time-zone' all alphabetic strings and `mail' a true/nil string value.
 '((substring year -2) \"/\" month \"/\" day
 \" \" 24-hours \":\" minutes \":\" seconds
 (if time-zone \" (\") time-zone (if time-zone \")\"))
 would give mode line times like `94/12/30 21:07:48 (UTC)'.")
+(make-obsolete-variable 'display-time-string-forms
+			"You should use the new facilities for `display-time'.
+Look at display-time-form-list.")
 (defun display-time-function ()
 (let* ((now (current-time))
 	 (time (current-time-string now))
 (load (condition-case ()

Mercurial > hg > xemacs-beta

comparison lisp/packages/time.el @ 118:7d55a9ba150c r20-1b11