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

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