[PATCH] Add syntax, case support for Greek
18 years
Aidan Kehoe
Aidan Kehoe
lisp/ChangeLog addition:
2006-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* mule/greek.el:
Support case tables, syntax for greek-iso8859-7.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: lisp/mule/greek.el
===================================================================
RCS
Index: lisp/mule/greek.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mule/greek.el,v
retrieving revision 1.5
diff -u -r1.5 greek.el
--- lisp/mule/greek.el 2002/03/16 10:39:06 1.5
+++ lisp/mule/greek.el 2006/12/15 17:13:15
＠＠ -29,27 +29,72 ＠＠
;;; Code:
-; (make-charset 'greek-iso8859-7
-; "Right-Hand Part of Latin/Greek Alphabet (ISO/IEC 8859-7): ISO-IR-126"
-; '(dimension
-; 1
-; registry "ISO8859-7"
-; chars 96
-; columns 1
-; direction l2r
-; final ?F
-; graphic 1
-; short-name "RHP of ISO8859/7"
-; long-name "RHP of Greek (ISO 8859-7): ISO-IR-126"
-; ))
+(loop
+ for (upper lower)
+ in '((#xdb #xfb) ;; UPSILON WITH DIALYTIKA
+ (#xda #xfa) ;; IOTA WITH DIALYTIKA
+ (#xd9 #xf9) ;; OMEGA
+ (#xd8 #xf8) ;; PSI
+ (#xd7 #xf7) ;; CHI
+ (#xd6 #xf6) ;; PHI
+ (#xd5 #xf5) ;; UPSILON
+ (#xd4 #xf4) ;; TAU
+ (#xd3 #xf3) ;; SIGMA
+ (#xd1 #xf1) ;; RHO
+ (#xd0 #xf0) ;; PI
+ (#xcf #xef) ;; OMICRON
+ (#xce #xee) ;; XI
+ (#xcd #xed) ;; NU
+ (#xcc #xec) ;; MU
+ (#xcb #xeb) ;; LAMDA
+ (#xca #xea) ;; KAPPA
+ (#xc9 #xe9) ;; IOTA
+ (#xc8 #xe8) ;; THETA
+ (#xc7 #xe7) ;; ETA
+ (#xc6 #xe6) ;; ZETA
+ (#xc5 #xe5) ;; EPSILON
+ (#xc4 #xe4) ;; DELTA
+ (#xc3 #xe3) ;; GAMMA
+ (#xc2 #xe2) ;; BETA
+ (#xc1 #xe1) ;; ALPHA
+ (#xbf #xfe) ;; OMEGA WITH TONOS
+ (#xbe #xfd) ;; UPSILON WITH TONOS
+ (#xbc #xfc) ;; OMICRON WITH TONOS
+ (#xba #xdf) ;; IOTA WITH TONOS
+ (#xb9 #xde) ;; ETA WITH TONOS
+ (#xb8 #xdd) ;; EPSILON WITH TONOS
+ (#xb6 #xdc) ;; ALPHA WITH TONOS
+ (#xD3 #xF2)) ;; FINAL SIGMA
+ ;; No case mappings for:
+ ;;
+ ;; (#xE0 "GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS")
+ ;; (#xC0 "GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS")
+ ;;
+ with case-table = (standard-case-table)
+ do
+ (put-case-table-pair (make-char 'greek-iso8859-7 upper)
+ (make-char 'greek-iso8859-7 lower) case-table))
+
+;; Now, syntax.
+(dolist (code '(#xA1 ;; LEFT SINGLE QUOTATION MARK
+ #xA2 ;; RIGHT SINGLE QUOTATION MARK
+ #xA3 ;; POUND SIGN
+ #xA6 ;; BROKEN BAR
+ #xA7 ;; SECTION SIGN
+ #xA8 ;; DIAERESIS
+ #xA9 ;; COPYRIGHT SIGN
+ #xAB ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+ #xAC ;; NOT SIGN
+ #xAD ;; SOFT HYPHEN
+ #xAF ;; HORIZONTAL BAR
+ #xB0 ;; DEGREE SIGN
+ #xB1 ;; PLUS-MINUS SIGN
+ #xB7 ;; MIDDLE DOT
+ #xBB)) ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+ (modify-syntax-entry (make-char 'greek-iso8859-7 code) "."))
-;; For syntax of Greek
-(loop for c from 54 to 126
- do (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w"))
-(modify-syntax-entry (make-char 'greek-iso8859-7 32) "w") ; no-break space
-(modify-syntax-entry ?,F7(B ".")
-(modify-syntax-entry ?,F;(B ".")
-(modify-syntax-entry ?,F=(B ".")
+;; NO-BREAK SPACE
+(modify-syntax-entry (make-char 'greek-iso8859-7 #xA0) " ")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
＠＠ -57,24 +102,13 ＠＠
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (make-coding-system
-;; 'greek-iso-8bit 2 ?7
-;; "ISO 2022 based 8-bit encoding for Greek (MIME:ISO-8859-7)"
-;; '(ascii greek-iso8859-7 nil nil
-;; nil nil nil nil nil nil nil)
-;; '((safe-charsets ascii greek-iso8859-7)
-;; (mime-charset . iso-8859-7)))
-
-;; (define-coding-system-alias 'iso-8859-7 'greek-iso-8bit)
-
(make-coding-system
'iso-8859-7 'iso2022 "ISO-8859-7 (Greek)"
'(charset-g0 ascii
charset-g1 greek-iso8859-7
charset-g2 t
charset-g3 t
- mnemonic "Grk"
- ))
+ mnemonic "Grk"))
(set-language-info-alist
"Greek" '((charset greek-iso8859-7)
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
Re: [21.4] Patch for consistent crash with Linux native sound on AMD64
18 years
Aidan Kehoe
Aidan Kehoe
Ar an séú lá déag de mí na Nollaig, scríobh Stephen J. Turnbull:
> As long as the size_t data is solely used to communicate with external
> code such as device drivers, it's best to use size_t explicitly (and
> probably document it with a comment).
The communication with the device drivers is by means of write(). Using
size_t with write() and propagation of unsignedness with that was exactly
our problem with size_t, if I remember it correctly. I admit it unlikely
that more than 2^^31 (or 2^^63) bytes of data will be written to a sound
card.
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[21.4] Patch for consistent crash with Linux native sound on AMD64
18 years
Hans de Graaff
Hans de Graaff
On my AMD64 machine I can crash XEmacs 21.4.20 consistently by starting
xemacs and doing two page-ups. I'm using Linux native sound right now, and
that seems to be the problem. (I remember this crash from .19 as well but
didn't have time to investigate then.)
The following patch fixes things for me and makes sense since prtn and rrtn
are later recast as a size_t.
Kind regards,
Hans
Index: src/linuxplay.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/linuxplay.c,v
retrieving revision 1.13
diff -u -B -r1.13 linuxplay.c
--- src/linuxplay.c 2001/04/12 18:23:58 1.13
+++ src/linuxplay.c 2006/12/11 20:39:44
＠＠ -290,7 +290,8 ＠＠
fmtType ffmt;
int fmt,speed,tracks;
unsigned char *pptr,*optr,*cptr,*sptr;
- int wrtn,rrtn,crtn,prtn;
+ int wrtn,crtn;
+ size_t prtn,rrtn;
unsigned char sndbuf[SNDBUFSZ];
/* We need to read at least the header information before we can start
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
Not Requiring MSVCRTD.dll
18 years
Vin Shelton
Vin Shelton
Greetings -
Benson points out that the XEmacs-21.5 install kits I have been
creating (ftp://ftp.xemacs.org/pub/xemacs/windows/testing/XEmacs_Setup_21.5...)
require MSVRCTD.dll. This requires that the person installing the kit
have Visual Studio 6.0 installed.
This happens because I'm building the kits with debugging enabled and
xemacs.mak has the following logic:
!if $(USE_CRTDLL)
! if $(DEBUG_XEMACS)
C_LIBFLAG=-MDd
LIBC_LIB=msvcrtd.lib
! else
C_LIBFLAG=-MD
LIBC_LIB=msvcrt.lib
! endif
!else
C_LIBFLAG=-ML
LIBC_LIB=libc.lib
!endif
Apparently, -MDd is not really required in order to debug; I can work
around this in the kit generation process, or I can generate a patch
to change xemacs.mak. Please let me know if you think I should change
the logic of xemacs.mak.
Thanks,
Vin
--
The Journey by Mary Oliver
http://www.poemhunter.com/p/m/poem.asp?poet=6771&poem=30506
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[PATCH] Import Edward O'Connor's json.el.
18 years
Aidan Kehoe
Aidan Kehoe
An issue with this is that the package uses encode-char and decode-char with
'ucs as an argument, something 21.4 doesn’t have without Mule-UCS, and which
non-Mule builds don’t have at all. This means I have to edit it to be
compilable by non-Mule 21.4, but if anyone has objections to the other
aspects of the import, I’d love to hear them.
xemacs-packages/net-utils/ChangeLog addition:
2006-12-11 Aidan Kehoe <kehoea(a)parhasard.net>
* json.el: New.
Add support for Douglas Crockford's JavaScript Object Notation, as
implemented by Edward O'Connor.
XEmacs Packages source patch:
Diff command: cvs -q diff -Nu
Files affected: xemacs-packages/net-utils/json.el
===================================================================
RCS
Index: xemacs-packages/net-utils/json.el
===================================================================
RCS file: json.el
diff -N json.el
--- /dev/null Mon Dec 11 22:09:08 2006
+++ json.el Mon Dec 11 22:08:19 2006
＠＠ -0,0 +1,522 ＠＠
+;;; json.el --- JavaScript Object Notation parser / generator
+
+;; Copyright (C) 2006 Edward O'Connor <ted(a)oconnor.cx>
+
+;; Author: Edward O'Connor <ted(a)oconnor.cx>
+;; Keywords: convenience
+
+;; This file is NOT part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2, or (at your option) any later
+;; version.
+
+;; This file is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with Emacs; see the file COPYING, or type `C-h C-c'. If not,
+;; write to the Free Software Foundation at this address:
+
+;; Free Software Foundation
+;; 51 Franklin Street, Fifth Floor
+;; Boston, MA 02110-1301
+;; USA
+
+;;; Commentary:
+
+;; This is a library for parsing and generating JSON (JavaScript Object
+;; Notation).
+
+;; Learn all about JSON here: <URL:http://json.org/>.
+
+;; The user-serviceable entry points for the parser are the functions
+;; `json-read' and `json-read-from-string'. The encoder has a single
+;; entry point, `json-encode'.
+
+;; Since there are several natural representations of key-value pair
+;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
+;; to specify which you'd prefer (see `json-object-type' and
+;; `json-array-type').
+
+;; Similarly, since `false' and `null' are distinct in JSON, you can
+;; distinguish them by binding `json-false' and `json-null' as desired.
+
+;; The latest version of json.el can be found here:
+
+;; <URL:http://edward.oconnor.cx/elisp/json.el>
+
+;;; History:
+
+;; 2006-03-11 - Initial version.
+;; 2006-03-13 - Added JSON generation in addition to parsing. Various
+;; other cleanups, bugfixes, and improvements.
+
+;;; Code:
+
+;; Parameters
+
+(defvar json-object-type 'alist
+ "Type to convert JSON objects to.
+Must be one of `alist', `plist', or `hash-table'. Consider let-binding
+this around your call to `json-read' instead of `setq'ing it.")
+
+(defvar json-array-type 'vector
+ "Type to convert JSON arrays to.
+Must be one of `vector' or `list'. Consider let-binding this around
+your call to `json-read' instead of `setq'ing it.")
+
+(defvar json-key-type nil
+ "Type to convert JSON keys to.
+Must be one of `string', `symbol', `keyword', or nil.
+
+If nil, `json-read' will guess the type based on the value of
+`json-object-type':
+
+ If `json-object-type' is: nil will be interpreted as:
+ `hash-table' `string'
+ `alist' `symbol'
+ `plist' `keyword'
+
+Note that values other than `string' might behave strangely for
+Sufficiently Weird keys. Consider let-binding this around your call to
+`json-read' instead of `setq'ing it.")
+
+(defvar json-false :json-false
+ "Value to use when reading JSON `false'.
+If this has the same value as `json-read-null-value', you might not be
+able to tell the difference between `false' and `null'. Consider let-
+binding this around your call to `json-read' instead of `setq'ing it.")
+
+(defvar json-null nil
+ "Value to use when reading JSON `null'.
+If this has the same value as `json-read-false-value', you might not be
+able to tell the difference between `false' and `null'. Consider let-
+binding this around your call to `json-read' instead of `setq'ing it.")
+
+
+
+;;; Utilities
+
+(defun json-join (strings separator)
+ "Join STRINGS with SEPARATOR."
+ (mapconcat 'identity strings separator))
+
+(defun json-alist-p (list)
+ "Non-null iff LIST is an alist."
+ (or (null list)
+ (and (consp (car list))
+ (json-alist-p (cdr list)))))
+
+(defun json-plist-p (list)
+ "Non-null iff LIST is a plist."
+ (or (null list)
+ (and (keywordp (car list))
+ (consp (cdr list))
+ (json-plist-p (cddr list)))))
+
+;; Reader utilities
+
+(defsubst json-advance (&optional n)
+ "Skip past the following N characters."
+ (unless n (setq n 1))
+ (let ((goal (+ (point) n)))
+ (goto-char goal)
+ (when (< (point) goal)
+ (signal 'end-of-file nil))))
+
+(defsubst json-peek ()
+ "Return the character at point."
+ (let ((char (char-after (point))))
+ (or char :json-eof)))
+
+(defsubst json-pop ()
+ "Advance past the character at point, returning it."
+ (let ((char (json-peek)))
+ (if (eq char :json-eof)
+ (signal 'end-of-file nil)
+ (json-advance)
+ char)))
+
+(defun json-skip-whitespace ()
+ "Skip past the whitespace at point."
+ (while (looking-at "[\t\r\n\f\b ]")
+ (goto-char (match-end 0))))
+
+
+
+;; Error conditions
+
+(put 'json-error 'error-message "Unknown JSON error")
+(put 'json-error 'error-conditions '(json-error error))
+
+(put 'json-readtable-error 'error-message "JSON readtable error")
+(put 'json-readtable-error 'error-conditions
+ '(json-readtable-error json-error error))
+
+(put 'json-unknown-keyword 'error-message "Unrecognized keyword")
+(put 'json-unknown-keyword 'error-conditions
+ '(json-unknown-keyword json-error error))
+
+(put 'json-number-format 'error-message "Invalid number format")
+(put 'json-number-format 'error-conditions
+ '(json-number-format json-error error))
+
+(put 'json-string-escape 'error-message "Bad unicode escape")
+(put 'json-string-escape 'error-conditions
+ '(json-string-escape json-error error))
+
+(put 'json-string-format 'error-message "Bad string format")
+(put 'json-string-format 'error-conditions
+ '(json-string-format json-error error))
+
+(put 'json-object-format 'error-message "Bad JSON object")
+(put 'json-object-format 'error-conditions
+ '(json-object-format json-error error))
+
+
+
+;;; Keywords
+
+(defvar json-keywords '("true" "false" "null")
+ "List of JSON keywords.")
+
+;; Keyword parsing
+
+(defun json-read-keyword (keyword)
+ "Read a JSON keyword at point.
+KEYWORD is the keyword expected."
+ (unless (member keyword json-keywords)
+ (signal 'json-unknown-keyword (list keyword)))
+ (mapc (lambda (char)
+ (unless (char-equal char (json-peek))
+ (signal 'json-unknown-keyword
+ (list (save-excursion
+ (backward-word 1)
+ (word-at-point)))))
+ (json-advance))
+ keyword)
+ (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
+ (signal 'json-unknown-keyword
+ (list (save-excursion
+ (backward-word 1)
+ (word-at-point)))))
+ (cond ((string-equal keyword "true") t)
+ ((string-equal keyword "false") json-false)
+ ((string-equal keyword "null") json-null)))
+
+;; Keyword encoding
+
+(defun json-encode-keyword (keyword)
+ "Encode KEYWORD as a JSON value."
+ (cond ((eq keyword t) "true")
+ ((eq keyword json-false) "false")
+ ((eq keyword json-null) "null")))
+
+;;; Numbers
+
+;; Number parsing
+
+(defun json-read-number ()
+ "Read the JSON number following point."
+ (if (char-equal (json-peek) ?-)
+ (progn
+ (json-advance)
+ (- 0 (json-read-number)))
+ (if (looking-at "[0-9]+\\([.][0-9]+\\)?\\([eE][+-]?[0-9]+\\)?")
+ (progn
+ (goto-char (match-end 0))
+ (string-to-number (match-string 0)))
+ (signal 'json-number-format (list (point))))))
+
+;; Number encoding
+
+(defun json-encode-number (number)
+ "Return a JSON representation of NUMBER."
+ (format "%s" number))
+
+;;; Strings
+
+(defvar json-special-chars
+ '((?\" . ?\")
+ (?\\ . ?\\)
+ (?/ . ?/)
+ (?b . ?\b)
+ (?f . ?\f)
+ (?n . ?\n)
+ (?r . ?\r)
+ (?t . ?\t))
+ "Characters which are escaped in JSON, with their elisp counterparts.")
+
+;; String parsing
+
+(defun json-read-escaped-char ()
+ "Read the JSON string escaped character at point."
+ ;; Skip over the '\'
+ (json-advance)
+ (let* ((char (json-pop))
+ (special (assq char json-special-chars)))
+ (cond
+ (special (cdr special))
+ ((not (eq char ?u)) char)
+ ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
+ (let ((hex (match-string 0)))
+ (json-advance 4)
+ (decode-char 'ucs (string-to-number hex 16))))
+ (t
+ (signal 'json-string-escape (list (point)))))))
+
+(defun json-read-string ()
+ "Read the JSON string at point."
+ (unless (char-equal (json-peek) ?\")
+ (signal 'json-string-format (list "doesn't start with '\"'!")))
+ ;; Skip over the '"'
+ (json-advance)
+ (let ((characters '())
+ (char (json-peek)))
+ (while (not (char-equal char ?\"))
+ (push (if (char-equal char ?\\)
+ (json-read-escaped-char)
+ (json-pop))
+ characters)
+ (setq char (json-peek)))
+ ;; Skip over the '"'
+ (json-advance)
+ (if characters
+ (apply 'string (nreverse characters))
+ "")))
+
+;; String encoding
+
+(defun json-encode-char (char)
+ "Encode CHAR as a JSON string."
+ (setq char (encode-char char 'ucs))
+ (let ((control-char (car (rassoc char json-special-chars))))
+ (cond
+ ;; Special JSON character (\n, \r, etc.)
+ (control-char
+ (format "\\%c" control-char))
+ ;; ASCIIish printable character
+ ((and (> char 31) (< char 161))
+ (format "%c" char))
+ ;; Fallback: UCS code point in \uNNNN form
+ (t
+ (format "\\u%04x" char)))))
+
+(defun json-encode-string (string)
+ "Return a JSON representation of STRING."
+ (format "\"%s\"" (mapconcat 'json-encode-char string "")))
+
+;;; JSON Objects
+
+(defun json-new-object ()
+ "Create a new Elisp object corresponding to a JSON object.
+Please see the documentation of `json-object-type'."
+ (cond ((eq json-object-type 'hash-table)
+ (make-hash-table :test 'equal))
+ (t
+ (list))))
+
+(defun json-add-to-object (object key value)
+ "Add a new KEY -> VALUE association to OBJECT.
+Returns the updated object, which you should save, e.g.:
+ (setq obj (json-add-to-object obj \"foo\" \"bar\"))
+Please see the documentation of `json-object-type' and `json-key-type'."
+ (let ((json-key-type
+ (if (eq json-key-type nil)
+ (cdr (assq json-object-type '((hash-table . string)
+ (alist . symbol)
+ (plist . keyword))))
+ json-key-type)))
+ (setq key
+ (cond ((eq json-key-type 'string)
+ key)
+ ((eq json-key-type 'symbol)
+ (intern key))
+ ((eq json-key-type 'keyword)
+ (intern (concat ":" key)))))
+ (cond ((eq json-object-type 'hash-table)
+ (puthash key value object)
+ object)
+ ((eq json-object-type 'alist)
+ (cons (cons key value) object))
+ ((eq json-object-type 'plist)
+ (cons key (cons value object))))))
+
+;; JSON object parsing
+
+(defun json-read-object ()
+ "Read the JSON object at point."
+ ;; Skip over the "{"
+ (json-advance)
+ (json-skip-whitespace)
+ ;; read key/value pairs until "}"
+ (let ((elements (json-new-object))
+ key value)
+ (while (not (char-equal (json-peek) ?}))
+ (json-skip-whitespace)
+ (setq key (json-read-string))
+ (json-skip-whitespace)
+ (if (char-equal (json-peek) ?:)
+ (json-advance)
+ (signal 'json-object-format (list ":" (json-peek))))
+ (setq value (json-read))
+ (setq elements (json-add-to-object elements key value))
+ (json-skip-whitespace)
+ (unless (char-equal (json-peek) ?})
+ (if (char-equal (json-peek) ?,)
+ (json-advance)
+ (signal 'json-object-format (list "," (json-peek))))))
+ ;; Skip over the "}"
+ (json-advance)
+ elements))
+
+;; Hash table encoding
+
+(defun json-encode-hash-table (hash-table)
+ "Return a JSON representation of HASH-TABLE."
+ (format "{%s}"
+ (json-join
+ (let (r)
+ (maphash
+ (lambda (k v)
+ (push (format "%s:%s"
+ (json-encode k)
+ (json-encode v))
+ r))
+ hash-table)
+ r)
+ ", ")))
+
+;; List encoding (including alists and plists)
+
+(defun json-encode-alist (alist)
+ "Return a JSON representation of ALIST."
+ (format "{%s}"
+ (json-join (mapcar (lambda (cons)
+ (format "%s:%s"
+ (json-encode (car cons))
+ (json-encode (cdr cons))))
+ alist)
+ ", ")))
+
+(defun json-encode-plist (plist)
+ "Return a JSON representation of PLIST."
+ (let (result)
+ (while plist
+ (push (concat (json-encode (car plist))
+ ":"
+ (json-encode (cadr plist)))
+ result)
+ (setq plist (cddr plist)))
+ (concat "{" (json-join (nreverse result) ", ") "}")))
+
+(defun json-encode-list (list)
+ "Return a JSON representation of LIST.
+Tries to DWIM: simple lists become JSON arrays, while alists and plists
+become JSON objects."
+ (cond ((null list) "null")
+ ((json-alist-p list) (json-encode-alist list))
+ ((json-plist-p list) (json-encode-plist list))
+ ((listp list) (json-encode-array list))
+ (t
+ (signal 'json-error (list list)))))
+
+;;; Arrays
+
+;; Array parsing
+
+(defun json-read-array ()
+ "Read the JSON array at point."
+ ;; Skip over the "["
+ (json-advance)
+ (json-skip-whitespace)
+ ;; read values until "]"
+ (let (elements)
+ (while (not (char-equal (json-peek) ?\]))
+ (push (json-read) elements)
+ (json-skip-whitespace)
+ (unless (char-equal (json-peek) ?\])
+ (if (char-equal (json-peek) ?,)
+ (json-advance)
+ (signal 'json-error (list 'bleah)))))
+ ;; Skip over the "]"
+ (json-advance)
+ (apply json-array-type (nreverse elements))))
+
+;; Array encoding
+
+(defun json-encode-array (array)
+ "Return a JSON representation of ARRAY."
+ (concat "[" (mapconcat 'json-encode array ", ") "]"))
+
+
+
+;;; JSON reader.
+
+(defvar json-readtable
+ (let ((table
+ '((?t json-read-keyword "true")
+ (?f json-read-keyword "false")
+ (?n json-read-keyword "null")
+ (?{ json-read-object)
+ (?\[ json-read-array)
+ (?\" json-read-string))))
+ (mapc (lambda (char)
+ (push (list char 'json-read-number) table))
+ '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+ table)
+ "Readtable for JSON reader.")
+
+(defun json-read ()
+ "Parse and return the JSON object following point.
+Advances point just past JSON object."
+ (json-skip-whitespace)
+ (let ((char (json-peek)))
+ (if (not (eq char :json-eof))
+ (let ((record (cdr (assq char json-readtable))))
+ (if (functionp (car record))
+ (apply (car record) (cdr record))
+ (signal 'json-readtable-error record)))
+ (signal 'end-of-file nil))))
+
+;; Syntactic sugar for the reader
+
+(defun json-read-from-string (string)
+ "Read the JSON object contained in STRING and return it."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (json-read)))
+
+(defun json-read-file (file)
+ "Read the first JSON object contained in FILE and return it."
+ (with-temp-buffer
+ (insert-file file)
+ (goto-char (point-min))
+ (json-read)))
+
+
+
+;;; JSON encoder
+
+(defun json-encode (object)
+ "Return a JSON representation of OBJECT as a string."
+ (cond ((memq object (list t json-null json-false))
+ (json-encode-keyword object))
+ ((stringp object) (json-encode-string object))
+ ((keywordp object) (json-encode-string
+ (substring (symbol-name object) 1)))
+ ((symbolp object) (json-encode-string
+ (symbol-name object)))
+ ((numberp object) (json-encode-number object))
+ ((arrayp object) (json-encode-array object))
+ ((hash-table-p object) (json-encode-hash-table object))
+ ((listp object) (json-encode-list object))
+ (t (signal 'json-error (list object)))))
+
+(provide 'json)
+;;; json.el ends here
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[21.5] Avoid using Motif for cygwin
18 years
Dr. Volker Zell
Dr. Volker Zell
2006-12-06 Dr. Volker Zell <Dr.Volker.Zell(a)oracle.com>
* configure.ac: Avoid using Motif for cygwin.
--- configure.ac.orig 2006-12-06 11:17:49.081171200 +0100
+++ configure.ac 2006-12-06 11:25:31.135572800 +0100
＠＠ -4310,7 +4310,7 ＠＠
dnl Avoid using Motif :-(
case "$opsys" in
- *linux* | *darwin* | *bsd* ) lucid_prefers_motif="no" ;;
+ *linux* | *darwin* | *bsd* | *cygwin* ) lucid_prefers_motif="no" ;;
* ) lucid_prefers_motif="yes" ;;
esac
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 2 participants
- 1 comments
[PATCH] Avoid an error when creating a modified lang environment
18 years
Aidan Kehoe
Aidan Kehoe
No ChangeLog entry for this right now, sorry. Maybe tomorrow.
--- mule-cmds.el~ 2006-11-29 11:24:07.000000000 +0100
+++ mule-cmds.el 2006-12-07 14:43:55.625000000 +0100
＠＠ -1079,7 +1079,7 ＠＠
(replace-match (format " (%s)"
(upcase (symbol-name
(coding-system-name coding-system))))
- nil nil langenv)
+ nil nil (car langenv))
(format "%s (%s)" (car langenv)
(upcase (symbol-name (coding-system-name coding-system)))))
(destructive-plist-to-alist
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[PATCH] Accept that a charset's tag list may legitimately be nil.
18 years
Aidan Kehoe
Aidan Kehoe
Ar an séiú lá de mí na Nollaig, scríobh Stephen J. Turnbull:
> I was running a git diff in a shell buffer.
>
> Any ideas, Aidan?
>
> (gdb) up 4
> #4 0x0024d520 in charset_matches_specifier_tag_set_p (charset={...}, tag_set={...}, stage=initial) at /Users/steve/Software/XEmacs/git-staging/src/specifier.c:1003
> 1003 assert (!NILP(XVECTOR_DATA
> (gdb) pobj charset
See specifier.c:1342, setup_charset_initial_specifier_tags for where this
can happen. The crash didn’t happen if define-specifier-tag had been called
at least once with a third argument, which is why I found it difficult to
reproduce; fortunately, I regularly use a TTY build, where using the charset
predicate is a waste of time in lots of ways, and managed to reproduce it
consistently today. Building with this patch eliminates that crash.
Steve, I unsubscribed from xemacs-patches as an experiment to see if that
woul eliminate the duplicated messages I was getting from it. I then sent
17785.27430.262538.827891(a)parhasard.net to it, which has yet to appear--is
it currently subscriber-only? I suppose I’ll see whether this appears.
src/ChangeLog addition:
2006-12-08 Aidan Kehoe <kehoea(a)parhasard.net>
* specifier.c (charset_matches_specifier_tag_set_p):
A charset's entry in Vcharset_tag_lists may be nil, if, when that
charset was created, no tags with associated charset predicates
existed. Accept this posibility, treat it as the tag not matching
that charset.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/specifier.c
===================================================================
RCS
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.50
diff -u -r1.50 specifier.c
--- src/specifier.c 2006/11/15 21:12:17 1.50
+++ src/specifier.c 2006/12/08 16:13:04
＠＠ -997,12 +997,16 ＠＠
Lisp_Object tag = XCAR (rest);
Lisp_Object assoc;
- /* This function will not ever be called with a charset for which the
- relevant information hasn't been calculated (the information is
- calculated with the creation of every charset). */
- assert (!NILP(XVECTOR_DATA
- (Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
- - MIN_LEADING_BYTE]));
+ /* In the event that, during the creation of a charset, no specifier
+ tags exist for which CHARSET-PREDICATE has been specified, then
+ that charset's entry in Vcharset_tag_lists will be nil, and this
+ charset shouldn't match. */
+
+ if (NILP (XVECTOR_DATA(Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
+ - MIN_LEADING_BYTE]))
+ {
+ return 0;
+ }
/* Now, find out what the pre-calculated value is. */
assoc = assq_no_quit(tag,
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[PATCH] Pay attention to the dispatch event queue, SIGIO in emacs_tty_event_pending_p
18 years
Aidan Kehoe
Aidan Kehoe
My understanding is that the TTY code should be doing the same checking of
dispatch_event_queue and quit_check_signal_tick_count as the event-Xt code,
since emacs_tty_next_event and the event-stream code pays attention to the
former, and the signal handler to the latter. The below makes my TTY-only
build react more crisply (but doesn’t make VM startup on decent-size
mailboxes as fast as on a build with the XT event loop, even on a TTY--I
need to look further into why that is.)
http://mid.gmane.org/17597.11630.343389.787670＠parhasard.net is a similar
problem, but more clear-cut. I suspect the two stem from an oversight at the
same point in time. I’d appreciate a look from someone who knows their way
around the event-handling code.
src/ChangeLog addition:
2006-12-08 Aidan Kehoe <kehoea(a)parhasard.net>
* event-tty.c:
* event-tty.c (emacs_tty_event_pending_p):
* event-tty.c (reinit_vars_of_event_tty):
Pay attention to the dispatch event queue, and input pending
signals in emacs_tty_event_pending_p. Makes pure TTY builds more
responsive.
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/event-tty.c
===================================================================
RCS
Index: src/event-tty.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-tty.c,v
retrieving revision 1.17
diff -u -r1.17 event-tty.c
--- src/event-tty.c 2006/08/04 20:55:04 1.17
+++ src/event-tty.c 2006/12/08 13:10:02
＠＠ -45,6 +45,8 ＠＠
extern int mswindows_is_blocking;
#endif
+static int last_quit_check_signal_tick_count;
+
/************************************************************************/
/* timeout events */
＠＠ -84,22 +86,76 ＠＠
static int
emacs_tty_event_pending_p (int how_many)
{
+ Lisp_Object event;
+ int tick_count_val;
+
+ /* Cf. the comments on emacs_Xt_event_pending_p in event-xlike-inc.c . */
+
if (!how_many)
{
EMACS_TIME sometime;
- /* see if there's a pending timeout. */
+
+ /* (1) Any pending events in the dispatch queue? */
+ if (!NILP(dispatch_event_queue))
+ {
+ return 1;
+ }
+
+ /* (2) Any TTY or process input available? */
+ if (poll_fds_for_input (non_fake_input_wait_mask))
+ return 1;
+
+ /* (3) Any timeout input available? */
EMACS_GET_TIME (sometime);
if (tty_timer_queue &&
EMACS_TIME_EQUAL_OR_GREATER (sometime, tty_timer_queue->time))
return 1;
+ }
+ else
+ {
+ /* HOW_MANY > 0 */
+ EVENT_CHAIN_LOOP (event, dispatch_event_queue)
+ {
+ if (command_event_p (event))
+ {
+ how_many--;
+ if (how_many <= 0)
+ return 1;
+ }
+ }
- return poll_fds_for_input (non_fake_input_wait_mask);
}
+
+ tick_count_val = quit_check_signal_tick_count;
+
+ /* Checking in_modal_loop here is a bit cargo-cultish, since its use is
+ specific to builds with a window system. */
+ if (!in_modal_loop &&
+ (last_quit_check_signal_tick_count != tick_count_val))
+ {
+ last_quit_check_signal_tick_count = tick_count_val;
- /* #### Not right! We need to *count* the number of pending events, which
- means we need to have a dispatch queue and drain the pending events,
- using drain_tty_devices(). */
- return poll_fds_for_input (tty_only_mask);
+ /* We need to drain the entire queue now -- if we only drain part of
+ it, we may later on end up with events actually pending but
+ detect_input_pending() returning false because there wasn't
+ another SIGIO. */
+ event_stream_drain_queue ();
+
+ if (!how_many)
+ return !NILP (dispatch_event_queue);
+
+ EVENT_CHAIN_LOOP (event, dispatch_event_queue)
+ {
+ if (command_event_p (event))
+ {
+ how_many--;
+ if (how_many <= 0)
+ return 1;
+ }
+ }
+ }
+
+ return 0;
}
static void
＠＠ -304,6 +360,8 ＠＠
tty_event_stream->drain_queue_cb = emacs_tty_drain_queue;
tty_event_stream->create_io_streams_cb = emacs_tty_create_io_streams;
tty_event_stream->delete_io_streams_cb = emacs_tty_delete_io_streams;
+
+ last_quit_check_signal_tick_count = 0;
}
void
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[PATCH] Treat external data as such in glyphs-eimage.c
18 years
Aidan Kehoe
Aidan Kehoe
src/ChangeLog addition:
2006-11-28 Aidan Kehoe <kehoea(a)parhasard.net>
* glyphs-eimage.c (png_warning_func):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_warning_func):
Decode external binary data as such before passing it to
warn_when_safe().
XEmacs Trunk source patch:
Diff command: cvs -q diff -u
Files affected: src/glyphs-eimage.c
===================================================================
RCS
Index: src/glyphs-eimage.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-eimage.c,v
retrieving revision 1.27
diff -u -r1.27 glyphs-eimage.c
--- src/glyphs-eimage.c 2005/11/26 11:46:08 1.27
+++ src/glyphs-eimage.c 2006/11/28 17:14:24
＠＠ -827,7 +827,10 ＠＠
static void
png_warning_func (png_structp UNUSED (png_ptr), png_const_charp msg)
{
- warn_when_safe (Qpng, Qinfo, "%s", msg);
+ DECLARE_EISTRING (eimsg);
+
+ eicpy_ext(eimsg, msg, Qbinary);
+ warn_when_safe (Qpng, Qinfo, "%s", eidata(eimsg));
}
struct png_unwind_data
＠＠ -1018,16 +1021,21 ＠＠
unobtrusive. */
{
int i;
+ DECLARE_EISTRING (key);
+ DECLARE_EISTRING (text);
for (i = 0 ; i < info_ptr->num_text ; i++)
{
/* How paranoid do I have to be about no trailing NULLs, and
using (int)info_ptr->text[i].text_length, and strncpy and a temp
string somewhere? */
+ eireset(key);
+ eireset(text);
+ eicpy_ext(key, info_ptr->text[i].key, Qbinary);
+ eicpy_ext(text, info_ptr->text[i].text, Qbinary);
warn_when_safe (Qpng, Qinfo, "%s - %s",
- info_ptr->text[i].key,
- info_ptr->text[i].text);
+ eidata(key), eidata(text));
}
}
#endif
＠＠ -1221,6 +1229,8 ＠＠
#else
char warn_str[1024];
#endif
+ DECLARE_EISTRING (eimodule);
+ DECLARE_EISTRING (eiwarnstr);
va_start (vargs, fmt);
#ifdef HAVE_VSNPRINTF
＠＠ -1229,8 +1239,13 ＠＠
vsprintf (warn_str, fmt, vargs);
#endif
va_end (vargs);
+
+ eicpy_ext(eimodule, module, Qbinary);
+ eicpy_ext(eiwarnstr, warn_str, Qbinary);
+
warn_when_safe (Qtiff, Qinfo, "%s - %s",
- module, warn_str);
+ eidata(eimodule),
+ eidata(eiwarnstr));
}
static void
--
Santa Maradona, priez pour moi!
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments