[affi@csc.no: Calendar hack: Displaying ISO weeks, update for emacs 22]

[Richard Stallman <rms@gnu.org>]

We deleted the variable `facemenu-unlisted-faces' because it didn't do
anything.  But this method shows that we must have lost the
functionality since 21, and that we need to add it back.

Would someone please reimplement it, then ack?

------- Start of forwarded message -------
From: Alf-Ivar Holm <affi@csc.no>
Newsgroups: gnu.emacs.sources
Date: Fri, 01 Dec 2006 14:53:44 +0100
Organization: Cosmo Scientific Consultant AS
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Xref: shelby.stanford.edu gnu.emacs.sources:11601
To: gnu-emacs-sources@gnu.org
Subject: Calendar hack: Displaying ISO weeks, update for emacs 22
X-Spam-Status: No, score=-2.8 required=5.0 tests=ALL_TRUSTED autolearn=failed 
	version=3.0.4

- --=-=-=

Just tried 22.0.91 and noticed that `facemenu-unlisted-faces' has been
removed, a variable I have used in a hack I have been using for 10
years for marking the ISO week in the calendar.  This is what the it
looks like, without the colours, and with `calendar-week-start-day'
set to 1:

   November 2006            December 2006             January 2007    
Mo Tu We Th Fr Sa Su WK  Mo Tu We Th Fr Sa Su WK  Mo Tu We Th Fr Sa Su WK 
       1  2  3  4  5 44               1  2  3 48   1  2  3  4  5  6  7  1 
 6  7  8  9 10 11 12 45   4  5  6  7  8  9 10 49   8  9 10 11 12 13 14  2 
13 14 15 16 17 18 19 46  11 12 13 14 15 16 17 50  15 16 17 18 19 20 21  3 
20 21 22 23 24 25 26 47  18 19 20 21 22 23 24 51  22 23 24 25 26 27 28  4 
27 28 29 30              25 26 27 28 29 30 31 52  29 30 31 

I've posted it here before, but included is the update that works for
the upcomming emacs as well.  I've tried the updated hack in emacs
version 21.4 and 22.0.91.

Howto: Add the file to your load path, and put:

        (require 'calendar-hack)

in your .emacs.

Note: the hack is a rewrite of `generate-calendar-month' from the
calender.el package, as I were not able to defadvice it with the
needed functionality.  I see that the new version of calendar.el has
removed the following block from the function:

         (if enable-multibyte-characters
             (truncate-string-to-width string 2)
           (substring string 0 2)))

and I should probably do the same, but I guess that would remove
support for older emacs versions, and not everybody here have upgraded
yet, I guess.

        Affi


- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=calendar-hack.el
Content-Transfer-Encoding: quoted-printable
Content-Description: Displaying ISO week in calendar

;; Done for 19.31.97, Affi 1996/6/26
;; Last fix for 19.34, Affi 1996/11/2
;; Made week name be up to tree chars (done in 21.3), Affi 2005/05/04

(require 'calendar)
(require 'faces)
(require 'font-lock)

(defvar calendar-use-colours window-system
  "Tries to fontify Calendar if non-nil.  Default set to `window-system'.")

(defvar calendar-week-string "WK"
  "String (up to three chars) used in calendar header to identify week numb=
ers.")

;; Prelimenary face stuff
(if (not calendar-use-colours)
    nil
  (set-face-foreground 'diary-face "black")
  (make-face-bold 'diary-face)

  (add-to-list 'facemenu-unlisted-faces 'calendar-week-face)
  (make-face 'calendar-week-face)
  (cond ((face-differs-from-default-p 'calendar-week-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-week-face "blue"))
	(t (copy-face 'bold 'calendar-week-face)))

  (add-to-list 'facemenu-unlisted-faces 'calendar-header-face)
  (make-face 'calendar-header-face)
  (cond ((face-differs-from-default-p 'calendar-header-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-header-face "ForestGreen"))
	(t (copy-face 'bold 'calendar-header-face)))
  (make-face-bold 'calendar-header-face)

  (add-to-list 'facemenu-unlisted-faces 'calendar-sunday-face)
  (make-face 'calendar-sunday-face)
  (cond ((face-differs-from-default-p 'calendar-sunday-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-sunday-face "red"))
	(t (copy-face 'bold 'calendar-sunday-face))))

(defun generate-calendar-month (month year indent)
  "Produce a calendar for ISO-week, month, year on the Gregorian calendar.
The calendar is inserted in the buffer starting at the line on which point
is currently located, but indented INDENT spaces.  The indentation is done
from the first character on the line and does not disturb the first INDENT
characters on the line."
  (let* ((blank-days			; At start of month
          (mod
           (- (calendar-day-of-week (list month 1 year))
              calendar-week-start-day)
           7))
	 (last (calendar-last-day-of-month month year)))
    (goto-char (point-min))
    (calendar-insert-indented
     (calendar-string-spread
      (list (format "%s %d" (calendar-month-name month) year)) ?  20)
     indent t)
    ;; Add colour to month name
    (if calendar-use-colours
	(overlay-put (make-overlay (point-min) (1- (point)))
		     'face 'calendar-header-face))
    (calendar-insert-indented "" indent) ; Go to proper spot
    (calendar-for-loop
     i from 0 to 6 do
     (insert (substring (aref calendar-day-name-array
			      (mod (+ calendar-week-start-day i) 7)) 0 2))
     ;; Add colour to week day names and sundays
     (if calendar-use-colours
	 (overlay-put (make-overlay  (- (point) 2) (point)) 'face
		      (if (=3D 0 (mod (+ calendar-week-start-day i) 7))
			  'calendar-sunday-face
			'calendar-header-face)))
     (insert " "))
    ;; Add week-string after week dates
    (insert (concat calendar-week-string=20
		    (make-string (- 3 (length calendar-week-string)) ? )))
    ;; Add colour to week-string
    (if calendar-use-colours
	(overlay-put (make-overlay  (- (point) 3) (point))
		     'face 'calendar-week-face))
    (calendar-insert-indented "" 0 t);; Force onto following line
    (calendar-insert-indented "" indent);; Go to proper spot
    ;; Add blank days before the first of the month
    (calendar-for-loop i from 1 to blank-days do (insert "   "))
    ;; Put in the days of the month
    (calendar-for-loop
     i from 1 to last do
     (insert (format "%2d " i))
     (if (not calendar-use-colours)
	 nil
       (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
       ;; Add colour to sunday
       (if (=3D 1 (mod (+ blank-days calendar-week-start-day i) 7))
	   (overlay-put (make-overlay  (- (point) 3) (1- (point)))
			'face 'calendar-sunday-face)))
     (and (zerop (mod (+ i blank-days) 7))
	  ;; Add ISO-week # at the end each week entry
	  (require 'cal-iso)
	  (not (insert
		(format "%2d " (extract-calendar-month
				(calendar-iso-from-absolute
				 (calendar-absolute-from-gregorian
				  (list month i year)))))))
	  ;; Add colour to week #
	  (if calendar-use-colours
	      (overlay-put (make-overlay  (- (point) 3) (1- (point)))
			   'face 'calendar-week-face)
	    t)
	  (/=3D i last)
	  (calendar-insert-indented "" 0 t);; Force onto following line
	  (calendar-insert-indented "" indent)))));; Go to proper spot

(provide 'calendar-hack)

- --=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources@gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources

- --=-=-=--
------- End of forwarded message -------