Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-misc.el @ 359:8e84bee8ddd0 r21-1-9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-9
author cvs
date Mon, 13 Aug 2007 10:57:55 +0200
parents 4f79e16b1112
children
comparison
equal deleted inserted replaced
358:fed6e0f6a03a 359:8e84bee8ddd0
290 ;; ENABLE-FUNCTION should be a function of no arguments that will be called 290 ;; ENABLE-FUNCTION should be a function of no arguments that will be called
291 ;; when the language environment is made current." 291 ;; when the language environment is made current."
292 ;; (put env-sym 'quail-environ-doc-string doc-string) 292 ;; (put env-sym 'quail-environ-doc-string doc-string)
293 ;; (put env-sym 'set-quail-environ enable-function)) 293 ;; (put env-sym 'set-quail-environ enable-function))
294 294
295
296 ;;; @ coding-system category
297 ;;;
298
299 (defun coding-system-get (coding-system prop)
300 "Extract a value from CODING-SYSTEM's property list for property PROP."
301 (or (plist-get
302 (get (coding-system-name coding-system) 'coding-system-property)
303 prop)
304 (condition-case nil
305 (coding-system-property coding-system prop)
306 (error nil))))
307
308 (defun coding-system-put (coding-system prop val)
309 "Change value in CODING-SYSTEM's property list PROP to VAL."
310 (put (coding-system-name coding-system)
311 'coding-system-property
312 (plist-put (get (coding-system-name coding-system)
313 'coding-system-property)
314 prop val)))
315
316 (defun coding-system-category (coding-system)
317 "Return the coding category of CODING-SYSTEM."
318 (or (coding-system-get coding-system 'category)
319 (let ((type (coding-system-type coding-system)))
320 (cond ((eq type 'no-conversion)
321 'no-conversion)
322 ((eq type 'shift-jis)
323 'shift-jis)
324 ((eq type 'big5)
325 'big5)
326 ((eq type 'iso2022)
327 (cond ((coding-system-lock-shift coding-system)
328 'iso-lock-shift)
329 ((coding-system-seven coding-system)
330 'iso-7)
331 (t
332 (let ((dim 0)
333 ccs
334 (i 0))
335 (while (< i 4)
336 (setq ccs (coding-system-charset coding-system i))
337 (if (and ccs
338 (> (charset-dimension ccs) dim))
339 (setq dim (charset-dimension ccs))
340 )
341 (setq i (1+ i)))
342 (cond ((= dim 1) 'iso-8-1)
343 ((= dim 2) 'iso-8-2)
344 (t 'iso-8-designate))
345 ))))))))
346
295 ;;; mule-misc.el ends here 347 ;;; mule-misc.el ends here