Commit 8c6219eb authored by David Byers's avatar David Byers

Fix bug 1679

parent b2d3faed
2010-05-14 David Byers <davby@ida.liu.se>
Fix bug 1679:
* view-text.el (lyskom-format-mx-date): New function.
(lyskom-view-text): Use it.
(lyskom-mx-date-to-time): New implementation.
* utilities.el (lyskom-replace-in-list): New function.
* komtypes.el (def-komtype): Support :write-only keyword.
(time): Make yday and isdst read-only and write-only (we don't use
them and don't always set them correctly).
2010-05-13 David Byers <davby@ida.liu.se>
Emacs 24 compatibility
......
......@@ -55,6 +55,7 @@ Legal fiels properties are:
:default val In the constructor, if the value supplied for the
field is nil, use VAL instead.
:read-only t Do not create a mutator. Note that t must be specified.
:write-only t Do not create an accessor
:automatic val Do not include field in constructor. Use VAL for
the initial field value.
:filter code Use CODE as a filter for the field value supplied to
......@@ -137,13 +138,14 @@ Automatically created with def-komtype" type)
(lambda (arg)
(unless (eq arg '&optional)
(let ((field (or (car-safe arg) arg)))
(setq accessors
(cons `(defsubst ,(intern (format "%S->%S" type field)) (obj)
(lyskom-assert (or (null obj) (,(intern (format "lyskom-%S-p" type)) obj))
"Assertion failed in %s: got %S" ,(format "%S->%S" type field) obj)
,(format "Return field `%s' from OBJ." field)
(,access-method (cdr obj) ,field-index))
accessors))
(unless (plist-get (cdr-safe arg) ':write-only)
(setq accessors
(cons `(defsubst ,(intern (format "%S->%S" type field)) (obj)
(lyskom-assert (or (null obj) (,(intern (format "lyskom-%S-p" type)) obj))
"Assertion failed in %s: got %S" ,(format "%S->%S" type field) obj)
,(format "Return field `%s' from OBJ." field)
(,access-method (cdr obj) ,field-index))
accessors)))
(unless (plist-get (cdr-safe arg) ':read-only)
(setq mutators
(cons `(defsubst ,(intern (format "set-%S->%S" type field)) (obj val)
......@@ -393,15 +395,14 @@ Automatically created with def-komtype" type)
(mon :read-only t)
(year :read-only t)
(wday :read-only t)
(yday :read-only t)
(isdst :read-only t)
(yday :read-only t :write-only t)
(isdst :read-only t :write-only t)
&optional
(tzhr :read-only t)
(tzmin :read-only t))
(zone :read-only t))
:nil-safe)
(defun lyskom-create-time-from-utc (sec min hour mday mon year
wday yday isdst &optional tzhr tzmin)
wday yday isdst &optional zone)
(if lyskom-server-uses-utc
(let* ((date (decode-time (encode-time sec min hour mday mon year 0))))
(unless (eq mday (elt date 3))
......@@ -419,10 +420,10 @@ Automatically created with def-komtype" type)
(elt date 6) ; dow
yday ; yday
(elt date 7) ; dst
nil nil)
nil)
)
(lyskom-create-time sec min hour mday mon year
wday yday isdst tzhr tzmin)))
wday yday isdst nil)))
;;; ================================================================
......
......@@ -1927,6 +1927,9 @@ This command accepts text number prefix arguments \(see
(let ((lyskom-format-special nil)
(kom-smileys nil)
(kom-show-footnotes-immediately nil)
(kom-show-mx-date-as-local nil)
(kom-print-relative-dates nil)
(kom-print-seconds-in-time-strings t)
(kom-autowrap nil))
(unless kom-review-uses-cache
(cache-del-text-stat text-no))
......
......@@ -117,6 +117,13 @@ If BEFORE is not in the list, then insert EL at the end of the list."
(cons el (memq before list)))
list)))
(defun lyskom-replace-in-list (list idx newelt)
"Destructively replace LIST element at IDX with NEWELT."
(if (zerop idx)
(cons newelt (cdr list))
(setcdr (nthcdr (1- idx) list) (cons newelt (nthcdr (1+ idx) list)))
list))
(defun lyskom-move-in-list (el list pos)
"Destructively move EL within LIST so it appears at position POS."
(when (memq el list)
......@@ -1125,8 +1132,7 @@ of the week.
TIME defaults to the current client time."
(let* ((time (or time (lyskom-current-client-time)))
(fmt (cond
((stringp format)
format)
((stringp format) format)
((memq format '(date-and-time date time))
(lyskom-format (cond ((eq format 'date-and-time)
'format-time-date-and-time)
......@@ -1142,8 +1148,7 @@ TIME defaults to the current client time."
(if kom-print-seconds-in-time-strings
'timeformat-hh-mm-ss
'timeformat-hh-mm))))
((symbolp format)
(lyskom-get-string format))
((symbolp format) (lyskom-get-string format))
(t (error "Invalid argument")))))
(lyskom-format fmt
(time->year time)
......@@ -1155,7 +1160,23 @@ TIME defaults to the current client time."
(elt (lyskom-get-string 'weekdays)
(time->wday time))
(elt (lyskom-get-string 'weekdays-short)
(time->wday time)))))
(time->wday time))
(lyskom-format-timezone (time->zone time)))))
(defun lyskom-format-timezone (zone)
"Return a string representation of the timezone ZONE.
Returns nil if ZONE is nil."
(cond ((null zone) "")
((eq zone t) (lyskom-format-timezone (current-time-zone)))
((stringp zone) zone)
((listp zone) (car (cdr zone)))
((integerp zone)
(format "%s%02d%02d"
(if (< zone 0) "-" "+")
(/ (abs zone) 3600)
(/ (% (abs zone) 3600) 60)))
(t nil)))
;;; ============================================================
......
......@@ -1075,6 +1075,13 @@ for future use.
For this feature to work, the calendar package must be installed."
server)
(def-kom-var kom-show-mx-date-as-local t
"**Controls display of creation date of imported texts.
If set to `t' then display timestamps of imported texts in the local
timezone instead of the timezone specified in the timestamp."
server)
(def-kom-var kom-cite-string ">"
"**String to insert before each line of a commented text.
......
......@@ -123,16 +123,7 @@ Note that this function must not be called asynchronously."
text-stat
(list 'lyskom-text-start (text-stat->text-no text-stat))
(if mx-date
(let ((date (lyskom-mx-date-to-time mx-date)))
(if date
(concat
(lyskom-format-time 'date-and-time date)
(if (time->tzhr date)
(lyskom-format " %#1s%#2s"
(time->tzhr date)
(time->tzmin date))
""))
(aux-item->data mx-date)))
(lyskom-format-mx-date mx-date)
(lyskom-format-time 'date-and-time
(text-stat->creation-time text-stat)))
(text-stat->no-of-lines text-stat)
......@@ -1303,34 +1294,55 @@ Args: TEXT-STAT of the text being read."
)
author))
(defun lyskom-format-mx-date (mx-date)
(let ((date (lyskom-mx-date-to-time mx-date)))
(if date
(let ((tem (lyskom-format-time 'date-and-time date)))
(if (or kom-show-mx-date-as-local (null (time->zone date)))
tem
(concat tem " " (lyskom-format-timezone (time->zone date)))))
(aux-item->data mx-date))))
(lyskom-with-external-functions (calendar-iso-from-absolute
calendar-absolute-from-gregorian)
(defun lyskom-mx-date-to-time (mx-date)
"Attempt to convert MX-DATE to a lyskom time structure.
Returns the time structure if successful, otherwise nil."
(if (and mx-date
(condition-case nil
(progn (require 'calendar)
(require 'cal-iso)
t)
(error nil))
(string-match "\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\) \\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\) \\([-+][0-9][0-9]\\)?\\([0-9][0-9]\\)?"
(aux-item->data mx-date)))
(let* ((secs (string-to-number (match-string 6 (aux-item->data mx-date))))
(mins (string-to-number (match-string 5 (aux-item->data mx-date))))
(hour (string-to-number (match-string 4 (aux-item->data mx-date))))
(mday (string-to-number (match-string 3 (aux-item->data mx-date))))
(mon (string-to-number (match-string 2 (aux-item->data mx-date))))
(year (string-to-number (match-string 1 (aux-item->data mx-date))))
(tzhr (match-string 7 (aux-item->data mx-date)))
(tzmin (or (match-string 8 (aux-item->data mx-date)) ""))
(wday (abs
(elt
(calendar-iso-from-absolute
(calendar-absolute-from-gregorian
(list mon mday year)))
1))))
(lyskom-create-time secs mins hour mday mon year wday 0 nil tzhr tzmin)))))
(defun lyskom-mx-date-to-time (mx-date)
(when mx-date
(let* ((date (parse-time-string (aux-item->data mx-date)))
(now (decode-time))
(sec (or (elt date 0) 0))
(min (or (elt date 1) 0))
(hour (or (elt date 2) 0))
(day (or (elt date 3) (elt now 3)))
(month (or (elt date 4) (elt now 4)))
(year (or (elt date 5) (elt now 5)))
(wday (elt date 6))
(dst (elt date 7))
(zone (elt date 8)))
(setq date (if kom-show-mx-date-as-local
(decode-time (encode-time sec min hour day month year wday dst zone))
(list sec min hour day month year wday dst zone)))
(unless (elt date 6)
(setq date
(lyskom-replace-in-list
date 6
(abs (elt
(calendar-iso-from-absolute
(calendar-absolute-from-gregorian
(list (elt date 4) (elt date 3) (elt date 5))))
1)))))
(lyskom-create-time (elt date 0)
(elt date 1)
(elt date 2)
(elt date 3)
(elt date 4)
(elt date 5)
(elt date 6)
0
(elt date 7)
(elt date 8))))))
;;; Local Variables:
;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2)
......
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