[Mac-emacs-users] Mac Roman Character Sets and Coding System

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Hi Everyone,

Attached to this message is an interesting and useful use of the new
fontset support: the definition of character sets and coding system
for the Mac Roman encoding.

Once this code is loaded, Mac Roman characters will have their own
character sets and can appear in a buffer along with any other
characters sets.  Also, dired mode shows the correct characters.

One can also type "C-x RET c mac-roman RET C-x C-f" to find a file in
the Mac Roman encoding, or put -*- coding: mac-roman; -*- on the first
line of a file for the conversion to occur automatically when a file
is visited.

The mac-roman-lower and mac-roman-upper character sets are now
associated with Monaco 14 in fontset-mac.  It would be nice if we can
have a font consistent with ETL-Fixed-ISO8859-1 but in the Mac Roman
encoding (any one have some free time to do this?).

The code also defines a minor mode "mac-roman-kdb-mode".  Turning it
on allows characters typed at the Mac keyboard with code between
128-255 to be inserted into the buffer as mac-roman-lower or
mac-roman-upper characters.

It is now in the form of a .emacs file (just cut the following text
and store it as your .emacs file).  Some of it should eventually go
into its own file.

Andrew.

---cut here---
; MPW does not allow saving a file with name beginning with a period.
; Use Emacs or SimpleText to edit and save this file instead.

(cond ((fboundp 'global-font-lock-mode)
       ;; Turn on font-lock in all modes that support it
       (global-font-lock-mode t)
       ;; Maximum colors
       (setq font-lock-maximum-decoration t)))

; My preference for RMAIL.
(setq rmail-summary-window-size 10)
(setq mail-yank-prefix "> ")

; See the time on the status line.
(display-time)

; Most people should want to use the Mac command key as the meta key
; so dead key processing with the Mac option key will work.
(setq mac-command-key-is-meta t)

; Uncomment the following to edit files directly in Mac Roman
; encoding.  Visit a file with M-x find-file-literally instead of C-x
; C-f.
;
; (let
;     ((i 128))
;   (while (<= i 255)
;     (global-set-key (vector i) 'self-insert-command)
;     (setq i (1+ i))))
;
; (standard-display-8bit 128 255)

; Uncomment the following line to use Mac keyboard layouts for
; entering ISO Latin-1 characters.
;
;   (setq mac-keyboard-text-encoding kTextEncodingISOLatin1)
;

; Uncomment the following lines to use traditional Chinese.
;
; (set-language-environment 'Chinese-BIG5)
; (set-input-method 'chinese-b5-tsangchi)
;
; Uncomment the following line to use a traditional Chinese input
; method supported by the Mac OS (e.g., Mac OS + the Chinese Language
; Kit),
;
; (set-keyboard-coding-system 'chinese-big5)

; Uncomment the following line to use Japanese.
;
; (set-language-environment 'Japanese)
;
; To use a Japanese input method supported by the Mac OS (e.g., Mac OS
; + the Japanese Language Kit), uncomment the following line
;
; (set-keyboard-coding-system 'sjis)

; My attempt at making font-lock colors a little nicer.
(custom-set-variables)
(custom-set-faces
 '(font-lock-comment-face ((t (:italic t :foreground "DarkOliveGreen"))))
 '(font-lock-string-face ((t (:foreground "Brown"))))
 '(font-lock-keyword-face ((t (:bold t :foreground "Purple4"))))
 '(font-lock-constant-face ((t (:bold t :foreground "IndianRed4"))))
 '(font-lock-type-face ((t (:bold t :foreground "grey40"))))
 '(font-lock-variable-name-face ((t (:bold t :foreground "Navy"))))
 '(font-lock-builtin-face ((t (:bold t :foreground "Orchid4")))))

; Here is where I keep my Emacs Lisp info files
(setq
 Info-default-directory-list
 '("~emacs/../elisp-manual-20-2.5/" "~emacs/info"))

;; Definitions for the Mac Roman character sets and coding system.
;; The Mac Roman encoding uses all 128 code points in the range 128 to
;; 255 for actual characters.  Since Emacs cannot handle this many
;; code points as one character set, we divide it into two:
;; mac-roman-lower for code points 128 to 159 and mac-roman-upper for
;; code points 160 to 255.

(defvar mac-roman-lower-final-char
  (get-unused-iso-final-char 1 96))
(defvar mac-roman-upper-final-char
  (1+ mac-roman-lower-final-char))

(define-charset nil 'mac-roman-lower
  (vector 1 96 1 0 mac-roman-lower-final-char 1
     "Mac Roman lower" "Mac Roman lower" "Mac Roman lower"))
(define-charset nil 'mac-roman-upper
  (vector 1 96 1 0 mac-roman-upper-final-char 1
     "Mac Roman upper" "Mac Roman upper" "Mac Roman upper"))

;; Since Mac Roman does not follow the ISO 2022 standard and uses code
;; points in the range 128-159, it is necessary to define it as a
;; type-4 charset, with CCL programs and all.

(define-ccl-program decode-mac-roman
  `(2
    (loop
     (read r0)
     (if (r0 < 128)  ;; ASCII
	 (if (r0 == ?\r)  ;; assume such a file uses Mac EOL's
	     (write-repeat ?\n)
	   (write-repeat r0))
       (if (r0 < 160)  ;; lower
	   ((r0 += 32)
	    (r1 = ,(charset-id 'mac-roman-lower))
	    (write-multibyte-character r1 r0)
	    (repeat))
	 ((r1 = ,(charset-id 'mac-roman-upper))  ;; upper
	  (write-multibyte-character r1 r0)
	  (repeat)))))))

(define-ccl-program encode-mac-roman
  `(1
    (loop
     (read-multibyte-character r0 r1)
     (if (r0 == ,(charset-id 'ascii))
	 (if (r1 == ?\n)
	     (write-repeat ?\r)
	   (write-repeat r1))
       (if (r0 == ,(charset-id 'mac-roman-lower))
	   ((r1 += 96)
	    (write-repeat r1))
	 (if (r0 == ,(charset-id 'mac-roman-upper))
	     ((r1 += 128)
	      (write-repeat r1))))))))

(make-coding-system
 'mac-roman 4 ?M "Mac Roman Encoding"
 '(decode-mac-roman . encode-mac-roman)
 '((safe-charsets (ascii mac-roman-lower mac-roman-upper))
   (valid codes (0 . 255))))

;; This doesn't seem to do anything for type-4 charsets:
;; (put 'mac-roman 'eol-type (make-subsidiary-coding-system 'mac-roman))

(define-ccl-program ccl-encode-mac-roman-font
  `(0
    (if (r0 == ,(charset-id 'mac-roman-lower))
	(r1 += 96)
      (r1 += 128))))

(setq font-ccl-encoder-alist
      (cons (cons "mac-roman" ccl-encode-mac-roman-font)
	    font-ccl-encoder-alist))

; This shows how the font for an indiviual character set can be
; chosen.

(if (fboundp 'new-fontset)
    (progn
      (create-fontset-from-fontset-spec
       "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
        mac-roman-lower:-*-Monaco-*-*-*-*-14-*-*-*-*-*-mac-roman,
        mac-roman-upper:-*-Monaco-*-*-*-*-14-*-*-*-*-*-mac-roman,
        thai-tis620:-ETL-Fixed-*-*-*-*-16-*-*-*-*-*-tis620.2529-1,
        lao:-Misc-Fixed-*-*-*-*-16-*-*-*-*-*-MuleLao-1,
        vietnamese-viscii-lower:-ETL-Fixed-*-*-*-*-16-*-*-*-*-*-viscii1.1-1,
        vietnamese-viscii-upper:-ETL-Fixed-*-*-*-*-16-*-*-*-*-*-viscii1.1-1,
        chinese-big5-1:-*-Nice Taipei Mono-*-*-*-*-12-*-*-*-*-*-big5,
        chinese-big5-2:-*-Nice Taipei Mono-*-*-*-*-12-*-*-*-*-*-big5,
        chinese-gb2312:-*-Beijing-*-*-*-*-16-*-*-*-*-*-gb2312,
        japanese-jisx0208:-*-\x8d\xd7\x96\xbe\x92\xa9\x91\xcc-*-*-*-*-16-*-*-*-*-*-jisx0208-sjis,
        katakana-jisx0201:-*-*-*-*-*-*-16-*-*-*-*-*-JISX0201.1976-0,
        korean-ksc5601:-*-Seoul-*-*-*-*-16-*-*-*-*-*-ksc5601"
       t)

      ; Use the fontset we just created
      (modify-frame-parameters
       (selected-frame)
       '((height . 44)
	 (width . 80)
	 (font . "fontset-mac")))))

;; To display filenames in Chinese or Japanese, replace mac-roman with
;; big5 or sjis
(setq file-name-coding-system 'mac-roman)

;;(prefer-coding-system 'mac-roman)

(defun mac-roman-kbd-insert ()
  (interactive "*")
  (let ((ch last-command-char))
    (if (< ch 160)
	(insert
	 (make-char 'mac-roman-lower
		    (- last-command-char 96)))
      (insert
       (make-char 'mac-roman-upper
		  (- last-command-char 128))))))

(defvar mac-roman-kbd-mode nil
  "Non-nil if in Mac-kbd minor mode.")
(put 'mac-roman-kbd-mode 'permanent-local t)

(or (assq 'mac-roman-kbd-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(mac-roman-kbd-mode " Mac-kbd") minor-mode-alist)))

(defvar mac-roman-kbd-mode-map
  (let ((map (make-keymap))
	(i 128))
    (while (< i 256)
      (define-key map (vector i) 'mac-roman-kbd-insert)
      (setq i (1+ i)))
    map)
  "Keymap for Mac-kbd minor mode.")

(or (assq 'mac-roman-kbd-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (cons (cons 'mac-roman-kbd-mode mac-roman-kbd-mode-map)
		minor-mode-map-alist)))

(defun mac-roman-kbd-mode (&optional arg)
  "Toggle Mac Roman Keyboard (Mac-kbd) minor mode, in which characters
in the range 128 to 255 generated by the Mac keyboard are inserted as
mac-roman-lower or mac-roman-upper characters, in the mac-roman
encoding.

With an argument, a positive argument enables Mac Roman Keyboard mode,
and a negative argument disables it."

  (interactive "P")

  (if (if arg
	  ;; Negative arg means switch it off.
	  (<= (prefix-numeric-value arg) 0)
	;; No arg means toggle.
	mac-roman-kbd-mode)
      (setq mac-roman-kbd-mode nil)

    ;; Enable mode.
    (setq mac-roman-kbd-mode t)))