jcgs@harlqn.UUCP (John Sturdy) (11/30/88)
Well, someone asked for that so-useful editing command to tell you
when the next train is, so here it is:
--------------------------------cut here--------------------------------
; -*-emacs-lisp-*- /usr/users/jcgs/emacs/trains.el
; Last edited: Wed Nov 30 15:35:57 1988 by jcgs (John Sturdy) on harlqn
(defun digit-above-regexp (digit)
"Returns a chunk of regular expression to search for a digit higher
than DIGIT, or if DIGIT is 9, something that will not match any
digit."
(let ((x (1+ digit)))
(if (> x 9)
"[^0-9]"
(format "[%1d-9]" x))))
(defun time-after (time)
"Return a regular expression for the earliest time after TIME, which
is given in HHMM format."
(let ((hour-tens (string-to-int (substring time 0 1)))
(hour-units (string-to-int (substring time 1 2)))
(minute-tens (string-to-int (substring time 2 3)))
(minute-units (string-to-int (substring time 3 4))))
(format
"%s%s%s\\|%s[%1d-5][0-9]\\|%s%s[0-5][0-9]\\|[%1d-2][0-9][0-5][0-9]"
;; the first possibility is in the next ten minutes of this hour
(substring time 0 2) (substring time 2 3)
(digit-above-regexp minute-units)
;; now try in the rest of this hour
(substring time 0 2) (1+ minute-tens)
;; otherwise something in the rest of this ten hours
(substring time 0 1) (digit-above-regexp hour-units)
;; otherwise anything later
(1+ hour-tens))))
(defun train (destination time)
"Return (and display, if interactive) the next train to DESTINATION
that leaves after TIME. If TIME is nil or the empty string, the
current time is used; otherwise TIME should be a string in the format
HHMM."
(interactive
(list (completing-read "To: " '(("Cambridge") ("Foxton")) nil t)
(read-from-minibuffer "Time (HHMM) (default: now): ")))
(let ((now (current-time-string))
(result-string nil))
(save-window-excursion
(if (or (null time) (zerop (length time)))
(setq time
(format "%s%s"
(substring now 11 13)
(substring now 14 16))))
(find-file "/harlqn/usr/users/jcgs/misc/TRAINS")
(goto-char (point-min))
(search-forward (format "to %s" destination))
(search-forward (substring now 0 3)) ; day of week
(re-search-forward (format "\\(%s\\)->[0-9]+" (time-after time)))
(setq result-string (buffer-substring (match-beginning 0)
(match-end 0)))
(bury-buffer (current-buffer)))
(if (interactive-p) (message "Next train departs at %s, arrives at %s"
(substring result-string 0 4)
(substring result-string 6 10)))
result-string))
; end of trains.el
--------------------------------cut here--------------------------------
And here is part of a sample file (really we get more trains than
this, I just trimmed it to save net costs!):
--------------------------------cut here--------------------------------
Foxton to Cambridge
Mon,Tue,Wed,Thu,Fri
0021->0034 0043->0100 0108->0125 0638->0652 0759->0811
2251->2303 2322->2336 0108->0125
Sat
0043->0100 0108->0125 0638->0652 0750->0802 0835->0907
(Sun morning) 0016->0033 0108->0125
Sun
0016->0033 0108->0125 0740->0753 0904->0917 1004->1017
2121->2134 2221->2234 2321->2334 (Mon morning) 0021->0034
Cambridge to Foxton
Mon,Tue,Wed,Thu,Fri
0020->0029 0600->0609 0710->0719 0733->0742 0752->0801
--------------------------------cut here--------------------------------
--
__John All facts are useless, but some facts are more useless than others.
(After Ecclesiastes Chs. 1 & 2, 1 Corinthians 13:9,
and George Orwell's "Animal Farm")
jcgs@uk.co.harlqn Harlequin Ltd,Barrington,Cambridge,UK +44-223-872522jcgs@harlqn.harlqn.uucp (John Sturdy) (12/01/88)
Here's some more stuff not so directly related to editing: it handles
calendar files (a subset of the format taken by Unix's calendar (1)).
There are two sets of functions in this file: one for handling
calendars, and one for finding people. (They go together as we have a
site-wide file calendar.away which says who expects to be away on a
particular day.)
(To use multiple calendar files, use #include. But first check that
your local version of the calendar program puts the users' calendars
through cpp - I think that is a recent development.)
This stuff has grown gradually, there are some functions there I don't
use so much now. The interactive calls to it that I currently use are:
M-x diary (find a diary file)
M-x diary-enter (find a place in the current diary file)
M-x locate (find a person)
I think there is a bug in the construction of search patterns for
dates, but it only turns up for obscure combinations of dates, and I
haven't managed to track it down yet. You may need to adjust the
arguments to "substring" in the "locate" program, to suit your local
version of "rwho".
--------------------------------cut here--------------------------------
;;; calendar.el - niceties for handling *date-sorted* calendar files
;;; Last edited: Thu Dec 1 11:19:22 1988 by jcgs (John Sturdy) on harlqn
(provide 'calendar)
(defun get-date-leading-zero ()
"Return today's date, with a leading zero for days 1-9 of the month."
(let ((todays-date (substring (current-time-string) 4 10)))
(if (string= (substring todays-date 4 5) " ")
(setq todays-date (concat (substring todays-date 0 4)
"0"
(substring todays-date 5))))
todays-date))
(defun today ()
"Set the region to include just all of today's appointments."
(interactive)
(widen)
(let
((todays-date (get-date-leading-zero))
(old-point (point)))
(goto-char (point-max))
(if (search-backward todays-date (point-min) t)
(progn
(beginning-of-line 2) ; beginning of next line
(set-mark (point))
(goto-char (point-min))
(search-forward todays-date) ; was found from bottom, so will now
(beginning-of-line) ; find it from top
t) ; say we found it
(progn ; "else": not found, so
(goto-char old-point) ; go back to old point
nil)))) ; and say we didn't find today
(defun show-today ()
"Narrow to show today's block of appointments in a calendar file.
This can be used as an auto-mode function, on visiting a file with a
name matching \"/calendar$\"."
(interactive)
(if (today)
(progn
(narrow-to-region (point) (mark))
(message (substitute-command-keys "\\[widen] to see whole file"))
t)
(progn
(goto-char (point-min))
(message "No appointments for today")
nil)))
(defun digit-above-regexp-with-limit (digit limit)
"Return a regular expression for a digit > DIGIT, for DIGIT <= LIMIT
or if DIGIT is greater than LIMIT, something that will not match any digit."
(if (> digit limit)
"[^0-9]"
(format "[%1d-9]" (1+ digit))))
(defun next-found-day-in-same-month (thereafter)
"Return a regular expression for the next date string after THEREAFTER
within the same month."
(let
(
(month (substring thereafter 0 3))
(day-high-digit (string-to-int (substring thereafter 4 5)))
(day-low-digit (string-to-int (substring thereafter 5 6)))
)
(format
"%s \\\(%d[%d-9]\\\|[%d-3][0-9]\\\)"
;; "%s \\\(%d%s\\\|%s[0-9]\\\)"
month
day-high-digit
(min (+ day-low-digit 1) 9)
;; (digit-above-regexp-with-limit day-low-digit 9)
(min (+ day-high-digit 1) 3)
;; (digit-above-regexp-with-limit day-high-digit 3)
)))
(defun next-month (month)
"Increment a month-string
circularly (ie
(equal (next-month \"Dec\") \"Jan\")
)."
(cdr (assoc month
'(("Jan" . "Feb") ("Feb" . "Mar") ("Mar" . "Apr")
("Apr" . "May") ("May" . "Jun") ("Jun" . "Jul")
("Jul" . "Aug") ("Aug" . "Sep") ("Sep" . "Oct")
("Oct" . "Nov") ("Nov" . "Dec") ("Dec" . "Jan")))))
(defun goto-day-after (date-string)
"Move point to the beginning of the first line after the date given.
Leaves mark at the old cursor position."
(interactive "sDate to move after: ")
(set-mark (point))
(if (not (re-search-forward (next-found-day-in-same-month date-string)
(point-max) t))
(let* (
(month (substring date-string 0 3))
(following-month (next-month month))
)
(while (not (or
(search-forward following-month (point-max) t)
(string= month following-month)))
(setq following-month (next-month following-month)))))
(beginning-of-line 1))
(defun diary-enter (day)
"Move to the end of the last entry for DAY
or just before the first entry for the next date after that that has
any entries, and insert DAY at the start of a line, to make a new
calendar entry for that day. Completion is done on reading dates, to
make sure you put only valid dates in."
(interactive (list (read-date)))
(widen)
(goto-char (point-max))
(if (search-backward day (point-min) t)
(beginning-of-line 2)
(progn
(goto-char (point-min))
(goto-day-after day)))
(open-line 1)
(insert day " "))
(defun appointment (day what-to-do)
"Find your main calendar file, and at DAY enter WHAT-TO-DO
by moving to the end of the last entry for DAY, or just before the
first entry for the next date after that that has any entries,
inserting DAY at the start of a line, to make a new calendar entry for
that day, then inserting the string WHAT-TO-DO at that date."
(interactive "sMake entry for date:
sAppointment: ")
(save-window-excursion
(find-file (concat my-home-directory "/calendar"))
(save-excursion
; I'd like to use save-restriction
; here, but it's documentation has
; a caveat about changing the buffer
; outside the old narrow area!
(widen)
(diary-enter day)
(insert what-to-do)
(save-buffer nil))))
(defun move-to-today ()
"Move point to the first line containing today's date
(or the nearest following date), leaving mark at the old point."
(interactive)
(set-mark (point))
(goto-char (point-min))
(let ((today (get-date-leading-zero)))
(if (not (search-forward today (point-max) t))
(goto-day-after today))))
(defvar calendar-files
'(("away (meetings away, and holidays)" .
"/jung/usr/local/lib/calendar.away")
("meetings" . "/jung/usr/local/lib/calendar.meetings")
("deadlines" . "/jung/usr/local/lib/calendar.deadlines")
("new arrivals" .
"/jung/usr/local/lib/calendar.new")
;; ("birthdays" . "/jung/usr/local/lib/calendar.birthdays")
("personal calendar" . "~/calendar"))
"Alist of calendar names against file names.")
(defun read-calendar-file-name (&optional extra-list)
"Read a calendar file name, using (append extra-list calendar-files)
for the completion list - each entry is the name to put on the
completion list, dotted with the actual file name. The file name is
expanded after reading it, so you can put \"~\" substitutions in the file
name given."
(let ((file-list (append extra-list calendar-files)))
(expand-file-name
(cdr (assoc (completing-read "Calendar: " file-list
nil t)
file-list)))))
(defun diary (calendar-file-name)
"Find a calendar file, and put point at today's date.
Completion is provided for choosing which file, when called interactively."
(interactive (list (read-calendar-file-name)))
(find-file calendar-file-name)
(verify-visited-file-modtime (current-buffer))
(widen)
(move-to-today))
(defvar month-lengths '(("Jan" . 31) ("Feb" . 28) ("Mar" . 31)
("Apr" . 30) ("May" . 31) ("Jun" . 30)
("Jul" . 31) ("Aug" . 30) ("Sep" . 30)
("Oct" . 31) ("Nov" . 30) ("Dec" . 31))
"alist giving the length of each (named) month.")
(defun one-day (n)
"Make a string.number pair from N, for completion lists of days."
(cons (format "%02d" n) n))
(defun all-days (m)
"Make a completion list of days up to M."
(if (> m 0)
(cons (one-day m) (all-days (1- m)))
nil))
(defun do-months (mm)
"Make completion lists for all months in MM."
(if mm
(cons
(cons (car (car mm))
(all-days (cdr (car mm))))
(do-months (cdr mm)))
nil))
(defvar month-days (do-months month-lengths)
"An alist of the days in each month.")
(defun read-date ()
"Read a date, using completion, in the format for calendars."
(let* ((month (completing-read "Month: " month-days nil t))
(this-month-days (cdr (assoc month month-days))))
(concat month " "
(completing-read "Day: " this-month-days
nil t))))
(provide 'locate)
(defvar terminal-locations
'(("jung:console" . "the Meeting Room (at jung's console)")
("harlqn:console" . "the Machine Room (at harlqn's console)")
("wundt:console" . "the Machine Room (at wundt's console)")
("wundt:ttyb" . "the Pit (on Paul's terminal)")
("harlqn:tty09" . "the Pit (on Andy's terminal)")
("penny:ttyv0" . "the Pit (on Penny)")
("jung:ttya" . "Andrew and James' room (on Andrew's terminal)")
("harlqn:tty04" . "James and Andrew's room (on James's terminal)")
("freud:ttya" . "the Nursery (on Fil's terminal)")
;; we think it was this when the building was a used as a house!
("freud:console" . "the Nursery (at Freud's console)")
("harlqn:tty05" . "the Nursery (on John's terminal)")))
(defun locate-terminal (raw-terminal)
"Return a string describing the location of RAW-TERMINAL."
(let* ((terminal (substring raw-terminal
0 (string-match " " raw-terminal)))
(place (assoc terminal terminal-locations)))
(if place
(format "in %s" (cdr place))
(format "to %s" terminal))))
(defvar
locator-shell-command
"rwho -a | grep `grep -i %s /etc/passwd | head -1 | sed -e \"s/:.*//\"` | sort +5 | head -1"
"A shell command to find the terminal on which a given user $!
has most recently been active.")
(defun find-person-locally (person)
"Try to locate a person who is not thought to be away"
(message "%s has given no warning of being away today, looking locally..."
person)
(shell-command (format locator-shell-command person) nil)
(set-buffer (get-buffer "*Shell Command Output*"))
(goto-char (point-min))
(end-of-line 1)
(let ((rwho-string (buffer-substring (point-min) (point))))
(if (zerop (length rwho-string))
(format "Can't find %s" person)
(let* ((terminal (substring rwho-string 9 24))
(terminal-location (locate-terminal terminal))
(logon-time (substring rwho-string 22 34))
(idle-time (if (> (length rwho-string) 35)
(format ", idle for %s" (substring rwho-string 37))
"")))
(format "%s is logged on %s, since %s%s"
person terminal-location logon-time idle-time)))))
; ( (format "%s is probably somewhere around here" person))
(defun find-person-1 (person)
"Tells you where PERSON is thought to be.
Uses calendar.away to locate them if they are away."
(save-window-excursion
(diary "/jung/usr/local/lib/calendar.away")
(if (show-today)
(progn
(goto-char (point-min))
(if (search-forward person (point-max) t)
(progn
(beginning-of-line 1)
(let ((line-start (point)))
(end-of-line 1)
(let ((found (buffer-substring line-start (point))))
(widen)
(bury-buffer)
found)))
(find-person-locally person)))
(find-person-locally person))))
(defun locate (person)
"Tells you where PERSON is thought to be.
Uses calendar.away to locate them if they are away."
(interactive "sPerson: ")
(let ((found (find-person-1 person)))
(if (interactive-p) (message found))
found))
;;; end of calendar.el
--------------------------------cut here--------------------------------
--
__John All facts are useless, but some facts are more useless than others.
(After Ecclesiastes Chs. 1 & 2, 1 Corinthians 13:9,
and George Orwell's "Animal Farm")
jcgs@uk.co.harlqn Harlequin Ltd,Barrington,Cambridge,UK +44-223-872522
..!uunet!mcvax!ukc!harlqn!jcgs