mjab@.COM (Michael Berry) (02/08/89)
Somehow I included an old and slightly buggy version of the keywords.el file in
my earlier posting. Here is the right one:
(defvar visible-over-127 nil "visible quad-av characters in need of translation to keyword form")
(defvar keywords nil "Strings representing APL printing characters not part of normal ascii")
(defvar keywords-unique nil "A form of the APL keywords in which the introducer is never doubled")
(defvar char-to-key-alist nil "This list associates characters with keywords. The characters are the keys.")
(defvar key-to-char-alist nil "This list associates characters with keywords. The keywords are the keys.")
(setq visible-over-127
'(64 160 161 162 164 166 168 169 171 172 173 175 176 177 179 180 185 187 188 189 190 191 193 194 195 196 197 199 200 201 202 204 205 206 207 210 211 213 214 215 216 217 218 219 220 221 223 224 225 226 227 229 230 231 232 233 234 236 238 239 240 244 247 250 251 252 253 254))
(setq keywords
'("@ " "@0~ " "@\" " "@@_ " "@<_ " "@>_ " "@=/ " "@v " "@x " "@,- " "@[-:] " "@/- " "@^~ " "@@! " "@L- " "@Y= " "@v~ " "@[o] " "@[\\] " "@=_ " "@][ " "@@? " "@a " "@@T " "@n " "@L " "@e " "@@D " "@D " "@i " "@o " "@[] " "@I " "@T " "@O " "@r " "@@L " "@Iv " "@u " "@w " "@@c " "@I^ " "@c " "@I- " "@\\- " "@-I " "@-: " "@@I " "@O- " "@@To " "@no " "@e_ " "@@D~ " "@@DI " "@DI " "@i_ " "@\"o " "@['] " "@To " "@\"O " "@O* " "@O\\ " "@OI " "@cI " "@<- " "@D_ " "@-> " "@<> "))
(setq keywords-unique
'("@ " "@0~ " "@\" " "@._ " "@<_ " "@>_ " "@=/ " "@v " "@x " "@,- " "@[-:] " "@/- " "@^~ " "@.! " "@L- " "@Y= " "@v~ " "@[o] " "@[\\] " "@=_ " "@][ " "@.? " "@a " "@.T " "@n " "@L " "@e " "@.D " "@D " "@i " "@o " "@[] " "@I " "@T " "@O " "@r " "@.L " "@Iv " "@u " "@w " "@.c " "@I^ " "@c " "@I- " "@\\- " "@-I " "@-: " "@.I " "@O- " "@.To " "@no " "@e_ " "@.D~ " "@.DI " "@DI " "@i_ " "@\"o " "@['] " "@To " "@\"O " "@O* " "@O\\ " "@OI " "@cI " "@<- " "@D_ " "@-> " "@<> "))
(setq char-to-key-alist (pairlis visible-over-127 keywords))
(setq keyword-to-char-alist (pairlis keywords-unique visible-over-127))
(defun convert-apl-to-keywords()
"convert the current buffer to apl keyword form"
(interactive)
(save-excursion
(goto-char 1)
(while (convert-next-apl-character))))
(defun convert-next-apl-character()
"convert occurances of next APL character. Return nil if no APL left."
(let ((apl)
(loc)
(case-fold-search nil)
(case-replace nil))
(skip-chars-forward "[ -~]")
(setq loc (point))
(setq apl (buffer-substring loc (1+ loc)))
(let ((pair (assoc (elt apl 0) char-to-key-alist)))
(if pair
(progn
(replace-string apl (cdr pair))
(goto-char loc))
(progn
(if (< 127 (elt apl 0))
(progn
(replace-string apl "@][ ") ;unknown APL chars go to squish-quad
(goto-char loc)) ;go back to where first occurance was found
(skip-chars-forward apl)))))) ;not a meta character
(if (= (point) (point-max))
nil
t))
(defun convert-apl-file-to-keywords(file)
"convert a file in 256-character APL font to Iversonian keywords"
(interactive "fAPL file name: ")
(save-excursion
(find-file file)
(convert-apl-to-keywords)
(save-buffer)))
(defun convert-next-keyword()
"convert occurances of next keyword found to real APL character. Return nil if no keywords left."
(let ((pattern "@[^ ]* ")
(location)
(case-fold-search nil) ; @"o is not @"O !
(case-replace nil)
(apl)
(key))
(setq location (list
(re-search-forward pattern nil t)
(match-beginning 0)
(match-end 0)))
(if (car location) ;pattern was found
(progn
(goto-char (second location)) ;Don't miss the one found first!
(setq key (apply 'buffer-substring (cdr location)))
(setq apl (cdr (assoc key keyword-to-char-alist)))
(if apl
(replace-string key (char-to-string apl)))
(goto-char (second location)) ;go back to where first occurance was found
t)
nil)))
(defun convert-keywords-to-apl()
"convert current buffer from keywords to real APL characters"
(interactive)
(save-excursion
(goto-char 1)
(replace-string "@@" "@.")
(goto-char 1)
(while (convert-next-keyword))))
(defun convert-keyword-file-to-apl(file)
"convert a file in 256-character APL font to Iversonian keywords"
(interactive "fAPL file name: ")
(save-excursion
(find-file file)
(convert-apl-to-keywords)
(save-buffer)))
=============================================
Michael J. A. Berrry
Internet: mjab@think.com
uucp: {harvard}!think!mjab
=============================================