Commit 523cd195 authored by David Byers's avatar David Byers
Browse files

Fix bug 291.

Detailed changes:
> 2003-01-01  David Byers  <david.byers@swipnet.se>
>
> 	Fix bug 291:
> 	* vars.el.in (lyskom-language): Added to minibuffer variables or
> 	lyskom-get-string will fail in predicate functions used in
> 	lyskom-verified-read-from-minibuffer.
>
> 	* commands2.el (kom-set-unread): Allow date entry in addition to
> 	number entry.
>
> 	Implement date input (for bug 291):
> 	* lyskom-rest.el (lyskom-verified-read-from-minibuffer): New function.
> 	(lyskom-verified-read-map): New variable.
> 	(lyskom-verified-read-enter): New function.
> 	(lyskom-verified-read-predicate): New variable.
> 	(lyskom-read-num-range-or-date): Nre function.
>
> 	* utilities.el (lyskom-read-date): New function.
>
>
1a22,31
>
> 	Implement date parsing (for bug 291):
> 	* utilities.el (lyskom-parse-date): Implemented the remaining
> 	branches in the parser. Fixed various bugs. Validate results
> 	before returning. This function should work now.
> 	(lyskom-is-leap-year): New function (date-leap-year-p doesn't
> 	exist in Emacs 19, so this is needed).
> 	(lyskom-days-in-month): New function.
> 	(lyskom-adjust-day-for-date): New function.
> 	(lyskom-month-limits): New variable.
parent 54a094b2
2003-01-01 David Byers <david.byers@swipnet.se>
Fix bug 291:
* vars.el.in (lyskom-language): Added to minibuffer variables or
lyskom-get-string will fail in predicate functions used in
lyskom-verified-read-from-minibuffer.
* commands2.el (kom-set-unread): Allow date entry in addition to
number entry.
Implement date input (for bug 291):
* lyskom-rest.el (lyskom-verified-read-from-minibuffer): New function.
(lyskom-verified-read-map): New variable.
(lyskom-verified-read-enter): New function.
(lyskom-verified-read-predicate): New variable.
(lyskom-read-num-range-or-date): Nre function.
* utilities.el (lyskom-read-date): New function.
2002-12-31 David Byers <david.byers@swipnet.se>
Implement date parsing (for bug 291):
* utilities.el (lyskom-parse-date): Implemented the remaining
branches in the parser. Fixed various bugs. Validate results
before returning. This function should work now.
(lyskom-is-leap-year): New function (date-leap-year-p doesn't
exist in Emacs 19, so this is needed).
(lyskom-days-in-month): New function.
(lyskom-adjust-day-for-date): New function.
(lyskom-month-limits): New variable.
Fix bug 879:
* utilities.el (lyskom-read-text-no-prefix-arg): When new-default
is computed successfully, set default to new-default. I *think*
......
......@@ -743,16 +743,26 @@ send. If DONTSHOW is non-nil, don't display the sent message."
(<= 0 narg)
(<= narg (conf-stat->no-of-texts conf-stat)))
narg
(lyskom-read-num-range
0 (conf-stat->no-of-texts conf-stat)
(lyskom-format 'only-last
(conf-stat->no-of-texts conf-stat)
(conf-stat->name conf-stat)))))
(result (blocking-do 'set-unread conf-no n))
(membership (blocking-do 'query-read-texts
lyskom-pers-no
conf-no)))
(lyskom-ignore result)
(lyskom-read-num-range-or-date 0 (conf-stat->no-of-texts conf-stat)
(lyskom-format 'only-last
(conf-stat->no-of-texts conf-stat)
(conf-stat->name conf-stat)))))
(membership nil))
(cond ((listp n)
(lyskom-format-insert 'set-unread-date
(elt n 0)
(car (rassq (elt n 1) lyskom-month-names))
(elt n 2))
(let* ((target-date (lyskom-create-time 0 0 0 (elt n 2) (elt n 1) (elt n 0) 0 0 nil))
(text (lyskom-find-text-by-date conf-stat target-date)))
(when text
(blocking-do 'set-last-read
(conf-stat->conf-no conf-stat)
(car text)))))
((numberp n)
(lyskom-format-insert 'set-unread-n n)
(blocking-do 'set-unread conf-no n)))
(setq membership (blocking-do 'query-read-texts lyskom-pers-no conf-no))
(lyskom-replace-membership membership)
(if (= conf-no lyskom-current-conf)
(set-read-list-empty lyskom-reading-list))
......
......@@ -1853,22 +1853,28 @@ environment to one that uses \"%#2s\" to encode text.
(has-nameday-1 . "Today's name is %#1s.")
(has-nameday-2 . "Today's names are %#1s and %#2s.")
(invalid-date-entry . "Invalid date")
(number-out-of-range . "Invalid number")
(or-date . "or date")
(set-unread-n . "Only read the most recent %#1d?[text%]%[%#1d texts%].\n")
(set-unread-date . "Only read texts sinse %#2s %#3d, %#1d.\n")
))
(lyskom-language-var local lyskom-month-names en
'(("jan" . 1) ("january" . 1)
("feb" . 2) ("february" . 2)
("mar" . 3) ("march" . 3)
("apr" . 4) ("april" . 4)
("may" . 5) ("may" . 5)
("jun" . 6) ("june" . 6)
("jul" . 7) ("july" . 7)
("aug" . 8) ("august" . 8)
("sep" . 9) ("september" . 9)
("oct" . 10) ("october" . 10)
("nov" . 11) ("november" . 11)
("dec" . 12) ("december" . 12)))
'(("january" . 1) ("jan" . 1)
("february" . 2) ("feb" . 2)
("march" . 3) ("mar" . 3)
("april" . 4) ("apr" . 4)
("may" . 5) ("may" . 5)
("june" . 6) ("jun" . 6)
("july" . 7) ("jul" . 7)
("august" . 8) ("aug" . 8)
("september" . 9) ("sep" . 9)
("october" . 10) ("oct" . 10)
("november" . 11) ("nov" . 11)
("december" . 12) ("dec" . 12)))
;;; ================================================================
......
......@@ -107,6 +107,11 @@
(put 'lyskom-internal-error 'error-message
"Internal LysKOM format error")
(put 'lyskom-error 'error-conditions
'(error))
(put 'lyskom-error 'error-message
"LysKOM error")
;;; ================================================================
;;; Global variables
......@@ -3332,7 +3337,66 @@ VECTOR has to be sorted with regard to <."
;; Search the left subtree
(t (lyskom-binsearch-internal num vector split last+1)))))
(defvar lyskom-verified-read-predicate nil)
(defun lyskom-verified-read-enter ()
(interactive)
(let* ((val (minibuffer-contents))
(err (funcall lyskom-verified-read-predicate val)))
(if err
(minibuffer-message (format " [%s]" err))
(exit-minibuffer))))
(defvar lyskom-verified-read-map nil)
(if lyskom-verified-read-map
nil
(setq lyskom-verified-read-map (copy-keymap minibuffer-local-map))
(define-key lyskom-verified-read-map (kbd "RET") 'lyskom-verified-read-enter)
(define-key lyskom-verified-read-map (kbd "C-j") 'lyskom-verified-read-enter)
(define-key lyskom-verified-read-map (kbd "C-m") 'lyskom-verified-read-enter)
)
(defun lyskom-verified-read-from-minibuffer (prompt initial pred)
"Read something from minibuffer, verifying that it is valid.
PROMPT is the prompt and INITIAL the initial contents of the minibuffer.
PRED is a predicate to check entered data. It should return nil or a string. If
it returns a string, the data is not valid and the string is used as an error
message."
(let ((lyskom-verified-read-predicate pred))
(lyskom-with-lyskom-minibuffer
(lyskom-read-from-minibuffer prompt initial lyskom-verified-read-map))))
(defun lyskom-read-num-range-or-date (low high prompt)
"Read a number or a date from the minibuffer.
Args: LOW HIGH PROMPT.
The result will be a number or a list of (YEAR MONTH DATE)."
(let ((result nil)
(val nil)
(prompt (concat (if (symbolp prompt) (lyskom-get-string prompt) prompt)
(format "(%d-%d %s) " low high (lyskom-get-string 'or-date)))))
(while (null result)
(setq val (lyskom-verified-read-from-minibuffer
prompt
val
(lambda (val)
(if (string-match "^\\s-*[0-9]+\\s-*$" val)
(let ((num (string-to-int val)))
(unless (and (>= num low) (<= num high))
(lyskom-get-string 'number-out-of-range)))
(condition-case nil
(progn (lyskom-parse-date val) nil)
(lyskom-error (lyskom-get-string 'invalid-date-entry)))))))
(if (string-match "^\\s-*[0-9]+\\s-*$" val)
(let ((num (string-to-int val)))
(when (and (>= num low) (<= num high))
(setq result num)))
(condition-case nil
(setq result (lyskom-parse-date val) )
(lyskom-error nil))))
result))
(defun lyskom-read-num-range (low high &optional prompt show-range default history nildefault)
"Read a number from the minibuffer.
Args: LOW HIGH &optional PROMPT SHOW-RANGE with default value DEFAULT.
......
......@@ -1871,22 +1871,27 @@ teckenkodning.
(has-nameday-1 . "%#1s har namnsdag i dag.")
(has-nameday-2 . "%#1s och %#2s har namnsdag i dag.")
(invalid-date-entry . "Ogiltigt datum")
(number-out-of-range . "Otilltet tal")
(or-date . "eller datum")
(set-unread-n . "Endast lsa %#1d?[det senaste inlgget%]%[de senase %#1d inlggen%].\n")
(set-unread-date . "Endast lsa inlgg sedan %#3d %#2s %#1d.\n")
))
(lyskom-language-var local lyskom-month-names sv
'(("jan" . 1) ("januari" . 1)
("feb" . 2) ("februari" . 2)
("mar" . 3) ("mars" . 3)
("apr" . 4) ("april" . 4)
("maj" . 5) ("maj" . 5)
("jun" . 6) ("juni" . 6)
("jul" . 7) ("juli" . 7)
("aug" . 8) ("augusti" . 8)
("sep" . 9) ("september" . 9)
("okt" . 10) ("oktober" . 10)
("nov" . 11) ("november" . 11)
("dec" . 12) ("december" . 12)))
'(("januari" . 1) ("jan" . 1)
("februari" . 2) ("feb" . 2)
("mars" . 3) ("mar" . 3)
("april" . 4) ("apr" . 4)
("maj" . 5) ("maj" . 5)
("juni" . 6) ("jun" . 6)
("juli" . 7) ("jul" . 7)
("augusti" . 8) ("aug" . 8)
("september" . 9) ("sep" . 9)
("oktober" . 10) ("okt" . 10)
("november" . 11) ("nov" . 11)
("december" . 12) ("dec" . 12)))
;;; ================================================================
......
......@@ -1535,12 +1535,13 @@ car of each element is the recipient number and the cdr is the type."
Returns a cons of (LOCAL . GLOBAL)"
(let* ((lowest (conf-stat->first-local-no conf-stat))
(highest (+ lowest (conf-stat->no-of-texts conf-stat)))
(conf-no (conf-stat->conf-no conf-stat))
(result nil)
(index (+ lowest (/ (- highest lowest) 2)))
(last-index (1- index)))
(while (/= last-index index)
(let* ((map (blocking-do 'local-to-global
(conf-stat->conf-no conf-stat)
conf-no
index
1)))
(cond ((null map) (setq lowest highest))
......@@ -1554,7 +1555,7 @@ Returns a cons of (LOCAL . GLOBAL)"
(lyskom-traverse misc
(text-stat->misc-info-list text-stat)
(when (and (memq (misc-info->type misc) lyskom-recpt-types-list)
(eq (misc-info->recipient-no misc) text-no))
(eq (misc-info->recipient-no misc) conf-no))
(lyskom-traverse-break
(if (misc-info->sent-at misc)
(misc-info->sent-at misc)
......@@ -1569,7 +1570,31 @@ Returns a cons of (LOCAL . GLOBAL)"
(setq result text-stat))))))
(setq last-index index)
(setq index (+ lowest (/ (- highest lowest) 2))))
(cons last-index result)))
(cons last-index (text-stat->text-no result))))
(defun lyskom-read-date (prompt)
"Read a date from the minibuffer.
Returns a list (YEAR MONTH DATE) corresponding to the user's input."
(let ((result nil)
(date nil))
(while (null result)
(setq date (lyskom-verified-read-from-minibuffer
prompt
date
(lambda (data)
(condition-case nil
(progn (lyskom-parse-date data)
nil)
(lyskom-error (lyskom-get-string 'invalid-date-entry))))))
(condition-case nil
(setq result (lyskom-parse-date date))
(lyskom-error nil)))
result))
(put 'lyskom-parse-date-invalid 'error-conditions
'(error lyskom-error))
(put 'lyskom-parse-date-invalid 'error-message
"Error parsing date")
(defvar lyskom-year-window-start 80
"Windowing threshold for YY year specifications.
......@@ -1577,24 +1602,41 @@ Years below this are considered in the 21st century. Years above this
in the 20th century")
(defun lyskom-parse-date (arg)
"Parse ARG as a date."
(let ((month-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (car el)))
lyskom-month-names
"\\|")
"\\)"))
(dmy-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (lyskom-get-string el)))
'(years year months month days day)
"\\|")
"\\)"))
(test-date (format-time-string "%x" '(20 0)))
year month day di mi yi)
;; Look at test-date to see where dates in ambiguous cases should go
"Parse ARG (a string) as a date.
Returns a list (YEAR MONTH DAY) corresponding to the date in ARG."
(let* ((month-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (car el)))
lyskom-month-names
"\\|")
"\\)"))
(y-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (lyskom-get-string el)))
'(years year)
"\\|")
"\\)"))
(m-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (lyskom-get-string el)))
'(months month)
"\\|")
"\\)"))
(d-regexp (concat "\\("
(mapconcat (lambda (el)
(regexp-quote (lyskom-get-string el)))
'(days day)
"\\|")
"\\)"))
(test-date (format-time-string "%x" '(20 0)))
(now (decode-time))
(current-day (elt now 3))
(current-month (elt now 4))
(current-year (elt now 5))
(case-fold-search t)
year month day di mi yi)
;; Look at test-date to see where dates in ambiguous cases should go
(cond ((string-match "01.*16.*70" test-date) (setq di 2 mi 1 yi 3))
((string-match "01.*70.*16" test-date) (setq di 3 mi 1 yi 2))
((string-match "16.*01.*70" test-date) (setq di 1 mi 2 yi 3))
......@@ -1602,27 +1644,33 @@ in the 20th century")
((string-match "70.*01.*16" test-date) (setq di 3 mi 2 yi 1))
((string-match "70.*16.*01" test-date) (setq di 2 mi 3 yi 1)))
(cond ((string-match "\\([0-9][0-9][0-9][0-9]\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)" arg)
;; Match various variants
(cond ((string-match "^\\([0-9][0-9][0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)$" arg)
;; YYYY-MM-DD
(setq year (string-to-int (match-string 1 arg))
month (string-to-int (match-string (if (> mi di) 3 2) arg))
day (string-to-int (match-string (if (> di mi) 2 3) arg)))
day (string-to-int (match-string (if (> mi di) 2 3) arg)))
(when (> month 12) (setq month day day month))
)
((string-match "\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9][0-9][0-9]?\\)" arg)
;; YYYY-MM-DD
((string-match "^\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9][0-9][0-9]?\\)$" arg)
;; MM-DD-YYYY
(setq year (string-to-int (match-string 3 arg))
month (string-to-int (match-string (if (> mi di) 2 1) arg))
day (string-to-int (match-string (if (> di mi) 1 2) arg)))
day (string-to-int (match-string (if (> mi di) 1 2) arg)))
(when (> month 12) (setq month day day month))
)
((string-match "\\([0-9][0-9]\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)" arg)
((string-match "^\\([0-9][0-9]\\)[-./]\\([0-9][0-9]?\\)[-./]\\([0-9][0-9]?\\)$" arg)
;; Ambiguous:
;; YY/MM/DD, YY/DD/MM, MM/DD/YY, DD/MM/YY
(setq year (string-to-int (match-string yi arg))
month (string-to-int (match-string mi arg))
day (string-to-int (match-string di arg)))
(when (> month 12) (setq month day day month))
)
((string-match "\\([0-9][0-9]\\)/\\([0-9][0-9]\\)" arg)
((string-match "^\\([0-9][0-9]\\)/\\([0-9][0-9]\\)$" arg)
;; Ambiguous:
;; MM/DD Euro
;; DD/MM US
......@@ -1633,37 +1681,140 @@ in the 20th century")
((> di mi) (setq month b day a))
(t (setq month a day b))))
)
((string-match (format "%s \\([0-9][0-9]?\\)" month-regexp) arg)
;; Ambiguous:
;; Month DD
((string-match (format "^\\([0-9][0-9]?\\) %s \\([0-9][0-9][0-9][0-9]\\)$" month-regexp) arg)
;; DD Month YYYY
(setq day (string-to-int (match-string 1 arg))
month (cdr (lyskom-string-assoc (match-string 2 arg) lyskom-month-names))
year (string-to-int (match-string 3 arg)))
)
((string-match (format "^%s \\([0-9][0-9]?\\), \\([0-9][0-9][0-9]?[0-9]?\\)$" month-regexp) arg)
;; Month DD, YYYY
(setq day (string-to-int (match-string 2 arg))
month (cdr (lyskom-string-assoc (match-string 1 arg) lyskom-month-names))
year (string-to-int (match-string 3 arg)))
)
((string-match (format "%s,? \\([0-9][0-9][0-9][0-9]\\)" month-regexp) arg)
((string-match (format "^\\([0-9][0-9]?\\) %s, \\([0-9][0-9][0-9]?[0-9]?\\)$" month-regexp) arg)
;; DD Month, YYYY
(setq day (string-to-int (match-string 1 arg))
month (cdr (lyskom-string-assoc (match-string 2 arg) lyskom-month-names))
year (string-to-int (match-string 3 arg)))
)
((string-match (format "^%s,? \\([0-9][0-9][0-9][0-9]\\)$" month-regexp) arg)
;; Ambiguous:
;; Month YYYY
(setq day 1
month (cdr (lyskom-string-assoc (match-string 1 arg) lyskom-month-names))
year (string-to-int (match-string 2 arg)))
)
((string-match (format "\\([0-9][0-9]?\\) %s" month-regexp) arg)
((string-match (format "^%s \\([0-9][0-9]?\\)$" month-regexp) arg)
;; Ambiguous:
;; Month DD, Month YY
(setq month (cdr (lyskom-string-assoc (match-string 1 arg) lyskom-month-names))
day (string-to-int (match-string 2 arg))
year current-year)
(when (> day 31) (setq day 1 year day))
)
((string-match (format "^\\([0-9][0-9]?\\) %s$" month-regexp) arg)
;; DD Month
(setq day (string-to-int (match-string 1 arg))
month (cdr (lyskom-string-assoc (match-string 2 arg) lyskom-month-names))
year current-year)
)
((string-match (format "\\([0-9][0-9]?\\) %s \\([0-9][0-9][0-9][0-9]\\)" month-regexp) arg)
;; DD Month YYYY
((string-match (format "^-\\([0-9]+\\) %s$" y-regexp) arg)
;; -NN years
(setq year (- current-year (string-to-int (match-string 1 arg)))
day current-day
month current-month)
)
((string-match (format "%s \\([0-9][0-9]?\\), \\([0-9][0-9][0-9]?[0-9]?\\)" month-regexp) arg)
;; Month DD, YYYY
((string-match (format "^-\\([0-9]+\\) %s$" m-regexp) arg)
;; -NN months
(setq year current-year month current-month day current-day)
(let ((count (string-to-int (match-string 1 arg))))
(while (> count 0)
(if (>= count month)
(setq count (- count month)
year (1- year)
month 12)
(setq month (- month count) count 0))))
(setq day (lyskom-adjust-day-for-date year month day))
)
((string-match (format "\\([0-9][0-9]?\\) %s, \\([0-9][0-9][0-9]?[0-9]?\\)" month-regexp) arg)
;; DD Month, YYYY
((string-match (format "^-\\([0-9]+\\) %s$" d-regexp) arg)
;; -NN days
;; Theres probably an off-by-one error in this code on year transitions
;; but I really don't care.
(setq year current-year month current-month day current-day)
(let ((count (string-to-int (match-string 1 arg))))
(while (> count 0)
(if (>= count day)
(progn (setq count (- count day) month (1- month))
(when (< month 1) (setq month 12 year (1- year)))
(setq day (lyskom-adjust-day-for-date year month 31)))
(setq day (- day count) count 0))))
(setq day (lyskom-adjust-day-for-date year month day))
)
((string-match (format "-\\([0-9]+\\) %s" dmy-regexp) arg)
;; -NN days, months, years
((string-match "^\\([0-9][0-9][0-9][0-9]?\\)$" arg)
;; YYYY goes last because the pattern is the most general
(setq year (string-to-int (match-string 0 arg)) month 1 day 1)
)
(t (signal 'lyskom-parse-date-invalid (list (format "Unrecognized date: %s" arg))))
)
(if (< year lyskom-year-window-start)
(setq year (+ 2000 year))
(setq year (+ 1900 year)))
(list year month day)
))
;; Do the window thing for two-digit dates
(cond ((< year lyskom-year-window-start) (setq year (+ 2000 year)))
((< year 100) (setq year (+ 1900 year))))
;; Check date validity. Check month before checking days-in-month or stuff breaks
(when (or (< month 1) (< day 1) (> month 12)
(> day (lyskom-days-in-month year month)))
(signal 'lyskom-parse-date-invalid (list (format "Invalid date: %s" arg))))
(list year month day)
))
(defvar lyskom-month-limits '[31 ; Jan
28 ; Feb (non-leap)
31 ; Mar
30 ; Apr
31 ; May
30 ; Jun
30 ; Jul
31 ; Aug
30 ; Sep
31 ; Oct
30 ; Nov
31 ; Dec
]
"Number of days in various months. The value for february is not used.")
(defun lyskom-is-leap-year (year)
"Return non-nil if YEAR is a leap year."
(or (and (zerop (% year 4))
(not (zerop (% year 100))))
(zerop (% year 400))))
(defun lyskom-days-in-month (year month)
"Return the number of days mONTH of YEAR.
Args: YEAR MONTH"
(cond ((eq month 2) (if (lyskom-is-leap-year year) 29 28))
(t (elt lyskom-month-limits (1- month)))))
(defun lyskom-adjust-day-for-date (year month day)
"Return an appropriate day of month for a combination of YEAR, MONTH and DAY.
If DAY is too high for YEAR and MONTH, return the maximum permissible DAY for
that combination. Otherwise return DAY."
(let ((mdays (lyskom-days-in-month year month)))
(if (> day mdays) mdays day)))
;;; ================================================================
......
......@@ -1400,6 +1400,7 @@ All choices are listed in `lyskom-languages'"
(def-kom-var lyskom-language kom-default-language
local
inherited
minibuffer
protected
"The language currently in use for messages.")
......@@ -1437,7 +1438,8 @@ each time ."
"A list of month names.
Each element is a cons cell consisting of the name of the month
\(a symbol) and the number of the month (1-12). Each month may
appear more than once"
appear more than once, but the first occurence should be the
preferred name of the month."
local
inherited
language-force)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment