Please correct this incomplete list and add more!
---------------------------------------------------------
+Amharic (\e$(3"c!<!N"^\e(B) \e$(3!A!,!>\e(B
Arabic \e[2]\e(38R\e(47d\e(3T!JSa\e(4W\e(3W\e[0]\e(B
Croatian (Hrvatski) Bog (Bok), Dobar dan
-Czech (\e,Bh\e(Besky) Dobr\e,B}\e(B den
+Czech (\e.B\eNhesky) Dobr\eN} den
Danish (Dansk) Hej, Goddag
English Hello
Esperanto Saluton
Estonian Tere, Tervist
FORTRAN PROGRAM
Finnish (Suomi) Hei
-French (Fran\e,Ag\e(Bais) Bonjour, Salut
+French (Fran\e.A\eNgais) Bonjour, Salut
German (Deutsch Nord) Guten Tag
-German (Deutsch S\e,A|\e(Bd) Gr\e,A|_\e(B Gott
-Greek (\e,FGkk]mija\e(B) \e,FCei\\e(B \e,Fsar\e(B
-Hebrew \e[2]\e,Hylem\e[0]\e(B
+German (Deutsch S\e.A\eN|d) Gr\eN|\eN_ Gott
+Greek (\e.F\eNE\eNk\eNk\eNg\eNm\eNi\eNj\eN\) \eNC\eNe\eNi\eN\ \eNs\eNa\eNr
+Hebrew \e[2]\e.H\eNy\eNl\eNe\eNm\e[0]
Italiano Ciao, Buon giorno
Maltese Ciao
Nederlands, Vlaams Hallo, Hoi, Goedendag
Norwegian (Norsk) Hei, God dag
-Polish Cze\e,B6f\e(B!
-Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!
-Spanish (Espa\e,Aq\e(Bol) \e,A!\e(BHola!
+Polish Cze\e.B\eN6\eNf!
+Russian (\e.L\eN@\eNc\eNa\eNa\eNZ\eNX\eNY) \eN7\eNT\eN`\eNP\eNR\eNa\eNb\eNR\eNc\eNY\eNb\eNU!
+Slovak Dobr\e.B\eN} de\eNr
+Spanish (Espa\e.A\eNqol) \eN!Hola!
Swedish (Svenska) Hej, Goddag
-Vietnamese (Ti\e,1*\e(Bng Vi\e,1.\e(Bt) Ch\e,1`\e(Bo b\e,1U\e(Bn
+Thai (\e$(?@0R0I0R0d070B0\e(B) \e$(?J0G8J04H$0C8:0\e(B, \e$(?J0G8J04H$2P0\e(B
-Japanese (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e(I:]FAJ\e(B, \e$BqV\e$(DiQ\e(B
+Tigrigna (\e$(3"8#r!N"^\e(B) \e$(3!Q!,!<"8\e(B
+Turkish (T\e.A\eN|rk\eNge) Merhaba
+Vietnamese (Ti\e.1\eN*ng Vi\eN.t) Ch\eN`o b\eNUn
+
+Japanese (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e*I\eN:\eN]\eNF\eNA\eNJ, \e$BqV\e$(DiQ\e(B
Chinese (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B) \e$ADc:C\e(B
Cantonese (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(B
Hangul (\e$(CGQ1[\e(B) \e$(C>H3gGO<<?d\e(B, \e$(C>H3gGO=J4O1n\e(B
--- /dev/null
+Reference: Robert W. Brockway, Myth from the Ice Age to Mickey Mouse
+
+ A collective definition of myth composed of many theories might be
+ framed by the following paraphrase:
+
+ Myths are stories, usually, about gods and other supernatural
+ beings. They are often stories of origins, how the world and
+ everything in it came to be in illo tempore. They are usually
+ strongly structured and their meaning is only discerned by
+ linguistic analysis. Sometimes they are public dreams which, like
+ private dreams, emerge from the unconscious mind. Indeed, they
+ often reveal the archetypes of the collective unconscious. They
+ are symbolic and metaphorical. They orient people to the
+ metaphysical dimension, explain the origins and nature of the
+ cosmos, validate social issues, and, on the psychological plane,
+ address themselves to the innermost depths of the psyche. Some of
+ them are explanatory, being prescientific attempts to interpret
+ the natural world. As such, they are usually functional and are
+ the science of primitive peoples. Often, they are enacted in
+ rituals. Religious myths are sacred histories, and distinguished
+ from the profane. But, being semiotic expressions, they are a
+ "disease of language." They are both individual and social in
+ scope, but they are first and foremost stories.
+
+
--- /dev/null
+;; -*- Mode: Emacs-Lisp -*-
+
+;;; This is a sample .emacs file.
+;;;
+;;; The .emacs file, which should reside in your home directory, allows you to
+;;; customize the behavior of Emacs. In general, changes to your .emacs file
+;;; will not take effect until the next time you start up Emacs. You can load
+;;; it explicitly with `M-x load-file RET ~/.emacs RET'.
+;;;
+;;; There is a great deal of documentation on customization in the Emacs
+;;; manual. You can read this manual with the online Info browser: type
+;;; `C-h i' or select "Emacs Info" from the "Help" menu.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Basic Customization ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Enable the command `narrow-to-region' ("C-x n n"), a useful
+;; command, but possibly confusing to a new user, so it's disabled by
+;; default.
+(put 'narrow-to-region 'disabled nil)
+
+;;; Define a variable to indicate whether we're running XEmacs/Lucid Emacs.
+;;; (You do not have to defvar a global variable before using it --
+;;; you can just call `setq' directly like we do for `emacs-major-version'
+;;; below. It's clearer this way, though.)
+
+(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
+
+;; Make the sequence "C-x w" execute the `what-line' command,
+;; which prints the current line number in the echo area.
+(global-set-key "\C-xw" 'what-line)
+
+;; set up the function keys to do common tasks to reduce Emacs pinky
+;; and such.
+
+;; Make F1 invoke help
+(global-set-key [f1] 'help-command)
+;; Make F2 be `undo'
+(global-set-key [f2] 'undo)
+;; Make F3 be `find-file'
+;; Note: it does not currently work to say
+;; (global-set-key 'f3 "\C-x\C-f")
+;; The reason is that macros can't do interactive things properly.
+;; This is an extremely longstanding bug in Emacs. Eventually,
+;; it will be fixed. (Hopefully ..)
+(global-set-key [f3] 'find-file)
+
+;; Make F4 be "mark", F5 be "copy", F6 be "paste"
+;; Note that you can set a key sequence either to a command or to another
+;; key sequence.
+(global-set-key [f4] 'set-mark-command)
+(global-set-key [f5] "\M-w")
+(global-set-key [f6] "\C-y")
+
+;; Shift-F4 is "pop mark off of stack"
+(global-set-key [(shift f4)] (lambda () (interactive) (set-mark-command t)))
+
+;; Make F7 be `save-buffer'
+(global-set-key [f7] 'save-buffer)
+
+;; Make F8 be "start macro", F9 be "end macro", F10 be "execute macro"
+(global-set-key [f8] 'start-kbd-macro)
+(global-set-key [f9] 'end-kbd-macro)
+(global-set-key [f10] 'call-last-kbd-macro)
+
+;; Here's an alternative binding if you don't use keyboard macros:
+;; Make F8 be `save-buffer' followed by `delete-window'.
+;;(global-set-key 'f8 "\C-x\C-s\C-x0")
+
+;; If you prefer delete to actually delete forward then you want to
+;; uncomment the next line (or use `Customize' to customize this).
+;; (setq delete-key-deletes-forward t)
+
+
+(cond (running-xemacs
+ ;;
+ ;; Code for any version of XEmacs/Lucid Emacs goes here
+ ;;
+
+ ;; Change the values of some variables.
+ ;; (t means true; nil means false.)
+ ;;
+ ;; Use the "Describe Variable..." option on the "Help" menu
+ ;; to find out what these variables mean.
+ (setq find-file-use-truenames nil
+ find-file-compare-truenames t
+ minibuffer-confirm-incomplete t
+ complex-buffers-menu-p t
+ next-line-add-newlines nil
+ mail-yank-prefix "> "
+ kill-whole-line t
+ )
+
+ ;; When running ispell, consider all 1-3 character words as correct.
+ (setq ispell-extra-args '("-W" "3"))
+
+ (cond ((or (not (fboundp 'device-type))
+ (equal (device-type) 'x)
+ (equal (device-type) 'mswindows))
+ ;; Code which applies only when running emacs under X or
+ ;; MicroSoft Windows goes here. (We check whether the
+ ;; function `device-type' exists before using it. In
+ ;; versions before 19.12, there was no such function.
+ ;; If it doesn't exist, we simply assume we're running
+ ;; under X -- versions before 19.12 only supported X.)
+
+ ;; Remove the binding of C-x C-c, which normally exits emacs.
+ ;; It's easy to hit this by mistake, and that can be annoying.
+ ;; Under X, you can always quit with the "Exit Emacs" option on
+ ;; the File menu.
+ (global-set-key "\C-x\C-c" nil)
+
+ ;; Uncomment this to enable "sticky modifier keys" in 19.13
+ ;; and up. With sticky modifier keys enabled, you can
+ ;; press and release a modifier key before pressing the
+ ;; key to be modified, like how the ESC key works always.
+ ;; If you hold the modifier key down, however, you still
+ ;; get the standard behavior. I personally think this
+ ;; is the best thing since sliced bread (and a *major*
+ ;; win when it comes to reducing Emacs pinky), but it's
+ ;; disorienting at first so I'm not enabling it here by
+ ;; default.
+
+ ;;(setq modifier-keys-are-sticky t)
+
+ ;; This changes the variable which controls the text that goes
+ ;; in the top window title bar. (However, it is not changed
+ ;; unless it currently has the default value, to avoid
+ ;; interfering with a -wn command line argument I may have
+ ;; started emacs with.)
+ (if (equal frame-title-format "%S: %b")
+ (setq frame-title-format
+ (concat "%S: " invocation-directory invocation-name
+ " [" emacs-version "]"
+ (if nil ; (getenv "NCD")
+ ""
+ " %b"))))
+
+ ;; If we're running on display 0, load some nifty sounds that
+ ;; will replace the default beep. But if we're running on a
+ ;; display other than 0, which probably means my NCD X terminal,
+ ;; which can't play digitized sounds, do two things: reduce the
+ ;; beep volume a bit, and change the pitch of the sound that is
+ ;; made for "no completions."
+ ;;
+ ;; (Note that sampled sounds only work if XEmacs was compiled
+ ;; with sound support, and we're running on the console of a
+ ;; Sparc, HP, or SGI machine, or on a machine which has a
+ ;; NetAudio server; otherwise, you just get the standard beep.)
+ ;;
+ ;; (Note further that changing the pitch and duration of the
+ ;; standard beep only works with some X servers; many servers
+ ;; completely ignore those parameters.)
+ ;;
+ (cond ((or (and (getenv "DISPLAY")
+ (string-match ":0" (getenv "DISPLAY")))
+ (and (eq (console-type) 'mswindows)
+ (device-sound-enabled-p)))
+ (load-default-sounds))
+ (t
+ (setq bell-volume 40)
+ (setq sound-alist
+ (append sound-alist '((no-completion :pitch 500))))
+ ))
+
+ ;; Make `C-x C-m' and `C-x RET' be different (since I tend
+ ;; to type the latter by accident sometimes.)
+ (define-key global-map [(control x) return] nil)
+
+ ;; Change the pointer used when the mouse is over a modeline
+ (set-glyph-image modeline-pointer-glyph "leftbutton")
+
+ ;; Change the continuation glyph face so it stands out more
+ (and (fboundp 'make-face-bold)
+ (boundp 'continuation-glyph)
+ (make-face-bold (glyph-face continuation-glyph)))
+
+ ;; Change the pointer used during garbage collection.
+ ;;
+ ;; Note that this pointer image is rather large as pointers go,
+ ;; and so it won't work on some X servers (such as the MIT
+ ;; R5 Sun server) because servers may have lamentably small
+ ;; upper limits on pointer size.
+ ;;(if (featurep 'xpm)
+ ;; (set-glyph-image gc-pointer-glyph
+ ;; (expand-file-name "trash.xpm" data-directory)))
+
+ ;; Here's another way to do that: it first tries to load the
+ ;; pointer once and traps the error, just to see if it's
+ ;; possible to load that pointer on this system; if it is,
+ ;; then it sets gc-pointer-glyph, because we know that
+ ;; will work. Otherwise, it doesn't change that variable
+ ;; because we know it will just cause some error messages.
+ (if (featurep 'xpm)
+ (let ((file (expand-file-name "recycle.xpm" data-directory)))
+ (if (condition-case error
+ ;; check to make sure we can use the pointer.
+ (make-image-instance file nil
+ '(pointer))
+ (error nil)) ; returns nil if an error occurred.
+ (set-glyph-image gc-pointer-glyph file))))
+
+ (when (featurep 'menubar)
+ ;; Add `dired' to the File menu
+ (add-menu-button '("File") ["Edit Directory" dired t])
+
+ ;; Here's a way to add scrollbar-like buttons to the menubar
+ (add-menu-button nil ["Top" beginning-of-buffer t])
+ (add-menu-button nil ["<<<" scroll-down t])
+ (add-menu-button nil [" . " recenter t])
+ (add-menu-button nil [">>>" scroll-up t])
+ (add-menu-button nil ["Bot" end-of-buffer t]))
+
+ ;; Change the behavior of mouse button 2 (which is normally
+ ;; bound to `mouse-yank'), so that it inserts the selected text
+ ;; at point (where the text cursor is), instead of at the
+ ;; position clicked.
+ ;;
+ ;; Note that you can find out what a particular key sequence or
+ ;; mouse button does by using the "Describe Key..." option on
+ ;; the Help menu.
+ (setq mouse-yank-at-point t)
+
+ ;; When editing C code (and Lisp code and the like), I often
+ ;; like to insert tabs into comments and such. It gets to be
+ ;; a pain to always have to use `C-q TAB', so I set up a more
+ ;; convenient binding. Note that this does not work in
+ ;; TTY frames, where tab and shift-tab are indistinguishable.
+ (define-key global-map '(shift tab) 'self-insert-command)
+
+ ;; LISPM bindings of Control-Shift-C and Control-Shift-E.
+ ;; Note that "\C-C" means Control-C, not Control-Shift-C.
+ ;; To specify shifted control characters, you must use the
+ ;; more verbose syntax used here.
+ (define-key emacs-lisp-mode-map '(control C) 'compile-defun)
+ (define-key emacs-lisp-mode-map '(control E) 'eval-defun)
+
+ ;; If you like the FSF Emacs binding of button3 (single-click
+ ;; extends the selection, double-click kills the selection),
+ ;; uncomment the following:
+
+ ;; Under 19.13, the following is enough:
+ ;(define-key global-map 'button3 'mouse-track-adjust)
+
+ ;; But under 19.12, you need this:
+ ;(define-key global-map 'button3
+ ; (lambda (event)
+ ; (interactive "e")
+ ; (let ((default-mouse-track-adjust t))
+ ; (mouse-track event))))
+
+ ;; Under both 19.12 and 19.13, you also need this:
+ ;(add-hook 'mouse-track-click-hook
+ ; (lambda (event count)
+ ; (if (or (/= (event-button event) 3)
+ ; (/= count 2))
+ ; nil ;; do the normal operation
+ ; (kill-region (point) (mark))
+ ; t ;; don't do the normal operations.
+ ; )))
+
+ ))
+
+ ))
+
+;; Oh, and here's a cute hack you might want to put in the sample .emacs
+;; file: it changes the color of the window if it's not on the local
+;; machine, or if it's running as root:
+
+;; local emacs background: whitesmoke
+;; remote emacs background: palegreen1
+;; root emacs background: coral2
+(cond
+ ((and (string-match "XEmacs" emacs-version)
+ (eq window-system 'x)
+ (boundp 'emacs-major-version)
+ (= emacs-major-version 19)
+ (>= emacs-minor-version 12))
+ (let* ((root-p (eq 0 (user-uid)))
+ (dpy (or (getenv "DISPLAY") ""))
+ (remote-p (not
+ (or (string-match "^\\(\\|unix\\|localhost\\):" dpy)
+ (let ((s (system-name)))
+ (if (string-match "\\.\\(netscape\\|mcom\\)\\.com" s)
+ (setq s (substring s 0 (match-beginning 0))))
+ (string-match (concat "^" (regexp-quote s)) dpy)))))
+ (bg (cond (root-p "coral2")
+ (remote-p "palegreen1")
+ (t nil))))
+ (cond (bg
+ (let ((def (color-name (face-background 'default)))
+ (faces (face-list)))
+ (while faces
+ (let ((obg (face-background (car faces))))
+ (if (and obg (equal def (color-name obg)))
+ (set-face-background (car faces) bg)))
+ (setq faces (cdr faces)))))))))
+
+
+;;; Older versions of emacs did not have these variables
+;;; (emacs-major-version and emacs-minor-version.)
+;;; Let's define them if they're not around, since they make
+;;; it much easier to conditionalize on the emacs version.
+
+(if (and (not (boundp 'emacs-major-version))
+ (string-match "^[0-9]+" emacs-version))
+ (setq emacs-major-version
+ (string-to-int (substring emacs-version
+ (match-beginning 0) (match-end 0)))))
+(if (and (not (boundp 'emacs-minor-version))
+ (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version))
+ (setq emacs-minor-version
+ (string-to-int (substring emacs-version
+ (match-beginning 1) (match-end 1)))))
+
+;;; Define a function to make it easier to check which version we're
+;;; running.
+
+(defun running-emacs-version-or-newer (major minor)
+ (or (> emacs-major-version major)
+ (and (= emacs-major-version major)
+ (>= emacs-minor-version minor))))
+
+(cond ((and running-xemacs
+ (running-emacs-version-or-newer 19 6))
+ ;;
+ ;; Code requiring XEmacs/Lucid Emacs version 19.6 or newer goes here
+ ;;
+ ))
+
+(cond ((>= emacs-major-version 19)
+ ;;
+ ;; Code for any vintage-19 emacs goes here
+ ;;
+ ))
+
+(cond ((and (not running-xemacs)
+ (>= emacs-major-version 19))
+ ;;
+ ;; Code specific to FSF Emacs 19 (not XEmacs/Lucid Emacs) goes here
+ ;;
+ ))
+
+(cond ((< emacs-major-version 19)
+ ;;
+ ;; Code specific to emacs 18 goes here
+ ;;
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customization of Specific Packages ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Load gnuserv, which will allow you to connect to XEmacs sessions
+;;; using `gnuclient'.
+
+;; If you never run more than one XEmacs at a time, you might want to
+;; always start gnuserv. Otherwise it is preferable to specify
+;; `-f gnuserv-start' on the command line to one of the XEmacsen.
+; (gnuserv-start)
+
+
+;;; ********************
+;;; Load efs, which uses the FTP protocol as a pseudo-filesystem.
+;;; When this is loaded, the pathname syntax /user@host:/remote/path
+;;; refers to files accessible through ftp.
+;;;
+(require 'dired)
+;; compatible ange-ftp/efs initialization derived from code
+;; from John Turner <turner@lanl.gov>
+;; As of 19.15, efs is bundled instead of ange-ftp.
+;; NB: doesn't handle 20.0 properly, efs didn't appear until 20.1.
+;;
+;; The environment variable EMAIL_ADDRESS is used as the password
+;; for access to anonymous ftp sites, if it is set. If not, one is
+;; constructed using the environment variables USER and DOMAINNAME
+;; (e.g. turner@lanl.gov), if set.
+
+(if (and running-xemacs
+ (or (> emacs-major-version 20)
+ (and (= emacs-major-version 20) (>= emacs-minor-version 1))
+ (and (= emacs-major-version 19) (>= emacs-minor-version 15))))
+ (progn
+ (message "Loading and configuring bundled packages... efs")
+ (require 'efs-auto)
+ (if (getenv "USER")
+ (setq efs-default-user (getenv "USER")))
+ (if (getenv "EMAIL_ADDRESS")
+ (setq efs-generate-anonymous-password (getenv "EMAIL_ADDRESS"))
+ (if (and (getenv "USER")
+ (getenv "DOMAINNAME"))
+ (setq efs-generate-anonymous-password
+ (concat (getenv "USER")"@"(getenv "DOMAINNAME")))))
+ (setq efs-auto-save 1))
+ (progn
+ (message "Loading and configuring bundled packages... ange-ftp")
+ (require 'ange-ftp)
+ (if (getenv "USER")
+ (setq ange-ftp-default-user (getenv "USER")))
+ (if (getenv "EMAIL_ADDRESS")
+ (setq ange-ftp-generate-anonymous-password (getenv "EMAIL_ADDRESS"))
+ (if (and (getenv "USER")
+ (getenv "DOMAINNAME"))
+ (setq ange-ftp-generate-anonymous-password
+ (concat (getenv "USER")"@"(getenv "DOMAINNAME")))))
+ (setq ange-ftp-auto-save 1)
+ )
+ )
+
+;;; ********************
+;;; Load the default-dir.el package which installs fancy handling
+;;; of the initial contents in the minibuffer when reading
+;;; file names.
+
+(if (and running-xemacs
+ (or (and (= emacs-major-version 20) (>= emacs-minor-version 1))
+ (and (= emacs-major-version 19) (>= emacs-minor-version 15))))
+ (require 'default-dir))
+
+;;; ********************
+;;; Load the auto-save.el package, which lets you put all of your autosave
+;;; files in one place, instead of scattering them around the file system.
+;;;
+(setq auto-save-directory (expand-file-name "~/autosave/")
+ auto-save-directory-fallback auto-save-directory
+ auto-save-hash-p nil
+ efs-auto-save t
+ efs-auto-save-remotely nil
+ ;; now that we have auto-save-timeout, let's crank this up
+ ;; for better interactive response.
+ auto-save-interval 2000
+ )
+;; We load this afterwards because it checks to make sure the
+;; auto-save-directory exists (creating it if not) when it's loaded.
+(require 'auto-save)
+
+;; This adds additional extensions which indicate files normally
+;; handled by cc-mode.
+(setq auto-mode-alist
+ (append '(("\\.C$" . c++-mode)
+ ("\\.cc$" . c++-mode)
+ ("\\.hh$" . c++-mode)
+ ("\\.c$" . c-mode)
+ ("\\.h$" . c-mode))
+ auto-mode-alist))
+
+
+;;; ********************
+;;; cc-mode (the mode you're in when editing C, C++, and Objective C files)
+
+;; Tell cc-mode not to check for old-style (K&R) function declarations.
+;; This speeds up indenting a lot.
+(setq c-recognize-knr-p nil)
+
+;; Change the indentation amount to 4 spaces instead of 2.
+;; You have to do it in this complicated way because of the
+;; strange way the cc-mode initializes the value of `c-basic-offset'.
+(add-hook 'c-mode-hook (lambda () (setq c-basic-offset 4)))
+
+
+;;; ********************
+;;; Load a partial-completion mechanism, which makes minibuffer completion
+;;; search multiple words instead of just prefixes; for example, the command
+;;; `M-x byte-compile-and-load-file RET' can be abbreviated as `M-x b-c-a RET'
+;;; because there are no other commands whose first three words begin with
+;;; the letters `b', `c', and `a' respectively.
+;;;
+(load-library "completer")
+
+
+;;; ********************
+;;; Load crypt, which is a package for automatically decoding and reencoding
+;;; files by various methods - for example, you can visit a .Z or .gz file,
+;;; edit it, and have it automatically re-compressed when you save it again.
+;;;
+(setq crypt-encryption-type 'pgp ; default encryption mechanism
+ crypt-confirm-password t ; make sure new passwords are correct
+ ;crypt-never-ever-decrypt t ; if you don't encrypt anything, set this to
+ ; tell it not to assume that "binary" files
+ ; are encrypted and require a password.
+ )
+(require 'crypt)
+
+
+;;; ********************
+;;; Edebug is a source-level debugger for emacs-lisp programs.
+;;;
+(define-key emacs-lisp-mode-map "\C-xx" 'edebug-defun)
+
+
+;;; ********************
+;;; Font-Lock is a syntax-highlighting package. When it is enabled and you
+;;; are editing a program, different parts of your program will appear in
+;;; different fonts or colors. For example, with the code below, comments
+;;; appear in red italics, function names in function definitions appear in
+;;; blue bold, etc. The code below will cause font-lock to automatically be
+;;; enabled when you edit C, C++, Emacs-Lisp, and many other kinds of
+;;; programs.
+;;;
+;;; The "Options" menu has some commands for controlling this as well.
+;;;
+(cond (running-xemacs
+
+ ;; If you want the default colors, you could do this:
+ ;; (setq font-lock-use-default-fonts nil)
+ ;; (setq font-lock-use-default-colors t)
+ ;; but I want to specify my own colors, so I turn off all
+ ;; default values.
+ (setq font-lock-use-default-fonts nil)
+ (setq font-lock-use-default-colors nil)
+
+ (require 'font-lock)
+
+ ;; Mess around with the faces a bit. Note that you have
+ ;; to change the font-lock-use-default-* variables *before*
+ ;; loading font-lock, and wait till *after* loading font-lock
+ ;; to customize the faces.
+
+ ;; string face is green
+ (set-face-foreground 'font-lock-string-face "forest green")
+
+ ;; comments are italic and red; doc strings are italic
+ ;;
+ ;; (I use copy-face instead of make-face-italic/make-face-bold
+ ;; because the startup code does intelligent things to the
+ ;; 'italic and 'bold faces to ensure that they are different
+ ;; from the default face. For example, if the default face
+ ;; is bold, then the 'bold face will be unbold.)
+ (copy-face 'italic 'font-lock-comment-face)
+ ;; Underlining comments looks terrible on tty's
+ (set-face-underline-p 'font-lock-comment-face nil 'global 'tty)
+ (set-face-highlight-p 'font-lock-comment-face t 'global 'tty)
+ (copy-face 'font-lock-comment-face 'font-lock-doc-string-face)
+ (set-face-foreground 'font-lock-comment-face "red")
+
+ ;; function names are bold and blue
+ (copy-face 'bold 'font-lock-function-name-face)
+ (set-face-foreground 'font-lock-function-name-face "blue")
+
+ ;; misc. faces
+ (and (find-face 'font-lock-preprocessor-face) ; 19.13 and above
+ (copy-face 'bold 'font-lock-preprocessor-face))
+ (copy-face 'italic 'font-lock-type-face)
+ (copy-face 'bold 'font-lock-keyword-face)
+ ))
+
+
+;;; ********************
+;;; fast-lock is a package which speeds up the highlighting of files
+;;; by saving information about a font-locked buffer to a file and
+;;; loading that information when the file is loaded again. This
+;;; requires a little extra disk space be used.
+;;;
+;;; Normally fast-lock puts the cache file (the filename appended with
+;;; .flc) in the same directory as the file it caches. You can
+;;; specify an alternate directory to use by setting the variable
+;;; fast-lock-cache-directories.
+
+;; Let's use lazy-lock instead.
+;;(add-hook 'font-lock-mode-hook 'turn-on-fast-lock)
+;;(setq fast-lock-cache-directories '("/foo/bar/baz"))
+
+
+;;; ********************
+;;; lazy-lock is a package which speeds up the highlighting of files
+;;; by doing it "on-the-fly" -- only the visible portion of the
+;;; buffer is fontified. The results may not always be quite as
+;;; accurate as using full font-lock or fast-lock, but it's *much*
+;;; faster. No more annoying pauses when you load files.
+
+(add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)
+;; I personally don't like "stealth mode" (where lazy-lock starts
+;; fontifying in the background if you're idle for 30 seconds)
+;; because it takes too long to wake up again on my piddly Sparc 1+.
+(setq lazy-lock-stealth-time nil)
+
+
+;;; ********************
+;;; func-menu is a package that scans your source file for function
+;;; definitions and makes a menubar entry that lets you jump to any
+;;; particular function definition by selecting it from the menu. The
+;;; following code turns this on for all of the recognized languages.
+;;; Scanning the buffer takes some time, but not much.
+;;;
+;;; Send bug reports, enhancements etc to:
+;;; David Hughes <ukchugd@ukpmr.cs.philips.nl>
+;;;
+(cond (running-xemacs
+ (require 'func-menu)
+ (define-key global-map 'f8 'function-menu)
+ (add-hook 'find-file-hooks 'fume-add-menubar-entry)
+ (define-key global-map "\C-cl" 'fume-list-functions)
+ (define-key global-map "\C-cg" 'fume-prompt-function-goto)
+
+ ;; The Hyperbole information manager package uses (shift button2) and
+ ;; (shift button3) to provide context-sensitive mouse keys. If you
+ ;; use this next binding, it will conflict with Hyperbole's setup.
+ ;; Choose another mouse key if you use Hyperbole.
+ (define-key global-map '(shift button3) 'mouse-function-menu)
+
+ ;; For descriptions of the following user-customizable variables,
+ ;; type C-h v <variable>
+ (setq fume-max-items 25
+ fume-fn-window-position 3
+ fume-auto-position-popup t
+ fume-display-in-modeline-p t
+ fume-menubar-menu-location "File"
+ fume-buffer-name "*Function List*"
+ fume-no-prompt-on-valid-default nil)
+ ))
+
+
+;;; ********************
+;;; MH is a mail-reading system from the Rand Corporation that relies on a
+;;; number of external filter programs (which do not come with emacs.)
+;;; Emacs provides a nice front-end onto MH, called "mh-e".
+;;;
+;; Bindings that let you send or read mail using MH
+;(global-set-key "\C-xm" 'mh-smail)
+;(global-set-key "\C-x4m" 'mh-smail-other-window)
+;(global-set-key "\C-cr" 'mh-rmail)
+
+;; Customization of MH behavior.
+(setq mh-delete-yanked-msg-window t)
+(setq mh-yank-from-start-of-msg 'body)
+(setq mh-summary-height 11)
+
+;; Use lines like the following if your version of MH
+;; is in a special place.
+;(setq mh-progs "/usr/dist/pkgs/mh/bin.svr4/")
+;(setq mh-lib "/usr/dist/pkgs/mh/lib.svr4/")
+
+
+;;; ********************
+;;; resize-minibuffer-mode makes the minibuffer automatically
+;;; resize as necessary when it's too big to hold its contents.
+
+(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
+(resize-minibuffer-mode)
+(setq resize-minibuffer-window-exactly nil)
+
+;;; ********************
+;;; W3 is a browser for the World Wide Web, and takes advantage of the very
+;;; latest redisplay features in XEmacs. You can access it simply by typing
+;;; 'M-x w3'; however, if you're unlucky enough to be on a machine that is
+;;; behind a firewall, you will have to do something like this first:
+
+;(setq w3-use-telnet t
+; ;;
+; ;; If the Telnet program you use to access the outside world is
+; ;; not called "telnet", specify its name like this.
+; w3-telnet-prog "itelnet"
+; ;;
+; ;; If your Telnet program adds lines of junk at the beginning
+; ;; of the session, specify the number of lines here.
+; w3-telnet-header-length 4
+; )
--- /dev/null
+%Start ErrorText ErrorMessage OtherText
+
+EC [0-9][0-9][0-9][0-9]-[0-9][0-9][0-9]
+D [0-9]
+D3 [0-9 ][0-9 ][0-9]
+D4 [0-9 ][0-9 ][0-9 ][0-9]
+D5 [0-9 ][0-9 ][0-9 ][0-9 ][0-9]
+DS [0-9 ]
+
+%{
+/* moore@wilma.cs.utk.edu
+
+ * Hack to work around the AIX C compiler's brain-damaged error messages
+ * so that emacs can parse them. It runs /bin/cc as a subprocess, and
+ * tries to rearrange the error messages so that (a) each message contains
+ * both the filename and line number where the error occurred, and (b)
+ * the error message(s) for a particular line get displayed *before* the
+ * line itself.
+ *
+ * to compile:
+ * lex aixcc.lex
+ * cc -o aixcc lex.yy.c
+ *
+ *
+ * Copyright December 1991 by Keith Moore
+ *
+ * This program 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 of the License, or
+ * (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ *
+ * TODO: figure out how the compiler counts file numbers for included
+ * files, keep track of which file corresponds to which number, and
+ * always output the right file name.
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+char *current_file;
+int line;
+int debug = 0;
+char bigbuf[10240];
+char *bufptr = bigbuf;
+int last_line_was_error = 0;
+
+spaces (s)
+char *s;
+{
+ while (*s++)
+ *bufptr++ = ' ';
+}
+
+char *
+strsave (s)
+char *s;
+{
+ char *ptr = malloc (strlen (s) + 1);
+ strcpy (ptr, s);
+ return ptr;
+}
+
+yywrap ()
+{
+ *bufptr = '\0';
+ bufptr = bigbuf;
+ while (*bufptr)
+ putc (*bufptr++, yyout);
+ return 1;
+}
+
+%}
+%%
+^File\ Line\ Column\ Message\ text[^\n]* {
+ /*
+ * ignore this. don't treat it as error text
+ */
+}
+
+^{DS}{DS}{DS}\ {D5}\ \| {
+ /*
+ * (optional) nesting level, followed by line number, followed
+ * by the source code fragment that caused the error
+ */
+
+ /*
+ * save the line number for later
+ */
+ line = atoi (yytext+4);
+
+ if (debug) {
+ fprintf (yyout, "line <= %d\n", line);
+ fprintf (yyout, "%s\n", yytext);
+ }
+
+ /*
+ * if the last line was an error message, to flush out all of
+ * the old source text before starting to save the new source text.
+ */
+ if (last_line_was_error) {
+ *bufptr = '\0';
+ bufptr = bigbuf;
+ while (*bufptr)
+ putc (*bufptr++, yyout);
+ bufptr = bigbuf;
+ last_line_was_error = 0;
+ }
+ /*
+ * stuff enough spaces in the text buffer so that the
+ * saved text will line up properly when displayed.
+ */
+ spaces (yytext);
+
+ BEGIN ErrorText; /* continue below */
+}
+
+<ErrorText>[^\n]*$ {
+ char *ptr;
+
+ /*
+ * Save the text until we see the error message(s), then print it.
+ * This because emacs puts the error message at the top of the
+ * window, and it's nice to be able to see the text below it.
+ */
+
+ ptr = yytext;
+ while (*ptr)
+ *bufptr++ = *ptr++;
+ *bufptr++ = '\n';
+
+ BEGIN 0;
+}
+
+^Processing\ include\ file\ .*$ {
+ /*
+ * name of a new include file being processed. Increment file number
+ * and remember the file name corresponding to this file number.
+ */
+
+ current_file = strsave (yytext+24);
+
+ if (debug) {
+ fprintf (yyout, "current_file <= %s\n", current_file);
+ fprintf (yyout, "%s\n", yytext);
+ }
+}
+
+^([a-z]\ -)?\ *{EC}: {
+ /*
+ * error message (which we print immediately) preceded by an
+ * error code (which we ignore)
+ */
+
+ fprintf (yyout, "\"%s\", line %d: %c -", current_file, line, *yytext);
+ last_line_was_error = 1;
+ BEGIN ErrorMessage;
+}
+
+^{D3}\ {D5}\ {D4}\ {EC}: {
+ /*
+ * (optional) nesting level, followed by line number, followed
+ * by column number, followed by error message text.
+ */
+
+ /*
+ * save the line number for later
+ */
+ line = atoi (yytext+4);
+
+ if (debug) {
+ fprintf (yyout, "line <= %d\n", line);
+ fprintf (yyout, "%s\n", yytext);
+ }
+
+ /*
+ * if the last line was an error message, flush out all of
+ * the old source text before printing this error message.
+ */
+ if (last_line_was_error) {
+ *bufptr = '\0';
+ bufptr = bigbuf;
+ while (*bufptr)
+ putc (*bufptr++, yyout);
+ bufptr = bigbuf;
+ last_line_was_error = 0;
+ }
+ fprintf (yyout, "\"%s\", line %d:", current_file, line);
+ last_line_was_error = 1;
+ BEGIN ErrorMessage;
+}
+
+<ErrorMessage>[^\n]*$ {
+ fprintf (yyout, "%s\n", yytext);
+ BEGIN 0;
+}
+
+
+^[^ :]+".c:"\ *$ {
+ /* name of new source file being processed */
+
+ char *ptr;
+
+ if (current_file)
+ free (current_file);
+ ptr = strchr (yytext, ':');
+ *ptr = '\0';
+ current_file = strsave (yytext);
+}
+
+^[^\n] {
+ /*
+ * other text starting with a newline. We have to break it up this
+ * way to keep this rule from matching any of the above patterns
+ */
+
+ if (last_line_was_error) {
+ *bufptr = '\0';
+ bufptr = bigbuf;
+ while (*bufptr)
+ putc (*bufptr++, yyout);
+ bufptr = bigbuf;
+ last_line_was_error = 0;
+ }
+
+ *bufptr++ = *yytext;
+ BEGIN OtherText;
+}
+
+<OtherText>[^\n]*$ {
+ char *ptr;
+
+ ptr = yytext;
+ while (*ptr)
+ *bufptr++ = *ptr++;
+ *bufptr++ = '\n';
+
+ BEGIN 0;
+}
+
+\n ;
+
+%%
+
+main (argc, argv)
+char **argv;
+{
+ int pfd[2];
+ int child_pid;
+ int i;
+
+ current_file = strsave ("/dev/null");
+
+ line = 0;
+
+ for (i = 1; i < argc; ++i) {
+ char *ptr = strrchr (argv[i], '.');
+ if (ptr && ptr[1] == 'c' && ptr[2] == '\0') {
+ current_file = strsave (argv[i]);
+ break;
+ }
+ }
+
+ if (pipe (pfd) < 0) {
+ perror ("pipe");
+ exit (1);
+ }
+ if ((child_pid = fork()) > 0) {
+ int status;
+
+ close (pfd[1]);
+ yyin = fdopen (pfd[0], "r");
+ yyout = stderr;
+ yylex();
+
+ wait (&status);
+ exit ((status >> 8) & 0xff);
+ }
+ else if (child_pid == 0) {
+ dup2 (pfd[1], 2);
+ close (pfd[0]);
+ close (pfd[1]);
+ argv[0] = "cc";
+ execv ("/bin/cc", argv);
+ perror ("/bin/cc");
+ exit (1);
+ }
+ else {
+ perror ("fork");
+ exit (1);
+ }
+}
--- /dev/null
+## Process the output of makedepend.
+## Copyright (c) 1994 Amdahl Corporation.
+## Written by Ben Wing, December 1994.
+
+## This file is used as part of 'make depend', to produce the
+## dependency list for src/Makefile.in.in.
+
+## Unfortunately, makedepend (at least the one that comes as part
+## of Open Windows under Solaris) is stupid and doesn't follow the
+## documented behavior. So we have to force the definitions of
+## certain options through -D flags (even though it's supposed to
+## pick this up), and post-process the output to get rid of stuff
+## we don't want.
+
+## The sed stage gets rid of include files in other directories,
+## except for lwlib.h (makedepend puts system include files in,
+## which is pretty stupid). We also get rid of some standard
+## include files that are in every or pretty much every file
+## and where changes in those files don't usually merit
+## recompilation of everything. Finally, we eliminate entirely
+## the dependencies for some files (such as unex*.c) that get
+## screwed up by makedepend. We just put those in by hand at
+## the top of the dependency list.
+
+## For Mule, we need to do some additional processing: conversion
+## to MULESRCDIR (at least so that the include files don't get
+## wiped out by the next stage) and removing the mule/ prefix
+## from the object file names.
+
+## The awk stage puts one dependency per line. Then we pass
+## the result through sort and uniq (makedepend is supposed
+## to not put in duplicate dependencies, but it does so
+## occasionally).
+
+## After running 'make depend', verify that the output (in
+## depend.out) is reasonable and then replace the stuff in
+## Makefile.in.in marked "generated by 'make depend'".
+
+sed -e '
+1d
+s/ \/[^ ]*\/lwlib\// $(LWLIBSRCDIR)\//g
+s/\.\.\/etc\//${srcdir}\/${etcdir}/g
+s/^mule\///g
+s/ mule\// $(MULESRCDIR)\/mule\//g
+s/ \/[^ ]*\.h//g
+s/ \/[^ ]*gray//g
+s/ [a-z][^ ]*\/[^ ]*\.h//g
+s/ lisp\.h//g
+s/ lisp-union\.h//g
+s/ lisp-disunion\.h//g
+s/ lrecord\.h//g
+s/ emacsfns\.h//g
+s/ symeval\.h//g
+s/ symsinit\.h//g
+s/ syssignal\.h//g
+s/ intl\.h//g
+s/ tt_c\.h//g
+s/ descrip\.h//g
+/^unex/d
+/^sgiplay/d
+/^Extern/d
+/^extw/d
+/^[^ ]*\.o:$/d
+' | awk '
+{ for (i = 2; i <= NF; i++)
+ printf ("%s %s\n", $1, $i)
+}
+' | sort | uniq
--- /dev/null
+#!/bin/sh
+
+perl -e '
+while (<>)
+{
+ chop;
+ $foo .= $_;
+ if (!/\\$/)
+ {
+ @foo = split (/[ \\:\n]+/, $foo);
+ $filename = $foo[0];
+ if (($filename =~ /^unex/) ||
+ ($filename =~ /^sgiplay/) ||
+ ($filename =~ /^Extern/) ||
+ ($filename =~ /^extw/))
+ {
+ $foo = "";
+ next;
+ }
+ @foo = grep (!/\.c$/, @foo);
+ @foo = grep ((s/\/.*lwlib\//\$(LWLIBSRCDIR)\//, 1), @foo);
+ @foo = grep (!/lisp\.h/, @foo);
+ @foo = grep (!/lisp\.h/, @foo);
+ @foo = grep (!/lisp-union\.h/, @foo);
+ @foo = grep (!/lisp-disunion\.h/, @foo);
+ @foo = grep (!/lrecord\.h/, @foo);
+ @foo = grep (!/emacsfns\.h/, @foo);
+ @foo = grep (!/symeval\.h/, @foo);
+ @foo = grep (!/symsinit\.h/, @foo);
+ @foo = grep (!/syssignal\.h/, @foo);
+ @foo = grep (!/intl\.h/, @foo);
+ @foo = grep (!/tt_c\.h/, @foo);
+ @foo = grep (!/descrip\.h/, @foo);
+ shift @foo;
+ if (!$#foo)
+ {
+ next;
+ }
+ foreach $i (0 .. $#foo)
+ {
+ $foo[$i] = $filename . ": " . $foo[$i];
+ }
+ print $filename . ": config.h\n";
+ print join ("\n", @foo);
+ print "\n";
+ $foo = "";
+ }
+}
+' | sort | uniq
\ No newline at end of file
--- /dev/null
+: # -*-Perl-*-
+eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
+ if 0;
+#
+# pstogif.pl v1.0, July 1994, by Nikos Drakos <nikos@cbl.leeds.ac.uk>
+# Computer Based Learning Unit, University of Leeds.
+#
+# Accompanies LaTeX2HTML Version 96.1
+#
+# Script to convert an arbitrary PostScript image to a cropped GIF image
+# suitable for incorporation into HTML documents as inlined images to be
+# viewed with WWW browsers.
+#
+# This is based on the pstoepsi script
+# by Doug Crabill dgc@cs.purdue.edu
+#
+# Please note the following:
+# - The source PostScript file must end
+# in a .ps extention. This is a GhostScript requirement, not mine...
+# - The -density argument has no effect unless the
+# color depth (set with the -depth argument) is equal to 1.
+# - Valid arguments for -depth are 1,8, or 24.
+#
+# This software is provided as is without any guarantee.
+#
+# Nikos Drakos (ND), nikos@cbl.leeds.ac.uk
+# Computer Based Learning Unit, University of Leeds.
+#
+# 15 Jan 96 HS Call ppmquant only if needed. Fixed bug relative to
+# V 95.3 .
+#
+# 15 Dec 95 HS (Herbert Swan <dprhws.edp.Arco.com> Added support for
+# the flip=option. This allows images to be oriented differently
+# in the paper versus the electronic media
+#
+# 1 Nov 95 jmn - modified for use with gs ppm driver - from jhrg's patches
+# note that ppmtops.ps and ppmtops3.ps are no longer needed
+#
+# 20 JUL 94 ND Converted to Perl and made several changes eg it now accepts
+# parameters from environment variables or from command line or will use
+# default ones.
+#
+# 1 APR 94 ND Changed the suffixes of multi-page files from xbm to gif (oops!)
+#
+#
+
+#####################################################################
+$| =1;
+&read_args;
+
+### You may need to specify some pathnames here if you want to
+### run the script without LaTeX2HTML
+
+# Ghostscript
+$GS= $ENV{'GS'} || 'gs';
+
+# Comes with LaTeX2HTML (For ghostscript versions greater than 3.0
+# you need the newer pstoppm.ps)
+#$PSTOPPM= $ENV{'PSTOPPM'} ||
+# 'pstoppm.ps';
+
+# Available in the PBMPLUS library
+$PNMCROP=$ENV{'PNMCROP'} || 'pnmcrop' ;
+
+# Also in PBMPLUS
+$PNMFLIP=$ENV{'PNMFLIP'} || 'pnmflip' ;
+
+# Also in PBMPPLUS
+$PPMTOGIF=$ENV{'PPMTOGIF'} || 'ppmtogif' ;
+
+# Also in PBMPPLUS
+$REDUCE_COLOR=$ENV{'PPMQUANT'} || 'ppmquant 256' ;
+
+$OUTFILE = $ENV{'OUTFILE'} || $out;
+
+# Valid choices for $COLOR_DEPTH are 1, 8 or 24.
+$DEPTH = $ENV{'DEPTH'} || $depth || 24;
+
+#Default density is 72
+$DENSITY = $ENV{'DENSITY'} || $density || 72;
+
+# Valid choices are any numbers greater than zero
+# Useful choices are numbers between 0.1 - 5
+# Large numbers may generate very large intermediate files
+# and will take longer to process
+$SCALE = $ENV{'SCALE'} || $scale; # No default value
+
+$PAPERSIZE = $ENV{'PAPERSIZE'} || $papersize; # No default value;
+
+$DEBUG = $ENV{'DEBUG'} || $DEBUG || 0;
+
+######################################################################
+
+&main;
+
+sub read_args {
+ local($_);
+ local($color);
+ while ($ARGV[0] =~ /^-/) {
+ $_ = shift @ARGV;
+ if (/^-h(elp)?$/) {
+ &usage; exit}
+ elsif (/^-out$/) {
+ $out = shift @ARGV;
+ }
+ elsif (/^-(.*)$/) {
+ eval "\$$1 = shift \@ARGV"; # Create and set a flag $<name>
+ }
+ }
+}
+
+sub main {
+ local($base, $outfile, $i, $j);
+ $base = &test_args;
+ $outfile = $OUTFILE || "$base.gif";
+ open(STDERR, ">/dev/null") unless $DEBUG;
+ &convert($base);
+ if (-f "$base.ppm") {
+ &crop_scale_etc("$base.ppm", $outfile);
+ }
+ else {
+ foreach $i (<$base.[1-9]*ppm>) {
+ $j = $i;
+ $j =~ s/\.(.*)ppm/$1.gif/;
+ &crop_scale_etc($i, $j)}
+ }
+ &cleanup($base);
+}
+
+sub crop_scale_etc {
+ local($in, $out) = @_;
+ local($tmp) = $in . ".tmp";
+ open(STDERR, ">/dev/null") unless $DEBUG;
+
+ if ($flip) {
+ rename($tmp, $in) unless system("$PNMFLIP -$flip $in > $tmp");
+ }
+ system("$PNMCROP $in > $tmp");
+
+ if (system("$PPMTOGIF $tmp > $out")) {
+ print "Running ppmquant for $out\n";
+ system("$REDUCE_COLOR < $tmp|$PPMTOGIF - > $out");
+ }
+ unlink $tmp;
+ print "Writing $out\n";
+}
+
+sub test_args {
+ local($file) = $ARGV[0];
+ if (! ($file =~ s/\.ps$//)) {
+ print "The name of the input file must end in '.ps'\n";
+ exit}
+ elsif (! ( -f "$file.ps")) {
+ print "Cannot find file $file.ps\n.";
+ exit}
+ elsif (! ($DEPTH =~ /^(1|8|24)$/)) {
+ print "The color depth must be 1 or 8 or 24. You specified $DEPTH\n";
+ exit
+ }
+ if (defined $SCALE) {
+ if ($SCALE > 0) {
+ $DENSITY = int($SCALE * $DENSITY)}
+ else {
+ print "Error: The scale must be greater than 0.\n" .
+ "You specified $SCALE\n";
+ exit}
+ }
+ $file;
+}
+
+sub convert {
+ local($base) = @_;
+ local($paperopt) = "-sPAPERSIZE=$PAPERSIZE" if $PAPERSIZE;
+ local($ppmtype) = join('', "ppm",$DEPTH,"run");
+ local($density) = "-r$DENSITY" if ($DENSITY != 72);
+ open (GS, "|$GS -q -dNOPAUSE -dNO_PAUSE -sDEVICE=ppmraw $density -sOutputFile=$base.ppm $paperopt $base.ps");
+ close GS;
+}
+
+sub cleanup {
+ local($base) = @_;
+ unlink <$base[0-9.]*ppm>;
+}
+
+sub usage {
+ print "Usage: pstogif [-h(elp)] [-out <output file>] [-depth <color depth 1, 8 or 24>] [-flip <Flip_code>] [-density <pixel density>] <file>.ps\n\n";
+}
+
+
--- /dev/null
+/* run -- Wrapper program for console mode programs under Windows(TM)
+ * Copyright (C) 1998 Charles S. Wilson
+ *
+ * This program 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
+ * of the License, or (at your option) any later version.
+ *
+ * This program 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 this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+/*
+ * This program is based on the runemacs.c distributed with XEmacs 21.0
+ *
+ * Simple program to start gnu-win32 X11 programs (and native XEmacs)
+ * with its console window hidden.
+ *
+ * This program is provided purely for convenience, since most users will
+ * use XEmacs in windowing (GUI) mode, and will not want to have an extra
+ * console window lying around. Ditto for desktop shortcuts to gnu-win32
+ * X11 executables.
+ */
+
+
+#define WIN32
+
+#include <windows.h>
+#include <string.h>
+#include <malloc.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+
+#include "run.h"
+
+#if defined(__CYGWIN__)
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #include <sys/cygwin.h>
+ #include <sys/unistd.h>
+WinMainCRTStartup() { mainCRTStartup(); }
+#else
+ #include <direct.h>
+#endif
+
+
+char buffer[1024];
+
+int WINAPI
+WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
+{
+ int wait_for_child = FALSE;
+ int compact_invocation = FALSE;
+ DWORD ret_code = 0;
+
+
+ char execname[FILENAME_MAX];
+ char execpath[MAX_PATH];
+ char* argv[MAX_ARGS+1]; /* leave extra slot for compact_invocation argv[0] */
+ int argc;
+ int i,j;
+ char exec[MAX_PATH + FILENAME_MAX + 100];
+ char cmdline2[MAX_ARGS * MAX_PATH];
+
+ compact_invocation = get_exec_name_and_path(execname,execpath);
+
+ if (compact_invocation)
+ {
+ argv[0] = execname;
+ argc = parse_cmdline_to_arg_array(&(argv[1]),cmdline);
+ argc++;
+ }
+ else
+ {
+ argc = parse_cmdline_to_arg_array(argv,cmdline);
+ if (argc >= 1)
+ strcpy(execname,argv[0]);
+ }
+ /* at this point, execpath is defined, as are argv[] and execname */
+#ifdef DEBUG
+ j = sprintf(buffer,"\nexecname : %s\nexecpath : %s\n",execname,execpath);
+ for (i = 0; i < argc; i++)
+ j += sprintf(buffer+j,"argv[%d]\t: %s\n",i,argv[i]);
+ Trace((buffer));
+#endif
+
+ if (execname == NULL)
+ error("you must supply a program name to run");
+
+#if defined(__CYGWIN__)
+ /* this insures that we search for symlinks before .exe's */
+ if (compact_invocation)
+ strip_exe(execname);
+#endif
+
+ process_execname(exec,execname,execpath);
+ Trace(("exec\t%s\nexecname\t%s\nexecpath\t%s\n",
+ exec,execname,execpath));
+
+ wait_for_child = build_cmdline(cmdline2,exec,argc,argv);
+ Trace((cmdline2));
+
+ xemacs_special(exec);
+ ret_code = start_child(cmdline2,wait_for_child);
+ if (compact_invocation)
+ for (i = 1; i < argc; i++) // argv[0] was not malloc'ed
+ free(argv[i]);
+ else
+ for (i = 0; i < argc; i++)
+ free(argv[i]);
+ return (int) ret_code;
+}
+int start_child(char* cmdline, int wait_for_child)
+{
+ STARTUPINFO start;
+ SECURITY_ATTRIBUTES sec_attrs;
+ SECURITY_DESCRIPTOR sec_desc;
+ PROCESS_INFORMATION child;
+ int retval;
+
+ memset (&start, 0, sizeof (start));
+ start.cb = sizeof (start);
+ start.dwFlags = STARTF_USESHOWWINDOW;
+ start.wShowWindow = SW_HIDE;
+
+ sec_attrs.nLength = sizeof (sec_attrs);
+ sec_attrs.lpSecurityDescriptor = NULL;
+ sec_attrs.bInheritHandle = FALSE;
+
+ if (CreateProcess (NULL, cmdline, &sec_attrs, NULL, TRUE, 0,
+ NULL, NULL, &start, &child))
+ {
+ if (wait_for_child)
+ {
+ WaitForSingleObject (child.hProcess, INFINITE);
+ GetExitCodeProcess (child.hProcess, &retval);
+ }
+ CloseHandle (child.hThread);
+ CloseHandle (child.hProcess);
+ }
+ else
+ error("could not start %s",cmdline);
+ return retval;
+}
+void xemacs_special(char* exec)
+{
+ /*
+ * if we're trying to run xemacs, AND this file was in %emacs_dir%\bin,
+ * then set emacs_dir environment variable
+ */
+ char* p;
+ char* p2;
+ char exec2[MAX_PATH + FILENAME_MAX + 100];
+ char tmp[MAX_PATH + FILENAME_MAX + 100];
+ strcpy(exec2,exec);
+ /* this depends on short-circuit evaluation */
+ if ( ((p = strrchr(exec2,'\\')) && stricmp(p,"\\xemacs") == 0) ||
+ ((p = strrchr(exec2,'/')) && stricmp(p,"/xemacs") == 0) ||
+ ((p = strrchr(exec2,'\\')) && stricmp(p,"\\xemacs.exe") == 0) ||
+ ((p = strrchr(exec2,'/')) && stricmp(p,"/xemacs.exe") == 0) )
+ {
+ if ( ((p2 = strrchr(p, '\\')) && stricmp(p2, "\\bin") == 0) ||
+ ((p2 = strrchr(p, '/')) && stricmp(p2, "/bin") == 0) )
+ {
+ *p2 = '\0';
+#if defined(__CYGWIN__)
+ CYGWIN_CONV_TO_POSIX_PATH((exec2,tmp));
+ strcpy(exec2,tmp);
+#else /* NATIVE xemacs DOS-style paths with forward slashes */
+ for (p = exec2; *p; p++)
+ if (*p == '\\') *p = '/';
+#endif
+ SetEnvironmentVariable ("emacs_dir", exec2);
+ }
+ }
+}
+int build_cmdline(char* new_cmdline, char* exec, int argc, char* argv[])
+{
+ int retval = FALSE;
+ int first_arg = 1;
+ int i;
+ int char_cnt = 0;
+ /*
+ * look for "-wait" as first true argument; we'll apply that ourselves
+ */
+ if ((argc >= 2) && (stricmp(argv[1],"-wait") == 0))
+ {
+ retval = TRUE;
+ first_arg++;
+ }
+
+ char_cnt = strlen(exec);
+ for (i = first_arg; i < argc; i++)
+ char_cnt += strlen(argv[i]);
+ if (char_cnt > MAX_ARGS*MAX_PATH) /* then we ran out of room */
+ error("command line too long -\n%s",new_cmdline);
+
+ strcpy(new_cmdline,exec);
+ for (i = first_arg; i < argc; i++)
+ {
+ strcat(new_cmdline," ");
+ strcat(new_cmdline,argv[i]);
+ }
+ return retval;
+}
+/* process exec_arg : if it
+ * NATIVE:
+ * 1) starts with '\\' or '/', it's a root-path and leave it alone
+ * 2) starts with 'x:\\' or 'x:/', it's a root-path and leave it alone
+ * 3) starts with '.\\' or './', two possible meanings:
+ * 1) exec is in the current directory
+ * 2) exec in same directory as this program
+ * 4) otherwise, search path (and _prepend_ "." to the path!!!)
+ * 5) convert all '/' to '\\'
+ * CYGWIN
+ * 1) starts with '\\' or '/', it's a root-path and leave it alone
+ * 2) starts with 'x:\\' or 'x:/', it's a root-path and leave it alone
+ * 3) starts with '.\\' or './', two possible meanings:
+ * 1) exec is in the current directory
+ * 2) exec in same directory as this program
+ * 4) otherwise, search path (and _prepend_ "." to the path!!!)
+ * 5) convert to cygwin-style path to resolve symlinks within the pathspec
+ * 6) check filename: if it's a symlink, resolve it by peeking inside
+ * 7) convert to win32-style path+filename since we're using Windows
+ * createProcess() to launch
+ */
+void process_execname(char *exec, const char* execname,const char* execpath )
+{
+ char* orig_pathlist;
+ char* pathlist;
+ char exec_tmp[MAX_PATH + FILENAME_MAX + 100];
+ char exec_tmp2[MAX_PATH + FILENAME_MAX + 100];
+ char buf[MAX_PATH + FILENAME_MAX + 100];
+ int i,j;
+
+ int len = 0;
+ /*
+ * STARTS WITH / or \
+ * execpath NOT used
+ */
+ if ((execname[0] == '\\') || (execname[0] == '/'))
+ {
+#if defined(__CYGWIN__)
+ strcpy(exec_tmp,execname);
+#else
+ exec_tmp[0] = ((char) (_getdrive() + ((int) 'A') - 1));
+ exec_tmp[1] = ':';
+ exec_tmp[2] = '\0';
+ strcat(exec_tmp,execname);
+#endif
+ Trace(("/ -\nexec_tmp\t%s\nexecname\t%s\nexecpath\t%s\n",
+ exec_tmp,execname,execpath));
+ if (! fileExistsMulti(exec_tmp2,NULL,exec_tmp,exts,NUM_EXTENSIONS) )
+ {
+ j = 0;
+ for (i = 0; i < NUM_EXTENSIONS; i++)
+ j += sprintf(buf + j," [%d]: %s\n",i+1,exts[i]);
+ error("Couldn't locate %s\nI tried appending the following "
+ "extensions: \n%s",exec_tmp,buf);
+ }
+ Trace((exec_tmp2));
+ }
+ /*
+ * STARTS WITH x:\ or x:/
+ * execpath NOT used
+ */
+ else if ((strlen(execname) > 3) && // avoid boundary errors
+ (execname[1] == ':') &&
+ ((execname[2] == '\\') || (execname[2] == '/')))
+ {
+ strcpy(exec_tmp,execname);
+ Trace(("x: -\nexec_tmp\t%s\nexecname\t%s\nexecpath\t%s\n",
+ exec_tmp,execname,execpath));
+ if (! fileExistsMulti(exec_tmp2,NULL,exec_tmp,exts,NUM_EXTENSIONS) )
+ {
+ j = 0;
+ for (i = 0; i < NUM_EXTENSIONS; i++)
+ j += sprintf(buf + j," [%d]: %s\n",i+1,exts[i]);
+ error("Couldn't locate %s\nI tried appending the following "
+ "extensions: \n%s",exec_tmp,buf);
+ }
+ Trace((exec_tmp2));
+ }
+ /*
+ * STARTS WITH ./ or .\
+ */
+ else if ((execname[0] == '.') &&
+ ((execname[1] == '\\') || (execname[1] == '/')))
+ {
+ if (((char*) getcwd(exec_tmp,MAX_PATH))==NULL)
+ error("can't find current working directory");
+ if (! fileExistsMulti(exec_tmp2,exec_tmp,&(execname[2]),
+ exts,NUM_EXTENSIONS) )
+ if (! fileExistsMulti(exec_tmp2,execpath,&(execname[2]),
+ exts,NUM_EXTENSIONS) )
+ {
+ j = 0;
+ for (i = 0; i < NUM_EXTENSIONS; i++)
+ j += sprintf(buf + j," [%d]: %s\n",i+1,exts[i]);
+ error("Couldn't locate %s\n"
+ "I looked in the following directories:\n [1]: %s\n [2]: %s\n"
+ "I also tried appending the following "
+ "extensions: \n%s",execname,exec_tmp,execpath,buf);
+ }
+ Trace((exec_tmp2));
+ }
+ /*
+ * OTHERWISE, SEARCH PATH (prepend '.' and run.exe's directory)
+ * can't use fileExistsMulti because we want to search entire path
+ * for exts[0], then for exts[1], etc.
+ */
+ else
+ {
+ orig_pathlist = getenv("PATH");
+ if ((pathlist = malloc (strlen(orig_pathlist)
+ + strlen(".")
+ + strlen(execpath)+ 3)) == NULL)
+ error("internal error - out of memory");
+ strcpy(pathlist,".");
+ strcat(pathlist,SEP_CHARS);
+ strcat(pathlist,execpath);
+ strcat(pathlist,SEP_CHARS);
+ strcat(pathlist,orig_pathlist);
+
+ Trace((pathlist));
+ for (i = 0; i < NUM_EXTENSIONS; i++)
+ {
+ strcpy(exec_tmp,execname);
+ strcat(exec_tmp,exts[i]);
+ pfopen(exec_tmp2,exec_tmp,pathlist);
+ if (fileExists(NULL,NULL,exec_tmp2))
+ break;
+ exec_tmp2[0] = '\0';
+ }
+ Trace(("exec_tmp\t%s\npathlist\t%s\n",exec_tmp2,pathlist));
+
+ free(pathlist);
+ if (exec_tmp2[0] == '\0')
+ {
+ j = 0;
+ for (i = 0; i < NUM_EXTENSIONS; i++)
+ j += sprintf(buf + j," [%d]: %s\n",i+1,exts[i]);
+ error("Couldn't find %s anywhere.\n"
+ "I even looked in the PATH \n"
+ "I also tried appending the following "
+ "extensions: \n%s",execname,buf);
+ }
+ }
+/*
+ * At this point, we know that exec_tmp2 contains a filename
+ * and we know that exec_tmp2 exists.
+ */
+#if defined(__CYGWIN__)
+ {
+ struct stat stbuf;
+ char sym_link_name[MAX_PATH+1];
+ char real_name[MAX_PATH+1];
+ char dummy[MAX_PATH+1];
+
+ strcpy(exec_tmp,exec_tmp2);
+
+ CYGWIN_CONV_TO_POSIX_PATH((exec_tmp,sym_link_name));
+ Trace((sym_link_name));
+
+ if (lstat(sym_link_name, &stbuf) == 0)
+ {
+ if ((stbuf.st_mode & S_IFLNK) == S_IFLNK)
+ {
+ if (readlink(sym_link_name, real_name, sizeof(real_name)) == -1)
+ error("problem reading symbolic link for %s",exec_tmp);
+ else
+ {
+ // if realname starts with '/' it's a rootpath
+ if (real_name[0] == '/')
+ strcpy(exec_tmp2,real_name);
+ else // otherwise, it's relative to the symlink's location
+ {
+ CYGWIN_SPLIT_PATH((sym_link_name,exec_tmp2,dummy));
+ if (!endsWith(exec_tmp2,PATH_SEP_CHAR_STR))
+ strcat(exec_tmp2,PATH_SEP_CHAR_STR);
+ strcat(exec_tmp2,real_name);
+ }
+ }
+ }
+ else /* NOT a symlink */
+ strcpy(exec_tmp2, sym_link_name);
+ }
+ else
+ error("can't locate executable - %s",sym_link_name);
+ }
+ CYGWIN_CONV_TO_FULL_WIN32_PATH((exec_tmp2,exec));
+#else
+ strcpy (exec, exec_tmp2);
+#endif
+}
+int endsWith(const char* s1, const char* s2)
+{
+ int len1;
+ int len2;
+ int retval = FALSE;
+ len1 = strlen(s1);
+ len2 = strlen(s2);
+ if (len1 - len2 >= 0)
+ if (stricmp(&(s1[len1-len2]),s2) == 0)
+ retval = TRUE;
+ return retval;
+}void strip_exe(char* s)
+{
+ if ((strlen(s) > 4) && // long enough to have .exe extension
+ // second part not evaluated (short circuit) if exec_arg too short
+ (stricmp(&(s[strlen(s)-4]),".exe") == 0))
+ s[strlen(s)-4] = '\0';
+}
+void error(char* fmt, ...)
+{
+ char buf[4096];
+ int j;
+ va_list args;
+ va_start(args, fmt);
+ j = sprintf(buf, "Error: ");
+ j += vsprintf(buf + j,fmt,args);
+ j += sprintf(buf + j,"\n");
+ va_end(args);
+ MessageBox(NULL, buf, "Run.exe", MB_ICONSTOP);
+ exit(1);
+}
+void message(char* fmt, ...)
+{
+ char buf[10000];
+ int j;
+ va_list args;
+ va_start(args, fmt);
+ j = vsprintf(buf,fmt,args);
+ j += sprintf(buf + j,"\n");
+ va_end(args);
+ MessageBox(NULL, buf, "Run.exe Message", MB_ICONSTOP);
+}
+void Trace_(char* fmt, ...)
+{
+ char buf[10000];
+ int j;
+ va_list args;
+ va_start(args, fmt);
+ j = vsprintf(buf,fmt,args);
+ j += sprintf(buf + j,"\n");
+ va_end(args);
+ MessageBox(NULL, buf, "Run.exe DEBUG", MB_ICONSTOP);
+}
+/*
+ * Uses system info to determine the path used to invoke run
+ * Also attempts to deduce the target execname if "compact_invocation"
+ * method was used.
+ *
+ * returns TRUE if compact_invocation method was used
+ * (and target execname was deduced successfully)
+ * otherwise returns FALSE, and execname == run or run.exe
+ */
+int get_exec_name_and_path(char* execname, char* execpath)
+{
+ char modname[MAX_PATH];
+ char* tmp_execname;
+ char* p;
+ int retval = FALSE;
+
+ if (!GetModuleFileName (NULL, modname, MAX_PATH))
+ error("internal error - can't find my own name");
+ if ((p = strrchr (modname, '\\')) == NULL)
+ error("internal error - my own name has no path\n%s",modname);
+ tmp_execname = p + 1;
+ p[0] = '\0';
+ // if invoked by a name like "runxemacs" then strip off
+ // the "run" and let "xemacs" be execname.
+ // To check for this, make that:
+ // 1) first three chars are "run"
+ // 2) but the string doesn't end there, or start ".exe"
+ // Also, set "compact_invocation" TRUE
+ if ( ((tmp_execname[0] == 'r') || (tmp_execname[0] == 'R')) &&
+ ((tmp_execname[1] == 'u') || (tmp_execname[1] == 'U')) &&
+ ((tmp_execname[2] == 'n') || (tmp_execname[2] == 'N')) &&
+ ((tmp_execname[3] != '.') && (tmp_execname[3] != '\0')) )
+ {
+ tmp_execname += 3;
+ retval = TRUE;
+ }
+ else
+ tmp_execname = NULL;
+
+ if (tmp_execname == NULL)
+ strcpy(execname,"");
+ else
+ strcpy(execname,tmp_execname);
+#if defined(__CYGWIN__)
+ CYGWIN_CONV_TO_POSIX_PATH((modname,execpath));
+#else
+ strcpy(execpath,modname);
+#endif
+ return retval;
+}
+/*
+ * works like strtok, but:
+ * double quotes (") suspends tokenizing until closing " reached
+ * CYGWIN ONLY:
+ * additionally, backslash escapes next character, even if that
+ * next character is a delimiter. Or a double quote.
+ * WARNING: this means that backslash may NOT be a delimiter
+ */
+char* my_strtok(char* s, const char* delim, char** lasts)
+{
+ char *spanp;
+ int c, sc;
+ char *tok;
+
+ if ((s == NULL) && ((s = *lasts) == NULL))
+ return NULL;
+ /* Skip leading delimiters */
+cont:
+ c = *s++;
+ for (spanp = (char *)delim; (sc = *spanp++) != 0;) {
+ if (c == sc)
+ goto cont;
+ }
+ if (c == 0) { /* no non-delimiter characters */
+ *lasts = NULL;
+ return (NULL);
+ }
+ tok = s - 1;
+ /*
+ * Scan token (scan for delimiters: s += strcspn(s, delim), sort of).
+ * Note that delim must have one NUL; we stop if we see that, too.
+ * If we see a double quote, continue until next double quote, then
+ * start scanning for delimiters again.
+ * CYGWIN ONLY: if we see a backslash, just copy next character -
+ * don't consider it as a delimiter even if it is in delim string.
+ */
+ for (;;) {
+ /* if this c is ", then scan until we find next " */
+ if (c == '\"')
+ while ((c = *s++) != '\"')
+ if (c == 0) /* oops, forgot to close the ", clean up & return */
+ {
+ s = NULL;
+ *lasts = s;
+ return (tok);
+ }
+#if defined(__CYGWIN__)
+ if (c == '\\')
+ {
+ c = *s++; /* skip the backslash */
+ if (c == 0) /* if escaped character is end-of-string, clean up & return */
+ {
+ s = NULL;
+ *lasts = s;
+ return (tok);
+ }
+ c = *s++; /* otherwise, skip the escaped character */
+ }
+#endif
+ spanp = (char *)delim;
+ do {
+ if ((sc = *spanp++) == c) {
+ if (c == 0)
+ s = NULL;
+ else
+ s[-1] = 0;
+ *lasts = s;
+ return (tok);
+ }
+ } while (sc != 0);
+ c = *s++;
+ }
+ /* NOTREACHED */
+}
+int parse_cmdline_to_arg_array(char* argv[MAX_ARGS], char* cmdline)
+{
+ char seps[] = " \t\n";
+ char* token;
+ int argc = 0;
+ char* lasts;
+
+ token = my_strtok(cmdline, seps, &lasts);
+ while ((token != NULL) && (argc < MAX_ARGS))
+ {
+ if ((argv[argc] = malloc(strlen(token)+1)) == NULL)
+ {
+ error("internal error - out of memory");
+ }
+ strcpy(argv[argc++],token);
+ token = my_strtok(NULL,seps,&lasts);
+ }
+ if (argc >= MAX_ARGS)
+ error("too many arguments on commandline\n%s",cmdline);
+ return argc;
+}
+/* Taken from pfopen.c by David Engel (5-Jul-97).
+ * Original comments appear below. Superseded by next comment block.
+ *
+ * Written and released to the public domain by David Engel.
+ *
+ * This function attempts to open a file which may be in any of
+ * several directories. It is particularly useful for opening
+ * configuration files. For example, PROG.EXE can easily open
+ * PROG.CFG (which is kept in the same directory) by executing:
+ *
+ * cfg_file = pfopen("PROG.CFG", "r", getenv("PATH"));
+ *
+ * NULL is returned if the file can't be opened.
+ */
+
+/*
+ * This function attempts to locate a file which may be in any of
+ * several directories. Unlike the original pfopen, it does not
+ * return a FILE pointer to the opened file, but rather returns
+ * the fully-qualified filename of the first match found. Returns
+ * empty string if not found.
+ */
+char *pfopen(char *retval, const char *name, const char *dirs)
+{
+ char *ptr;
+ char *tdirs;
+ char returnval[MAX_PATH + FILENAME_MAX + 100];
+ char *recursive_name;
+ int foundit = FALSE;
+
+ returnval[0] = '\0';
+
+ if (dirs == NULL || dirs[0] == '\0')
+ return NULL;
+
+ if ((tdirs = malloc(strlen(dirs)+1)) == NULL)
+ return NULL;
+
+ strcpy(tdirs, dirs);
+
+ for (ptr = strtok(tdirs, SEP_CHARS); (foundit == FALSE) && ptr != NULL;
+ ptr = strtok(NULL, SEP_CHARS))
+ {
+ foundit = fileExists(returnval,ptr,name);
+ }
+
+ free(tdirs);
+ if (!foundit)
+ retval[0] = '\0';
+ else
+ strcpy(retval,returnval);
+ return retval;
+}
+int fileExistsMulti(char* fullname, const char* path,
+ const char* name_noext, const char* exts[],
+ const int extcnt)
+{
+ char tryName[MAX_PATH + FILENAME_MAX];
+ int i = 0;
+ int retval = FALSE;
+ fullname[0] = '\0';
+ for (i = 0; i < extcnt; i++)
+ {
+ strcpy(tryName,name_noext);
+ strcat(tryName,exts[i]);
+ if (fileExists(fullname, path, tryName) == TRUE)
+ {
+ retval = TRUE;
+ break;
+ }
+ fullname[0] = '\0';
+ }
+ return retval;
+}
+int fileExists(char* fullname, const char* path, const char* name)
+{
+ int retval = FALSE;
+ FILE* file;
+ size_t len;
+ char work[FILENAME_MAX];
+ char work2[MAX_PATH + FILENAME_MAX + 100];
+ if (path != NULL)
+ {
+ strcpy(work, path);
+ len = strlen(work);
+ if (len && work[len-1] != '/' && work[len-1] != '\\')
+ strcat(work, PATH_SEP_CHAR_STR);
+ }
+ else
+ work[0]='\0';
+
+ strcat(work, name);
+#if defined(__CYGWIN__)
+ CYGWIN_CONV_TO_POSIX_PATH((work, work2));
+#else
+ strcpy(work2,work);
+#endif
+
+#ifdef DEBUGALL
+ Trace(("looking for...\t%s\n",work2));
+#endif
+
+ file = fopen(work2, "rb");
+ if (file != NULL)
+ {
+ if (fullname != NULL)
+ strcpy(fullname,work2);
+ retval = TRUE;
+ fclose(file);
+ }
+ return retval;
+}
--- /dev/null
+// #define DEBUG
+// #define DEBUGALL
+
+// B19 - egcs automatically defines CYGWIN32 but not CYGWIN
+// B20 - egcs automatically defines both CYGWIN32 and CYGWIN
+// Bfuture - (???) defines CYGWIN but not CYGWIN32
+#if defined(__CYGWIN32__)
+#if !defined(__CYGWIN__)
+ #define B19
+ #define __CYGWIN__
+#else
+ #define B20
+#endif
+#else
+#if defined(__CYGWIN__)
+ #define B21
+#endif
+#endif
+// Now: use __CYGWIN__ to represent any version
+// distinguish using B19, B20, or B21
+
+#if defined(__CYGWIN__)
+#ifdef B19
+#define CYGWIN_ATTACH_HANDLE_TO_FD(a) cygwin32_attach_handle_to_fd a
+#define CYGWIN_CONV_TO_FULL_POSIX_PATH(a) cygwin32_conv_to_full_posix_path a
+#define CYGWIN_CONV_TO_FULL_WIN32_PATH(a) cygwin32_conv_to_full_win32_path a
+#define CYGWIN_CONV_TO_POSIX_PATH(a) cygwin32_conv_to_posix_path a
+#define CYGWIN_CONV_TO_WIN32_PATH(a) cygwin32_conv_to_win32_path a
+#define CYGWIN_DETACH_DLL(a) cygwin32_detach_dll a
+#define CYGWIN_GETSHARED(a) cygwin32_getshared a
+#define CYGWIN_INTERNAL(a) cygwin32_internal a
+#define CYGWIN_POSIX_PATH_LIST_P(a) cygwin32_posix_path_list_p a
+#define CYGWIN_POSIX_TO_WIN32_PATH_LIST(a) cygwin32_posix_to_win32_path_list a
+#define CYGWIN_POSIX_TO_WIN32_PATH_LIST_BUF_SIZE(a) cygwin32_posix_to_win32_path_list_buf_size a
+#define CYGWIN_SPLIT_PATH(a) cygwin32_split_path a
+#define CYGWIN_WIN32_TO_POSIX_PATH_LIST(a) cygwin32_win32_to_posix_path_list a
+#define CYGWIN_WIN32_TO_POSIX_PATH_LIST_BUF_SIZE(a) cygwin32_win32_to_posix_path_list_buf_size a
+#define CYGWIN_WINPID_TO_PID(a) cygwin32_winpid_to_pid a
+#else
+#define CYGWIN_ATTACH_HANDLE_TO_FD(a) cygwin_attach_handle_to_fd a
+#define CYGWIN_CONV_TO_FULL_POSIX_PATH(a) cygwin_conv_to_full_posix_path a
+#define CYGWIN_CONV_TO_FULL_WIN32_PATH(a) cygwin_conv_to_full_win32_path a
+#define CYGWIN_CONV_TO_POSIX_PATH(a) cygwin_conv_to_posix_path a
+#define CYGWIN_CONV_TO_WIN32_PATH(a) cygwin_conv_to_win32_path a
+#define CYGWIN_DETACH_DLL(a) cygwin_detach_dll a
+#define CYGWIN_GETSHARED(a) cygwin_getshared a
+#define CYGWIN_INTERNAL(a) cygwin_internal a
+#define CYGWIN_POSIX_PATH_LIST_P(a) cygwin_posix_path_list_p a
+#define CYGWIN_POSIX_TO_WIN32_PATH_LIST(a) cygwin_posix_to_win32_path_list a
+#define CYGWIN_POSIX_TO_WIN32_PATH_LIST_BUF_SIZE(a) cygwin_posix_to_win32_path_list_buf_size a
+#define CYGWIN_SPLIT_PATH(a) cygwin_split_path a
+#define CYGWIN_WIN32_TO_POSIX_PATH_LIST(a) cygwin_win32_to_posix_path_list a
+#define CYGWIN_WIN32_TO_POSIX_PATH_LIST_BUF_SIZE(a) cygwin_win32_to_posix_path_list_buf_size a
+#define CYGWIN_WINPID_TO_PID(a) cygwin_winpid_to_pid a
+#endif
+#endif
+
+#if defined(__CYGWIN__)
+ #define PATH_SEP_CHAR_STR "/"
+ #define SEP_CHARS ":"
+#else
+ #define PATH_SEP_CHAR_STR "\\"
+ #define SEP_CHARS ";"
+#endif
+
+#ifndef RC_INVOKED
+
+#define MAX_ARGS 20
+
+#ifdef DEBUG
+ #define Trace(x) Trace_ x
+#else
+ #define Trace(x)
+#endif
+
+#define NUM_EXTENSIONS 2
+const char* exts[NUM_EXTENSIONS] = { "", ".exe" };
+
+char* pfopen(char *retval, const char *name, const char *dirs);
+void error(char* fmt, ...);
+void message(char* fmt, ...);
+void Trace_(char* fmt, ...);
+int get_exec_name_and_path(char* execname, char* execpath);
+char* my_strtok(char* s, const char* delim, char** lasts);
+int parse_cmdline_to_arg_array(char* argv[MAX_ARGS], char* cmdline);
+void strip_exe(char* s);
+int start_child(char* cmdline, int wait_for_child);
+void xemacs_special(char* exec);
+int build_cmdline(char* new_cmdline, char* exec, int argc, char* argv[]);
+void process_execname(char *exec, const char* execname, const char* execpath);
+int fileExists(char* fullname, const char* path, const char* name);
+int endsWith(const char* s1, const char* s2);
+int fileExistsMulti(char* fullname, const char* path,
+ const char* name_noext, const char* exts[],
+ const int extcnt);
+
+#endif /* RC_INVOKED */
+
+
+
--- /dev/null
+XEmacs ICON PRELOAD "xemacs.ico"
+XEmacsFile ICON "file.ico"
+XEmacsLisp ICON "lisp.ico"
+
+#include <windows.h>
+#include "run.h"
+
+1 VERSIONINFO
+FILEVERSION 1, 1, 4, 0
+PRODUCTVERSION 1, 1, 4, 0
+FILEOS VOS_NT_WINDOWS32
+FILETYPE VFT_APP
+FILESUBTYPE 0
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "04090000"
+ BEGIN
+ VALUE "CompanyName", "Charles S. Wilson\000"
+ VALUE "FileDescription", "Runs console-mode programs sans console.\000"
+ VALUE "FileVersion", "1.1.4\000"
+ VALUE "InternalName", "run\000"
+ VALUE "LegalCopyright", "Copyright © 1998 Charles S. Wilson\000"
+ VALUE "OriginalFilename", "run.exe\000"
+ VALUE "ProductName","run\000"
+ VALUE "ProductVersion","1.1.4\000"
+ VALUE "GPL Copyleft", "Released under the GNU General Public License version 2 --------------------------------------- This program is free software; you can redistribute it and/or modify it under the termms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. --------------------------------------- This program 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 this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\000"
+ END
+ END
+END
--- /dev/null
+#!/bin/sh
+# update-elc.sh --- recompile all missing or out-of-date .elc files
+
+# Author: Jamie Zawinski, Ben Wing, Martin Buchholz
+# Maintainer: Martin Buchholz
+# Keywords: recompile byte-compile .el .elc
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+### Commentary:
+## Recompile all .elc files that need recompilation. Requires a
+## working version of "xemacs". Correctly handles the case where the
+## .elc files are missing; thus you can execute "rm lisp/*/*.elc"
+## before running this script. Run this from the parent of the
+## "lisp" directory, or another nearby directory.
+
+set -e
+
+# Try to find the lisp directory in several places.
+# (Sun workspaces have an "editor" directory)
+for dir in . .. ../.. editor ../editor ; do
+ if test -d $dir/lisp/. ; then cd $dir ; break ; fi
+done
+
+if test ! -d lisp/. ; then
+ echo "$0: Cannot find the \"lisp\" directory."
+ exit 1
+fi
+
+if test -z "$EMACS"; then EMACS="./src/xemacs"; fi
+export EMACS
+
+echo " (using $EMACS)"
+
+# fuckin' sysv, man...
+if [ "`uname -r | sed 's/[^0-9]*\([0-9]*\).*/\1/'`" -gt 4 ]; then
+ echon()
+ {
+ /bin/echo $* '\c'
+ }
+else
+ echon()
+ {
+ echo -n $*
+ }
+fi
+
+EMACS_DIR=`cd \`dirname $EMACS\` && pwd`;
+CANON_PWD=`pwd`
+# Account for various system automounter configurations
+if test -d "/net"; then
+ if test -d "/tmp_mnt/net"; then tdir="/tmp_mnt/net"; else tdir="/tmp_mnt"; fi
+ EMACS_DIR=`echo "$EMACS_DIR" | \
+ sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"`
+ CANON_PWD=`echo "$CANON_PWD" | \
+ sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"`
+fi
+REAL="$EMACS_DIR/`basename $EMACS`"
+
+echo "Recompiling in $CANON_PWD"
+echo " with $REAL..."
+
+BYTECOMP="$REAL -batch -vanilla "
+
+$EMACS -batch -vanilla -l $CANON_PWD/lisp/cleantree -f batch-remove-old-elc lisp
+
+prune_vc="( -name '.*' -o -name SCCS -o -name RCS -o -name CVS ) -prune -o"
+
+# $els is a list of all .el files
+# $elcs is a list of all .elc files
+els=/tmp/update-elc-1.$$ elcs=/tmp/update-elc-2.$$
+rm -f $els $elcs
+trap "rm -f $els $elcs" 0 1 2 3 15
+find lisp/. $prune_vc -name '*.el' -print | sort > $els
+find lisp/. $prune_vc -name '*.elc' -print | sed 's/elc$/el/' | sort > $elcs
+
+
+echon "Deleting .elc files without .el files..."
+comm -13 $els $elcs | sed -e '\!/vm.el!d' -e 's/el$/elc/' | \
+ while read file ; do echo rm "$file" ; rm "$file" ; done
+echo done.
+
+
+# Compute patterns to ignore when searching for files
+ignore_dirs=""
+ignore_pattern=''
+
+# Only use Mule XEmacs to compile Mule-specific elisp dirs
+echon "Checking for Mule support..."
+lisp_prog='(princ (featurep (quote mule)))'
+mule_p="`$EMACS -batch -vanilla -eval \"$lisp_prog\"`"
+if test "$mule_p" = nil ; then
+ echo No
+ ignore_dirs="$ignore=dirs mule"
+else
+ echo Yes
+fi
+
+# first recompile the byte-compiler, so that the other compiles take place
+# with the latest version (assuming we're compiling the lisp dir of the emacs
+# we're running, which might not be the case, but often is.)
+#echo "Checking the byte compiler..."
+#$BYTECOMP -f batch-byte-recompile-directory lisp/bytecomp
+
+# Prepare for byte-compiling directories with directory-specific instructions
+# Not necessary any more, but I want to keep the text current to cut & paste
+# into the package lisp maintenance tree.
+#make_special_commands=''
+#make_special () {
+# dir="$1"; shift;
+# ignore_dirs="$ignore_dirs $dir"
+# make_special_commands="$make_special_commands \
+#echo \"Compiling in lisp/$dir\"; \
+#(cd \"lisp/$dir\" && ${MAKE:-make} EMACS=$REAL ${1+$*}); \
+#echo \"lisp/$dir done.\";"
+#}
+
+#if test "$mule_p" != nil; then
+# make_special skk all
+#fi
+
+## AUCTeX is a package now
+# if test "$mule_p" = nil ; then
+# make_special auctex some
+# else
+# make_special auctex some MULE_ELC=tex-jp.elc
+# fi
+#make_special cc-mode all
+# EFS is now packaged
+# make_special efs x20
+#make_special eos -k # not strictly necessary...
+## make_special gnus some # Now this is a package.
+# hyperbole is now packaged
+# make_special hyperbole elc
+# We're not ready for the following, yet.
+#make_special ilisp XEmacsELC=custom-load.elc elc
+# ilisp is now packaged
+# make_special ilisp elc
+# oobr is now packaged
+# make_special oobr HYPB_ELC='' elc
+## W3 is a package now.
+#make_special w3 xemacs-w3
+
+for dir in $ignore_dirs ; do
+ ignore_pattern="${ignore_pattern}/\\/$dir\\//d
+/\\/$dir\$/d
+"
+done
+
+# Other special-case filenames that don't get byte-compiled
+ignore_pattern="$ignore_pattern"'
+\!/,!d
+\!/paths.el$!d
+\!/loadup.el$!d
+\!/loadup-el.el$!d
+\!/update-elc.el$!d
+\!/dumped-lisp.el$!d
+\!/make-docfile.el$!d
+\!/site-start.el$!d
+\!/site-load.el$!d
+\!/site-init.el$!d
+\!/version.el$!d
+\!/very-early-lisp.el$!d
+\!/Installation.el$!d
+'
+
+echo "Compiling files without .elc..."
+NUMTOCOMPILE=20 # compile this many files with each invocation
+comm -23 $els $elcs | \
+ sed "$ignore_pattern" | \
+ xargs -t -n$NUMTOCOMPILE $BYTECOMP -f batch-byte-compile
+echo "Compiling files without .elc... Done"
+
+#if test "$mule_p" != nil; then
+# eval "$make_special_commands"
+#fi
--- /dev/null
+;;; cleantree.el --- Remove out of date .elcs in lisp directories
+
+;; Copyright (C) 1997 by Free Software Foundation, Inc.
+
+;; Author: Steven L Baur <steve@altair.xemacs.org>
+;; Keywords: internal
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; This code is derived from Gnus based on a suggestion by
+;; David Moore <dmoore@ucsd.edu>
+
+;;; Code:
+
+(defun remove-old-elc-1 (dir &optional seen)
+ (setq dir (file-name-as-directory dir))
+ ;; Only scan this sub-tree if we haven't been here yet.
+ (unless (member (file-truename dir) seen)
+ (push (file-truename dir) seen)
+ ;; We descend recursively
+ (let ((dirs (directory-files dir t nil t))
+ dir)
+ (while (setq dir (pop dirs))
+ (when (and (not (member (file-name-nondirectory dir) '("." "..")))
+ (file-directory-p dir))
+ (remove-old-elc-1 dir seen))))
+ ;; Do this directory.
+ (let ((files (directory-files dir t ".el$"))
+ file file-c)
+ (while (setq file (car files))
+ (setq files (cdr files))
+ (setq file-c (concat file "c"))
+ (when (and (file-exists-p file-c)
+ (file-newer-than-file-p file file-c))
+ (message file-c)
+ (delete-file file-c))))))
+
+;;;###autoload
+(defun batch-remove-old-elc ()
+ (defvar command-line-args-left)
+ (unless noninteractive
+ (error "`batch-remove-old-elc' is to be used only with -batch"))
+ (let ((dir (car command-line-args-left)))
+ (message "Cleaning out of date .elcs in directory `%s'..." dir)
+ (remove-old-elc-1 dir)
+ (message "Cleaning out of date .elcs in directory `%s'...done" dir))
+ (setq command-line-args-left nil))
+
+;;; cleantree.el ends here
(when-feature mule "chinese")
(when-feature mule "mule/cyrillic") ; overloaded in leim/quail
(when-feature mule "english")
-;; (when-feature mule "ethiopic")
+ (when-feature mule "ethiopic")
(when-feature mule "european")
(when-feature mule "mule/greek") ; overloaded in leim/quail
(when-feature mule "hebrew")
(when-feature mule "japanese")
(when-feature mule "korean")
(when-feature mule "misc-lang")
-;; (when-feature mule "thai")
+ (when-feature mule "thai-xtis")
(when-feature mule "viet-chars")
-;; (when-feature mule "vietnamese")
+ (when-feature mule "vietnamese")
;; Specialized language support
(when-feature (and mule CANNA) "canna-leim")
;;; cyrillic.el --- Support for languages which use Cyrillic characters
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Copyright (C) 1997 MORIOKA Tomohiko
;; For syntax of Cyrillic
(modify-syntax-entry 'cyrillic-iso8859-5 "w")
-(modify-syntax-entry ?\e,L-\e(B ".")
-(modify-syntax-entry ?\e,Lp\e(B ".")
-(modify-syntax-entry ?\e,L}\e(B ".")
+(modify-syntax-entry ?\e.L\eN- ".")
+(modify-syntax-entry ?\e.L\eNp ".")
+(modify-syntax-entry ?\e.L\eN} ".")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CYRILLIC
(charset . (cyrillic-iso8859-5))
(tutorial . "TUTORIAL.ru")
(coding-system . (iso-8859-5))
- (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+ (sample-text . "Russian (\e.L\eN@\eNc\eNa\eNa\eNZ\eNX\eNY) \eN7\eNT\eN`\eNP\eNR\eNa\eNb\eNR\eNc\eNY\eNb\eNU!")
(documentation . ("Support for Cyrillic ISO-8859-5."
. describe-cyrillic-environment-map))))
;; KOI-8 staff
+(eval-and-compile
+
+(defvar cyrillic-koi8-r-decode-table
+ [
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ ?\e$B(!\e(B ?\e$B("\e(B ?\e$B(#\e(B ?\e$B($\e(B ?\e$B(&\e(B ?\e$B(%\e(B ?\e$B('\e(B ?\e$B()\e(B ?\e$B((\e(B ?\e$B(*\e(B ?\e$B(+\e(B 32 ?\e$(G#'\e(B ?\e$(G#+\e(B ?\e$(G#/\e(B 32
+ 144 ?\e$(C"F\e(B 146 147 ?\e$B"#\e(B 149 ?\e$B"e\e(B ?\e$A!V\e(B ?\e$A!\\e(B ?\e$A!]\e(B ?\e.A\eN 32 ?\eN0 ?\eN2 ?\eN7 ?\eNw
+ ?\e$(G#D\e(B 32 32 ?\e.L\eNq 32 32 32 32 32 32 32 32 32 32 32 ?\e$(G#E\e(B
+ 32 32 ?\e$(G#G\e(B ?\e.L\eN! 32 32 32 32 32 32 32 32 ?\e$(G#F\e(B 32 32 ?\e.A\eN)
+ ?\e.L\eNn ?\eNP ?\eNQ ?\eNf ?\eNT ?\eNU ?\eNd ?\eNS ?\eNe ?\eNX ?\eNY ?\eNZ ?\eN[ ?\eN\ ?\eN] ?\eN^
+ ?\e.L\eN_ ?\eNo ?\eN` ?\eNa ?\eNb ?\eNc ?\eNV ?\eNR ?\eNl ?\eNk ?\eNW ?\eNh ?\eNm ?\eNi ?\eNg ?\eNj
+ ?\e.L\eNN ?\eN0 ?\eN1 ?\eNF ?\eN4 ?\eN5 ?\eND ?\eN3 ?\eNE ?\eN8 ?\eN9 ?\eN: ?\eN; ?\eN< ?\eN= ?\eN>
+ ?\e.L\eN? ?\eNO ?\eN@ ?\eNA ?\eNB ?\eNC ?\eN6 ?\eN2 ?\eNL ?\eNK ?\eN7 ?\eNH ?\eNM ?\eNI ?\eNG ?\eNJ ]
+ "Cyrillic KOI8-R decoding table.")
+
+(defvar cyrillic-koi8-r-encode-table
+ (let ((table (make-vector 256 32))
+ (i 0))
+ (while (< i 256)
+ (let* ((ch (aref cyrillic-koi8-r-decode-table i))
+ (split (split-char-or-char-int ch)))
+ (cond ((eq (car split) 'cyrillic-iso8859-5)
+ (aset table (logior (nth 1 split) 128) i)
+ )
+ ((eq ch 32))
+ ((eq (car split) 'ascii)
+ (aset table ch i)
+ )))
+ (setq i (1+ i)))
+ table)
+ "Cyrillic KOI8-R encoding table.")
+
+)
+
(define-ccl-program ccl-decode-koi8
- '(3
+ `(3
((read r0)
(loop
- (write-read-repeat
- r0
- [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
- 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
- 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
- 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
- 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
- 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
- 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
- 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
- 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
- 32 32 32 ?\e,Lq\e(B 32 32 32 32 32 32 32 32 32 32 32 32
- 32 32 32 ?\e,L!\e(B 32 32 32 32 32 32 32 32 32 32 32 32
- ?\e,Ln\e(B ?\e,LP\e(B ?\e,LQ\e(B ?\e,Lf\e(B ?\e,LT\e(B ?\e,LU\e(B ?\e,Ld\e(B ?\e,LS\e(B ?\e,Le\e(B ?\e,LX\e(B ?\e,LY\e(B ?\e,LZ\e(B ?\e,L[\e(B ?\e,L\\e(B ?\e,L]\e(B ?\e,L^\e(B
- ?\e,L_\e(B ?\e,Lo\e(B ?\e,L`\e(B ?\e,La\e(B ?\e,Lb\e(B ?\e,Lc\e(B ?\e,LV\e(B ?\e,LR\e(B ?\e,Ll\e(B ?\e,Lk\e(B ?\e,LW\e(B ?\e,Lh\e(B ?\e,Lm\e(B ?\e,Li\e(B ?\e,Lg\e(B ?\e,Lj\e(B
- ?\e,LN\e(B ?\e,L0\e(B ?\e,L1\e(B ?\e,LF\e(B ?\e,L4\e(B ?\e,L5\e(B ?\e,LD\e(B ?\e,L3\e(B ?\e,LE\e(B ?\e,L8\e(B ?\e,L9\e(B ?\e,L:\e(B ?\e,L;\e(B ?\e,L<\e(B ?\e,L=\e(B ?\e,L>\e(B
- ?\e,L?\e(B ?\e,LO\e(B ?\e,L@\e(B ?\e,LA\e(B ?\e,LB\e(B ?\e,LC\e(B ?\e,L6\e(B ?\e,L2\e(B ?\e,LL\e(B ?\e,LK\e(B ?\e,L7\e(B ?\e,LH\e(B ?\e,LM\e(B ?\e,LI\e(B ?\e,LG\e(B ?\e,LJ\e(B ]))))
+ (write-read-repeat r0 ,cyrillic-koi8-r-decode-table))))
"CCL program to decode KOI8.")
(define-ccl-program ccl-encode-koi8
`(1
((read r0)
(loop
- (if (r0 != ,(charset-id 'cyrillic-iso8859-5))
- (write-read-repeat r0)
- ((read r0)
- (r0 -= 160)
- (write-read-repeat
- r0
- [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32
- 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240
- 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241
- 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208
- 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209
- 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32])
- )))))
+ (if (r0 != ,(charset-id 'cyrillic-iso8859-5))
+ (write-read-repeat r0)
+ ((read r0)
+ (write-read-repeat r0 , cyrillic-koi8-r-encode-table))))))
"CCL program to encode KOI8.")
;(make-coding-system
(charset . (cyrillic-iso8859-5))
(coding-system . (koi8-r))
(tutorial . "TUTORIAL.ru")
- (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+ (sample-text . "Russian (\e.L\eN@\eNc\eNa\eNa\eNZ\eNX\eNY) \eN7\eNT\eN`\eNP\eNR\eNa\eNb\eNR\eNc\eNY\eNb\eNU!")
(documentation . ("Support for Cyrillic KOI-8."
. describe-cyrillic-environment-map))))
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
- ?\e,L0\e(B ?\e,L1\e(B ?\e,L2\e(B ?\e,L3\e(B ?\e,L4\e(B ?\e,L5\e(B ?\e,L6\e(B ?\e,L7\e(B ?\e,L8\e(B ?\e,L9\e(B ?\e,L:\e(B ?\e,L;\e(B ?\e,L<\e(B ?\e,L=\e(B ?\e,L>\e(B ?\e,L?\e(B
- ?\e,L@\e(B ?\e,LA\e(B ?\e,LB\e(B ?\e,LC\e(B ?\e,LD\e(B ?\e,LE\e(B ?\e,LF\e(B ?\e,LG\e(B ?\e,LH\e(B ?\e,LI\e(B ?\e,LJ\e(B ?\e,LK\e(B ?\e,LL\e(B ?\e,LM\e(B ?\e,LN\e(B ?\e,LO\e(B
- ?\e,LP\e(B ?\e,LQ\e(B ?\e,LR\e(B ?\e,LS\e(B ?\e,LT\e(B ?\e,LU\e(B ?\e,LV\e(B ?\e,LW\e(B ?\e,LX\e(B ?\e,LY\e(B ?\e,LZ\e(B ?\e,L[\e(B ?\e,L\\e(B ?\e,L]\e(B ?\e,L^\e(B ?\e,L_\e(B
+ ?\e.L\eN0 ?\eN1 ?\eN2 ?\eN3 ?\eN4 ?\eN5 ?\eN6 ?\eN7 ?\eN8 ?\eN9 ?\eN: ?\eN; ?\eN< ?\eN= ?\eN> ?\eN?
+ ?\e.L\eN@ ?\eNA ?\eNB ?\eNC ?\eND ?\eNE ?\eNF ?\eNG ?\eNH ?\eNI ?\eNJ ?\eNK ?\eNL ?\eNM ?\eNN ?\eNO
+ ?\e.L\eNP ?\eNQ ?\eNR ?\eNS ?\eNT ?\eNU ?\eNV ?\eNW ?\eNX ?\eNY ?\eNZ ?\eN[ ?\eN\ ?\eN] ?\eN^ ?\eN_
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
- ?\e,L`\e(B ?\e,La\e(B ?\e,Lb\e(B ?\e,Lc\e(B ?\e,Ld\e(B ?\e,Le\e(B ?\e,Lf\e(B ?\e,Lg\e(B ?\e,Lh\e(B ?\e,Li\e(B ?\e,Lj\e(B ?\e,Lk\e(B ?\e,Ll\e(B ?\e,Lm\e(B ?\e,Ln\e(B ?\e,Lo\e(B
- ?\e,L!\e(B ?\e,Lq\e(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?\e,Lp\e(B]))))
+ ?\e.L\eN` ?\eNa ?\eNb ?\eNc ?\eNd ?\eNe ?\eNf ?\eNg ?\eNh ?\eNi ?\eNj ?\eNk ?\eNl ?\eNm ?\eNn ?\eNo
+ ?\e.L\eN! ?\eNq 32 32 32 32 32 32 32 32 32 32 32 32 32 ?\eNp]))))
"CCL program to decode Alternativnyj.")
(define-ccl-program ccl-encode-alternativnyj
(charset . (cyrillic-iso8859-5))
(coding-system . (alternativnyj))
(tutorial . "TUTORIAL.ru")
- (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+ (sample-text . "Russian (\e.L\eN@\eNc\eNa\eNa\eNZ\eNX\eNY) \eN7\eNT\eN`\eNP\eNR\eNa\eNb\eNR\eNc\eNY\eNb\eNU!")
(documentation . ("Support for Cyrillic ALTERNATIVNYJ."
. describe-cyrillic-environment-map))))
(charset . (cyrillic-iso8859-5))
(tutorial . "TUTORIAL.ru")
(coding-system . (iso-8859-5 koi8-r alternativnyj))
- (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+ (sample-text . "Russian (\e.L\eN@\eNc\eNa\eNa\eNZ\eNX\eNY) \eN7\eNT\eN`\eNP\eNR\eNa\eNb\eNR\eNc\eNY\eNb\eNU!")
(documentation . nil)))
;;; cyrillic.el ends here
--- /dev/null
+;;; ethiopic.el --- Support for Ethiopic
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Ethiopic
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> for XEmacs.
+
+;;; Code:
+
+;; Ethiopic
+(make-charset 'ethiopic "Ethiopic"
+ '(registry "Ethio"
+ dimension 2
+ chars 94
+ final ?3
+ graphic 0
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ETHIOPIC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-category ?E "Ethiopic (Ge'ez) character.")
+(modify-category-entry 'ethiopic ?E)
+\f
+(define-ccl-program ccl-encode-ethio-font
+ '(0
+ ;; In: R0:ethiopic (not checked)
+ ;; R1:position code 1
+ ;; R2:position code 2
+ ;; Out: R1:font code point 1
+ ;; R2:font code point 2
+ ((r1 -= 33)
+ (r2 -= 33)
+ (r1 *= 94)
+ (r2 += r1)
+ (if (r2 < 256)
+ (r1 = ?\x12)
+ (if (r2 < 448)
+ ((r1 = ?\x13) (r2 -= 256))
+ ((r1 = ?\xfd) (r2 -= 208))
+ ))))
+ "CCL program to encode an Ethiopic code to code point of Ethiopic font.")
+
+;; (setq font-ccl-encoder-alist
+;; (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist))
+(set-charset-ccl-program 'ethiopic ccl-encode-ethio-font)
+
+(set-language-info-alist
+ "Ethiopic" '((setup-function . setup-ethiopic-environment-internal)
+ (exit-function . exit-ethiopic-environment)
+ (charset ethiopic)
+ (coding-system iso-2022-7bit)
+ (coding-priority iso-2022-7bit)
+ (input-method . "ethiopic")
+ (features ethio-util)
+ (sample-text . "\e$(3$Q#U!.\e(B")
+ (documentation . t)))
+
+;;; ethiopic.el ends here
--- /dev/null
+;;; mule-files.el --- File I/O functions for XEmacs/Mule.
+
+;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Amdahl Corporation.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Derived from mule.el in the original Mule but heavily modified
+;;; by Ben Wing. Mostly moved to code-files.el
+
+;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API.
+
+;;; Code:
+
+(setq-default buffer-file-coding-system 'iso-2022-8)
+
+;;; mule-files.el ends here
;; mule-misc.el --- Miscellaneous Mule functions.
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
;; Copyright (C) 1995 Amdahl Corporation.
(cons charset dest)
))))
+(defun split-char-or-char-int (char)
+ "Return list of charset and one or two position-codes of CHAR.
+CHAR must be character or integer."
+ (if (characterp char)
+ (split-char char)
+ (let ((c (int-char char)))
+ (if c
+ (split-char c)
+ (list 'ascii c)
+ ))))
+
;;; Commands
--- /dev/null
+;;; thai-xtis.el --- Thai support for pre-composed font (for XTIS).
+
+;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+;; MORIOKA Tomohiko <tomo@etl.go.jp>
+;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto
+;; 1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko
+
+;; Keywords: mule, multilingual, Thai, XTIS
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Thai, the pre-composed character set proposed by
+;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported.
+
+;;; Code:
+
+(when (featurep 'xemacs)
+ (make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)."
+ '(registry "xtis-0$"
+ dimension 2
+ chars 94
+ final ??
+ graphic 0))
+
+ (modify-syntax-entry 'thai-xtis "w")
+
+ (define-category ?T "Precomposed Thai character.")
+ (modify-category-entry 'thai-xtis ?T)
+ )
+
+
+(defvar leading-code-private-21 #x9F)
+
+(defconst thai-xtis-leading-code
+ (concat (char-to-string leading-code-private-21)
+ (char-to-string (charset-id 'thai-xtis))))
+
+(define-ccl-program ccl-thai-xtis-consonant
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0)
+ (r1 = r2))
+ (if (r1 == r2)
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0))
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0)
+ (r1 = r2))))))
+
+(define-ccl-program ccl-thai-xtis-vowel-d1
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0 r2))
+ (if (r1 == r2)
+ (r1 = ?\xb8)
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0 r2)
+ (r1 = 0))))))
+
+(define-ccl-program ccl-thai-xtis-vowel
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0 r2))
+ (if (r1 == r2)
+ (r1 = ((r0 - 188) << 3))
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0 r2)
+ (r1 = 0))))))
+
+(define-ccl-program ccl-thai-xtis-vowel-ee
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0 r2))
+ (if (r1 == r2)
+ (r1 = ?\xf8)
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0 r2)
+ (r1 = 0))))))
+
+(define-ccl-program ccl-thai-xtis-tone
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0 r2))
+ (if (r1 == r2)
+ ((r0 -= 54)
+ (write r0)
+ (r1 = 0))
+ ((r1 += (r0 - ?\xe6))
+ (write r1)
+ (r1 = 0))))))
+
+(define-ccl-program ccl-thai-xtis-symbol
+ `(0
+ (if (r1 == 0)
+ ((write ,thai-xtis-leading-code)
+ (write r0 r2))
+ (if (r1 == r2)
+ ((write r2)
+ (write ,thai-xtis-leading-code)
+ (write r0 r2)
+ (r1 = 0))
+ ((write r1)
+ (write ,thai-xtis-leading-code)
+ (write r0 r2)
+ (r1 = 0))))))
+
+(define-ccl-program ccl-decode-thai-xtis
+ `(4
+ ((read r0)
+ (r1 = 0)
+ (r2 = ?\xb0)
+ (loop
+ (if (r0 < 161)
+ (if (r1 == 0)
+ (write r0)
+ (if (r1 == r2)
+ ((write r2 r0)
+ (r1 = 0))
+ ((write r1 r0)
+ (r1 = 0))))
+ (branch (r0 - 161)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-consonant)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-vowel-d1)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ (call ccl-thai-xtis-vowel)
+ nil
+ nil
+ nil
+ nil
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-tone)
+ (call ccl-thai-xtis-vowel-ee)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ (call ccl-thai-xtis-symbol)
+ nil
+ nil
+ nil))
+ (read r0)
+ (repeat)))
+
+ (if (r1 != 0)
+ (write r1)
+ nil)))
+
+(define-ccl-program ccl-encode-thai-xtis
+ `(1
+ ((read r0)
+ (loop
+ (if (r0 == ,leading-code-private-21)
+ ((read r1)
+ (if (r1 == ,(charset-id 'thai-xtis))
+ ((read r0)
+ (write r0)
+ (read r0)
+ (r1 = (r0 & 7))
+ (r0 = ((r0 - ?\xb0) >> 3))
+ (if (r0 != 0)
+ (write r0 [0 209 212 213 214 215 216 217 218 238]))
+ (if (r1 != 0)
+ (write r1 [0 231 232 233 234 235 236 237]))
+ (read r0)
+ (repeat))
+ ((write r0 r1)
+ (read r0)
+ (repeat))))
+ (write-read-repeat r0))))))
+
+(if (featurep 'xemacs)
+ (make-coding-system
+ 'tis-620 'ccl
+ "external=tis620, internal=thai-xtis"
+ `(mnemonic "TIS620"
+ decode ,ccl-decode-thai-xtis
+ encode ,ccl-encode-thai-xtis))
+ (make-coding-system
+ 'tis-620 4 ?T "external=tis620, internal=thai-xtis"
+ '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
+ '((safe-charsets . t)))
+ )
+
+
+(set-language-info-alist
+ "Thai-XTIS"
+ '((setup-function . setup-thai-xtis-environment)
+ (exit-function . exit-thai-xtis-environment)
+ (charset thai-xtis)
+ (coding-system tis-620 iso-2022-7bit)
+ (coding-priority tis-620 iso-2022-7bit)
+ (sample-text . "\e$(?!:\e(B")
+ (documentation . t)))
+
+;; thai-xtis.el ends here.
--- /dev/null
+;;; vietnamese.el --- Support for Vietnamese
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Vietnamese
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Vietnames, the character sets VISCII and VSCII are supported.
+
+;;; Code:
+
+(eval-and-compile
+
+(defvar viet-viscii-decode-table
+ [;; VISCII is a full 8-bit code.
+ 0 1 ?\e.2\eNF 3 4 ?\eNG ?\eNg 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 ?\e.2\eNV 21 22 23 24 ?\eN[ 26 27 28 29 ?\eN\ 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ ?\e.2\eNU ?\eN! ?\eN" ?\eN# ?\eN$ ?\eN% ?\eN& ?\eN' ?\eN( ?\eN) ?\eN* ?\eN+ ?\eN, ?\eN- ?\eN. ?\eN/
+ ?\e.2\eN0 ?\eN1 ?\eN2 ?\eN5 ?\eN~ ?\eN> ?\eN6 ?\eN7 ?\eN8 ?\eNv ?\eNw ?\eNo ?\eN| ?\eN{ ?\eNx ?\eNO
+ ?\e.2\eNu ?\e.1\eN! ?\eN" ?\eN# ?\eN$ ?\eN% ?\eN& ?\eN' ?\eN( ?\eN) ?\eN* ?\eN+ ?\eN, ?\eN- ?\eN. ?\eN/
+ ?\e.1\eN0 ?\eN1 ?\eN2 ?\e.2\eN^ ?\eN= ?\e.1\eN5 ?\eN6 ?\eN7 ?\eN8 ?\e.2\eNq ?\eNQ ?\eNW ?\eNX ?\e.1\eN= ?\eN> ?\e.2\eN_
+ ?\e.2\eN` ?\eNa ?\eNb ?\eNc ?\eNd ?\eNe ?\e.1\eNF ?\eNG ?\e.2\eNh ?\eNi ?\eNj ?\eNk ?\eNl ?\eNm ?\eNn ?\e.1\eNO
+ ?\e.2\eNp ?\e.1\eNQ ?\e.2\eNr ?\eNs ?\eNt ?\e.1\eNU ?\eNV ?\eNW ?\eNX ?\e.2\eNy ?\eNz ?\e.1\eN[ ?\eN\ ?\e.2\eN} ?\e.1\eN^ ?\eN_
+ ?\e.1\eN` ?\eNa ?\eNb ?\eNc ?\eNd ?\eNe ?\eNf ?\eNg ?\eNh ?\eNi ?\eNj ?\eNk ?\eNl ?\eNm ?\eNn ?\eNo
+ ?\e.1\eNp ?\eNq ?\eNr ?\eNs ?\eNt ?\eNu ?\eNv ?\eNw ?\eNx ?\eNy ?\eNz ?\eN{ ?\eN| ?\eN} ?\eN~ ?\e.2\eNf ]
+ "Vietnamese VISCII decoding table.")
+
+(defvar viet-viscii-encode-table
+ (let ((table-lower (make-vector 128 0))
+ (table-upper (make-vector 128 0))
+ (i 0)
+ char-component)
+ (while (< i 256)
+ (setq char-component
+ (split-char-or-char-int (aref viet-viscii-decode-table i)))
+ (cond ((eq (car char-component) 'vietnamese-viscii-lower)
+ (aset table-lower (nth 1 char-component) i))
+ ((eq (car char-component) 'vietnamese-viscii-upper)
+ (aset table-upper (nth 1 char-component) i)))
+ (setq i (1+ i)))
+ (cons table-lower table-upper))
+ "Vietnamese VISCII encoding table.
+Cons of tables for encoding lower-case chars and upper-case characters.
+Both tables are indexed by the position code of Vietnamese characters.")
+
+(defvar viet-vscii-decode-table
+ [;; VSCII is a full 8-bit code.
+ 0 ?\e.2\eNz ?\eNx 3 ?\eNW ?\eNX ?\eNf 7 8 9 10 11 12 13 14 15
+ 16 ?\e.2\eNQ ?\eN_ ?\eNO ?\eNV ?\eN[ ?\eN} ?\eN\ 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ ?\e.2\eN` ?\eNd ?\eNc ?\eNa ?\eNU ?\eN# ?\eN' ?\eNh ?\eNk ?\eN( ?\eNi ?\eN) ?\eN. ?\eNl ?\eNo ?\eNn
+ ?\e.2\eNm ?\eN8 ?\eNr ?\eNv ?\eNu ?\eNs ?\eNw ?\eN5 ?\eN6 ?\eN7 ?\eN^ ?\eN> ?\eN~ ?\eNy ?\eN| ?\eN{
+ 160 ?\e.2\eNe ?\eNb ?\eNj ?\eNt ?\eN= ?\eN_ ?\eNp ?\e.1\eNe ?\eNb ?\eNj ?\eNt ?\eN> ?\eNy ?\eNp ?\e.2\eN"
+ 192 193 194 195 196 ?\e.1\eN` ?\eNd ?\eNc ?\eNa ?\eNU ?\e.2\eNF ?\e.1\eN" ?\eNF ?\eNG ?\eN! ?\e.2\eNG
+ ?\e.2\eN! ?\eN% ?\eN& ?\eNg ?\eN% ?\eN+ ?\e.1\eN# ?\eN% ?\eN& ?\eNg ?\eN$ ?\eN' ?\eNh ?\e.2\eN, ?\e.1\eNk ?\eN(
+ ?\e.1\eNi ?\eN) ?\eN+ ?\eN, ?\eN- ?\eN* ?\eN. ?\eNl ?\eNo ?\e.2\eN- ?\eN* ?\eN0 ?\e.1\eNn ?\eNm ?\eN8 ?\eNr
+ ?\e.2\eN1 ?\e.1\eNv ?\eNu ?\eNs ?\eNw ?\eN0 ?\eN1 ?\eN2 ?\eN/ ?\eN5 ?\eN6 ?\eN7 ?\eN^ ?\eN> ?\eN~ ?\eNy
+ ?\e.2\eN2 ?\e.1\eN| ?\eN{ ?\eNz ?\eNx ?\eNW ?\eNX ?\eNf ?\eNQ ?\eNq ?\eNO ?\eNV ?\eN[ ?\eN} ?\eN\ ?\e.2\eN/]
+ "Vietnamese VSCII decoding table.")
+
+(defvar viet-vscii-encode-table
+ (let ((table-lower (make-vector 128 0))
+ (table-upper (make-vector 128 0))
+ (i 0)
+ char-component)
+ (while (< i 256)
+ (setq char-component
+ (split-char-or-char-int (aref viet-vscii-decode-table i)))
+ (cond ((eq (car char-component) 'vietnamese-viscii-lower)
+ (aset table-lower (nth 1 char-component) i))
+ ((eq (car char-component) 'vietnamese-viscii-upper)
+ (aset table-upper (nth 1 char-component) i)))
+ (setq i (1+ i)))
+ (cons table-lower table-upper))
+ "Vietnamese VSCII encoding table.
+Cons of tables for encoding lower-case chars and upper-case characters.
+Both tables are indexed by the position code of Vietnamese characters.")
+
+)
+
+(define-ccl-program ccl-decode-viscii
+ `(3
+ ((read r0)
+ (loop
+ (write-read-repeat r0 ,viet-viscii-decode-table))
+ ))
+ "CCL program to decode VISCII 1.1")
+
+;; Multibyte form of a Vietnamese character is as follows (3-byte):
+;; LEADING-CODE-PRIVATE-11 LEADING-CODE-EXTENDED-11 POSITION-CODE
+;; where LEADING-CODE-EXTENDED-11 for Vietnamese is
+;; `vietnamese-viscii-lower' or `vietnamese-viscii-upper'.
+
+(defvar leading-code-private-11 #x9E)
+
+(define-ccl-program ccl-encode-viscii
+ `(1
+ ((read r0)
+ (loop
+ (if (r0 < 128)
+ ;; ASCII
+ (write-read-repeat r0)
+ ;; not ASCII
+ (if (r0 != ,leading-code-private-11)
+ ;; not Vietnamese
+ (write-read-repeat r0)
+ ((read-if (r0 == ,(charset-id 'vietnamese-viscii-lower))
+ (;; Vietnamese lower
+ (read r0)
+ (r0 -= 128)
+ (write-read-repeat r0 ,(car viet-viscii-encode-table)))
+ (if (r0 == ,(charset-id 'vietnamese-viscii-upper))
+ (;; Vietnamese upper
+ (read r0)
+ (r0 -= 128)
+ (write-read-repeat r0 ,(cdr viet-viscii-encode-table)))
+ ;; not Vietnamese
+ (write-read-repeat r0)))))))))
+ "CCL program to encode VISCII 1.1")
+
+(define-ccl-program ccl-encode-viscii-font
+ `(0
+ ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
+ ;; R1:position code
+ ;; Out: R1:font code point
+ (if (r0 == ,(charset-id 'vietnamese-viscii-lower))
+ (r1 = r1 ,(car viet-viscii-encode-table))
+ (r1 = r1 ,(cdr viet-viscii-encode-table)))
+ )
+ "CCL program to encode Vietnamese chars to VISCII 1.1 font")
+
+(define-ccl-program ccl-decode-vscii
+ `(3
+ ((read r0)
+ (loop
+ (write-read-repeat r0 ,viet-vscii-decode-table))
+ ))
+ "CCL program to decode VSCII-1.")
+
+(define-ccl-program ccl-encode-vscii
+ `(1
+ ((read r0)
+ (loop
+ (if (r0 < 128)
+ ;; ASCII
+ (write-read-repeat r0)
+ ;; not ASCII
+ (if (r0 != ,leading-code-private-11)
+ ;; not Vietnamese
+ (write-read-repeat r0)
+ (read-if (r0 == ,(charset-id 'vietnamese-viscii-lower))
+ (;; Vietnamese lower
+ (read r0)
+ (r0 -= 128)
+ (write-read-repeat r0 ,(car viet-vscii-encode-table)))
+ (if (r0 == ,(charset-id 'vietnamese-viscii-upper))
+ (;; Vietnamese upper
+ (read r0)
+ (r0 -= 128)
+ (write-read-repeat r0 ,(cdr viet-viscii-encode-table)))
+ ;; not Vietnamese
+ (write-read-repeat r0))))))))
+ "CCL program to encode VSCII-1.")
+
+(define-ccl-program ccl-encode-vscii-font
+ `(0
+ ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
+ ;; R1:position code
+ ;; Out: R1:font code point
+ (if (r0 == ,(charset-id 'vietnamese-viscii-lower))
+ (r1 = r1 ,(car viet-vscii-encode-table))
+ (r1 = r1 ,(cdr viet-vscii-encode-table)))
+ )
+ "CCL program to encode Vietnamese chars to VSCII-1 font.")
+
+
+(make-coding-system
+ 'viscii 'ccl
+ "Coding-system used for VISCII 1.1."
+ `(mnemonic "VISCII"
+ decode ,ccl-decode-viscii
+ encode ,ccl-encode-viscii))
+
+;; (make-coding-system
+;; 'vietnamese-viscii 4 ?V
+;; "8-bit encoding for Vietnamese VISCII 1.1 (MIME:VISCII)"
+;; (cons ccl-decode-viscii ccl-encode-viscii))
+
+;; (define-coding-system-alias 'viscii 'vietnamese-viscii)
+
+(make-coding-system
+ 'vscii 'ccl
+ "Coding-system used for VSCII 1.1."
+ `(mnemonic "VSCII"
+ decode ,ccl-decode-vscii
+ encode ,ccl-encode-vscii))
+
+;; (make-coding-system
+;; 'vietnamese-vscii 4 ?v
+;; "8-bit encoding for Vietnamese VSCII-1"
+;; (cons ccl-decode-vscii ccl-encode-vscii))
+
+;; (define-coding-system-alias 'vscii 'vietnamese-vscii)
+
+(make-coding-system
+ 'viqr 'no-conversion
+ "Coding-system used for VIQR."
+ '(mnemonic "VIQR"
+ eol-type lf
+ post-read-conversion viqr-post-read-conversion
+ pre-write-conversion viqr-pre-write-conversion))
+
+;; (make-coding-system
+;; 'vietnamese-viqr 0 ?q
+;; "Vietnamese latin transcription (VIQR)"
+;; nil)
+;; (put 'vietnamese-viqr 'post-read-conversion 'viqr-post-read-conversion)
+;; (put 'vietnamese-viqr 'pre-write-conversion 'viqr-pre-write-conversion)
+
+;; (define-coding-system-alias 'viqr 'vietnamese-viqr)
+
+;; For VISCII users
+(set-charset-ccl-program 'vietnamese-viscii-lower
+ ccl-encode-viscii-font)
+(set-charset-ccl-program 'vietnamese-viscii-upper
+ ccl-encode-viscii-font)
+;; For VSCII users
+(set-charset-ccl-program 'vietnamese-viscii-lower ccl-encode-vscii-font)
+(set-charset-ccl-program 'vietnamese-viscii-upper ccl-encode-vscii-font)
+
+;; (setq font-ccl-encoder-alist
+;; (cons (cons "viscii" ccl-encode-viscii-font) font-ccl-encoder-alist))
+
+;; (setq font-ccl-encoder-alist
+;; (cons (cons "vscii" ccl-encode-vscii-font) font-ccl-encoder-alist))
+
+(set-language-info-alist
+ "Vietnamese" '((setup-function . setup-vietnamese-environment)
+ (charset . (vietnamese-viscii-lower
+ vietnamese-viscii-upper))
+ (coding-system . (viscii vscii viqr))
+ (sample-text . "Vietnamese (Ti\e.1\eN*ng Vi\eN.t) Ch\eN`o b\eNUn")
+ (documentation . "\
+For Vietnamese, Emacs uses special charasets internally.
+They can be decoded from and encoded to VISCC, VSCII, and VIQR.")
+ ))
+
+;;; vietnamese.el ends here
--- /dev/null
+;;; winnt.el --- Lisp routines for Windows NT.
+
+;; Copyright (C) 1994 Free Software Foundation, Inc.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: mouse, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched with FSF. Almost completely divergent.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs for MS Windows (without cygwin).
+
+;; Based on NT Emacs version by Geoff Voelker (voelker@cs.washington.edu)
+;; Ported to XEmacs by Marc Paquette <marcpa@cam.org>
+;; Largely modified by Kirill M. Katsnelson <kkm@kis.ru>
+
+;;; Code:
+
+;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
+;; for executing its command line argument (from simple.el).
+;; #### Oh if we had an alist of shells and their command switches.
+(setq shell-command-switch "/c")
+
+;; For appending suffixes to directories and files in shell completions.
+(defun nt-shell-mode-hook ()
+ (setq comint-completion-addsuffix '("\\" . " ")
+ comint-process-echoes t))
+(add-hook 'shell-mode-hook 'nt-shell-mode-hook)
+
+;; Use ";" instead of ":" as a path separator (from files.el).
+(setq path-separator ";")
+
+;; Set the null device (for compile.el).
+;; #### There should be such a global thingy as null-device - kkm
+(setq grep-null-device "NUL")
+
+;; Set the grep regexp to match entries with drive letters.
+(setq grep-regexp-alist
+ '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
+
+;;----------------------------------------------------------------------
+;; Autosave hack
+;;--------------------
+
+;; Avoid creating auto-save file names containing invalid characters
+;; (primarily "*", eg. for the *mail* buffer).
+;; Avoid "doc lost for function" warning
+(defun original-make-auto-save-file-name (&optional junk)
+ "You do not want to call this."
+ )
+(fset 'original-make-auto-save-file-name
+ (symbol-function 'make-auto-save-file-name))
+
+(defun make-auto-save-file-name ()
+ "Return file name to use for auto-saves of current buffer.
+Does not consider `auto-save-visited-file-name' as that variable is checked
+before calling this function. You can redefine this for customization.
+See also `auto-save-file-name-p'."
+ (let ((name (original-make-auto-save-file-name))
+ (start 0))
+ ;; destructively replace occurrences of * or ? with $
+ (while (string-match "[?*]" name start)
+ (aset name (match-beginning 0) ?$)
+ (setq start (1+ (match-end 0))))
+ name))
+
+;;----------------------------------------------------------------------
+;; Quoting process args
+;;--------------------
+
+(defun nt-quote-args-verbatim (args)
+ "Copy ARG list verbatim, separating each arg with space."
+ (mapconcat #'identity args " "))
+
+(defun nt-quote-args-prefix-quote (prefix args)
+ (mapconcat (lambda (str)
+ (concat "\""
+ (mapconcat (lambda (ch)
+ (concat (if (eq ch ?\") prefix)
+ (char-to-string ch)))
+ str nil)
+ "\""))
+ args " "))
+
+(defun nt-quote-args-backslash-quote (args)
+ "Place ARG list in quotes, prefixing quotes in args with backslashes."
+ (nt-quote-args-prefix-quote "\\" args))
+
+(defun nt-quote-args-double-quote (args)
+ "Place ARG list in quotes, doubling quotes in args."
+ (nt-quote-args-prefix-quote "\"" args))
+
+(defvar nt-quote-args-functions-alist
+ '(("^.?.?sh\\." . nt-quote-args-double-quote))
+ "An alist for determining proper argument quoting given executable file name.
+Car of each cons must be a string, a regexp against which a file name sans
+directory is matched. Cdr is a function symbol. The list is mathced in
+forward order, and mathcing entry cdr's funcrion is called with a list of
+strings, process arguments. It must return a string which is passed to
+the newly created process.
+
+If not found, then `nt-quote-args-verbatim' is called on the argument list.")
+
+(defun nt-quote-process-args (args)
+ ;;Properly quote process ARGS for executing (car ARGS).
+ (let ((fname (file-name-nondirectory (car args)))
+ (alist nt-quote-args-functions-alist)
+ (case-fold-search nil)
+ (return-me nil)
+ (assoc nil))
+ (while (and alist
+ (null return-me))
+ (setq assoc (pop alist))
+ (if (string-match (car assoc) fname)
+ (setq return-me (funcall (cdr assoc) (cdr args)))))
+ (or return-me
+ (nt-quote-args-verbatim (cdr args)))))
+
+;;; winnt.el ends here
--- /dev/null
+Dummy file to keep CVS happy.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+@comment %**start of header
+@setfilename ../info/info-stnd.info
+@settitle GNU Info
+@set InfoProgVer 2.11
+@paragraphindent none
+@footnotestyle end
+@synindex vr cp
+@synindex fn cp
+@synindex ky cp
+@comment %**end of header
+@comment $Id: info-stnd.texi,v 1.3 1997/07/06 21:49:30 karl Exp $
+
+@dircategory Texinfo documentation system
+@direntry
+* info program: (info-stnd). Standalone Info-reading program.
+@end direntry
+
+@ifinfo
+This file documents GNU Info, a program for viewing the on-line formatted
+versions of Texinfo files. This documentation is different from the
+documentation for the Info reader that is part of GNU Emacs. If you do
+not know how to use Info, but have a working Info reader, you should
+read that documentation first.
+
+Copyright @copyright{} 1992, 93, 96, 97 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries a copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+@end ignore
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``Copying'' and ``GNU General Public License'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title GNU Info User's Guide
+@subtitle For GNU Info version @value{InfoProgVer}
+@author Brian J. Fox (bfox@@ai.mit.edu)
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1992, 1993, 1997 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``Copying'' and ``GNU General Public License'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end titlepage
+
+@ifinfo
+@node Top, What is Info, , (dir)
+@top The GNU Info Program
+
+This file documents GNU Info, a program for viewing the on-line
+formatted versions of Texinfo files, version @value{InfoProgVer}. This
+documentation is different from the documentation for the Info reader
+that is part of GNU Emacs.
+@end ifinfo
+
+@menu
+* What is Info::
+* Options:: Options you can pass on the command line.
+* Cursor Commands:: Commands which move the cursor within a node.
+* Scrolling Commands:: Commands for moving the node around
+ in a window.
+* Node Commands:: Commands for selecting a new node.
+* Searching Commands:: Commands for searching an Info file.
+* Xref Commands:: Commands for selecting cross references.
+* Window Commands:: Commands which manipulate multiple windows.
+* Printing Nodes:: How to print out the contents of a node.
+* Miscellaneous Commands:: A few commands that defy categories.
+* Variables:: How to change the default behavior of Info.
+* GNU Info Global Index:: Global index containing keystrokes,
+ command names, variable names,
+ and general concepts.
+@end menu
+
+@node What is Info, Options, Top, Top
+@chapter What is Info?
+
+@iftex
+This file documents GNU Info, a program for viewing the on-line formatted
+versions of Texinfo files, version @value{InfoProgVer}.
+@end iftex
+
+@dfn{Info} is a program which is used to view Info files on an ASCII
+terminal. @dfn{Info files} are the result of processing Texinfo files
+with the program @code{makeinfo} or with one of the Emacs commands, such
+as @code{M-x texinfo-format-buffer}. Texinfo itself is a documentation
+system that uses a single source file to produce both on-line
+information and printed output. You can typeset and print the
+files that you read in Info.@refill
+
+@node Options, Cursor Commands, What is Info, Top
+@chapter Command Line Options
+@cindex command line options
+@cindex arguments, command line
+
+GNU Info accepts several options to control the initial node being
+viewed, and to specify which directories to search for Info files. Here
+is a template showing an invocation of GNU Info from the shell:
+
+@example
+info [--@var{option-name} @var{option-value}] @var{menu-item}@dots{}
+@end example
+
+The following @var{option-names} are available when invoking Info from
+the shell:
+
+@table @code
+@cindex directory path
+@item --directory @var{directory-path}
+@itemx -d @var{directory-path}
+Add @var{directory-path} to the list of directory paths searched when
+Info needs to find a file. You may issue @code{--directory} multiple
+times; once for each directory which contains Info files.
+Alternatively, you may specify a value for the environment variable
+@code{INFOPATH}; if @code{--directory} is not given, the value of
+@code{INFOPATH} is used. The value of @code{INFOPATH} is a colon
+separated list of directory names. If you do not supply @code{INFOPATH}
+or @code{--directory-path}, Info uses a default path.
+
+@item --file @var{filename}
+@itemx -f @var{filename}
+@cindex Info file, selecting
+Specify a particular Info file to visit. By default, Info visits
+the file @code{dir}; if you use this option, Info will start with
+@code{(@var{filename})Top} as the first file and node.
+
+@item --index-search @var{string}
+@cindex index search, selecting
+@cindex online help, using Info as
+Go to the index entry @var{string} in the Info file specified with
+@samp{--file}. If no such entry, print @samp{no entries found} and exit
+with nonzero status. This can used from another program as a way to
+provide online help.
+
+@item --node @var{nodename}
+@itemx -n @var{nodename}
+@cindex node, selecting
+Specify a particular node to visit in the initial file that Info
+loads. This is especially useful in conjunction with
+@code{--file}@footnote{Of course, you can specify both the file and node
+in a @code{--node} command; but don't forget to escape the open and
+close parentheses from the shell as in: @code{info --node
+"(emacs)Buffers"}}. You may specify @code{--node} multiple times; for
+an interactive Info, each @var{nodename} is visited in its own window,
+for a non-interactive Info (such as when @code{--output} is given) each
+@var{nodename} is processed sequentially.
+
+@item --output @var{filename}
+@itemx -o @var{filename}
+@cindex file, outputting to
+@cindex outputting to a file
+Specify @var{filename} as the name of a file to which to direct output.
+Each node that Info visits will be output to @var{filename} instead of
+interactively viewed. A value of @code{-} for @var{filename} specifies
+the standard output.
+
+@item --subnodes
+@cindex @code{--subnodes}, command line option
+This option only has meaning when given in conjunction with
+@code{--output}. It means to recursively output the nodes appearing in
+the menus of each node being output. Menu items which resolve to
+external Info files are not output, and neither are menu items which are
+members of an index. Each node is only output once.
+
+@item --help
+@itemx -h
+Produces a relatively brief description of the available Info options.
+
+@item --version
+@cindex version information
+Prints the version information of Info and exits.
+
+@item @var{menu-item}
+@cindex menu, following
+Info treats its remaining arguments as the names of menu items. The
+first argument is a menu item in the initial node visited, while
+the second argument is a menu item in the first argument's node.
+You can easily move to the node of your choice by specifying the menu
+names which describe the path to that node. For example,
+
+@example
+info emacs buffers
+@end example
+
+@noindent
+first selects the menu item @samp{Emacs} in the node @samp{(dir)Top},
+and then selects the menu item @samp{Buffers} in the node
+@samp{(emacs)Top}.
+@end table
+
+@node Cursor Commands, Scrolling Commands, Options, Top
+@chapter Moving the Cursor
+@cindex cursor, moving
+
+Many people find that reading screens of text page by page is made
+easier when one is able to indicate particular pieces of text with some
+kind of pointing device. Since this is the case, GNU Info (both the
+Emacs and standalone versions) have several commands which allow you to
+move the cursor about the screen. The notation used in this manual to
+describe keystrokes is identical to the notation used within the Emacs
+manual, and the GNU Readline manual. @xref{Characters, , Character
+Conventions, emacs, the GNU Emacs Manual}, if you are unfamiliar with the
+notation.
+
+The following table lists the basic cursor movement commands in Info.
+Each entry consists of the key sequence you should type to execute the
+cursor movement, the @code{M-x}@footnote{@code{M-x} is also a command; it
+invokes @code{execute-extended-command}. @xref{M-x, , Executing an
+extended command, emacs, the GNU Emacs Manual}, for more detailed
+information.} command name (displayed in parentheses), and a short
+description of what the command does. All of the cursor motion commands
+can take an @dfn{numeric} argument (@pxref{Miscellaneous Commands,
+@code{universal-argument}}), to find out how to supply them. With a
+numeric argument, the motion commands are simply executed that
+many times; for example, a numeric argument of 4 given to
+@code{next-line} causes the cursor to move down 4 lines. With a
+negative numeric argument, the motion is reversed; an argument of -4
+given to the @code{next-line} command would cause the cursor to move
+@emph{up} 4 lines.
+
+@table @asis
+@item @code{C-n} (@code{next-line})
+@kindex C-n
+@findex next-line
+Move the cursor down to the next line.
+
+@item @code{C-p} (@code{prev-line})
+@kindex C-p
+@findex prev-line
+Move the cursor up to the previous line.
+
+@item @code{C-a} (@code{beginning-of-line})
+@kindex C-a, in Info windows
+@findex beginning-of-line
+Move the cursor to the start of the current line.
+
+@item @code{C-e} (@code{end-of-line})
+@kindex C-e, in Info windows
+@findex end-of-line
+Move the cursor to the end of the current line.
+
+@item @code{C-f} (@code{forward-char})
+@kindex C-f, in Info windows
+@findex forward-char
+Move the cursor forward a character.
+
+@item @code{C-b} (@code{backward-char})
+@kindex C-b, in Info windows
+@findex backward-char
+Move the cursor backward a character.
+
+@item @code{M-f} (@code{forward-word})
+@kindex M-f, in Info windows
+@findex forward-word
+Move the cursor forward a word.
+
+@item @code{M-b} (@code{backward-word})
+@kindex M-b, in Info windows
+@findex backward-word
+Move the cursor backward a word.
+
+@item @code{M-<} (@code{beginning-of-node})
+@itemx @code{b}
+@kindex b, in Info windows
+@kindex M-<
+@findex beginning-of-node
+Move the cursor to the start of the current node.
+
+@item @code{M->} (@code{end-of-node})
+@kindex M->
+@findex end-of-node
+Move the cursor to the end of the current node.
+
+@item @code{M-r} (@code{move-to-window-line})
+@kindex M-r
+@findex move-to-window-line
+Move the cursor to a specific line of the window. Without a numeric
+argument, @code{M-r} moves the cursor to the start of the line in the
+center of the window. With a numeric argument of @var{n}, @code{M-r}
+moves the cursor to the start of the @var{n}th line in the window.
+@end table
+
+@node Scrolling Commands, Node Commands, Cursor Commands, Top
+@chapter Moving Text Within a Window
+@cindex scrolling
+
+Sometimes you are looking at a screenful of text, and only part of the
+current paragraph you are reading is visible on the screen. The
+commands detailed in this section are used to shift which part of the
+current node is visible on the screen.
+
+@table @asis
+@item @code{SPC} (@code{scroll-forward})
+@itemx @code{C-v}
+@kindex SPC, in Info windows
+@kindex C-v
+@findex scroll-forward
+Shift the text in this window up. That is, show more of the node which
+is currently below the bottom of the window. With a numeric argument,
+show that many more lines at the bottom of the window; a numeric
+argument of 4 would shift all of the text in the window up 4 lines
+(discarding the top 4 lines), and show you four new lines at the bottom
+of the window. Without a numeric argument, @key{SPC} takes the bottom
+two lines of the window and places them at the top of the window,
+redisplaying almost a completely new screenful of lines.
+
+@item @code{DEL} (@code{scroll-backward})
+@itemx @code{M-v}
+@kindex DEL, in Info windows
+@kindex M-v
+@findex scroll-backward
+Shift the text in this window down. The inverse of
+@code{scroll-forward}.
+@end table
+
+@cindex scrolling through node structure
+The @code{scroll-forward} and @code{scroll-backward} commands can also
+move forward and backward through the node structure of the file. If
+you press @key{SPC} while viewing the end of a node, or @key{DEL} while
+viewing the beginning of a node, what happens is controlled by the
+variable @code{scroll-behavior}. @xref{Variables,
+@code{scroll-behavior}}, for more information.
+
+@table @asis
+@item @code{C-l} (@code{redraw-display})
+@kindex C-l
+@findex redraw-display
+Redraw the display from scratch, or shift the line containing the cursor
+to a specified location. With no numeric argument, @samp{C-l} clears
+the screen, and then redraws its entire contents. Given a numeric
+argument of @var{n}, the line containing the cursor is shifted so that
+it is on the @var{n}th line of the window.
+
+@item @code{C-x w} (@code{toggle-wrap})
+@kindex C-w
+@findex toggle-wrap
+Toggles the state of line wrapping in the current window. Normally,
+lines which are longer than the screen width @dfn{wrap}, i.e., they are
+continued on the next line. Lines which wrap have a @samp{\} appearing
+in the rightmost column of the screen. You can cause such lines to be
+terminated at the rightmost column by changing the state of line
+wrapping in the window with @code{C-x w}. When a line which needs more
+space than one screen width to display is displayed, a @samp{$} appears
+in the rightmost column of the screen, and the remainder of the line is
+invisible.
+@end table
+
+@node Node Commands, Searching Commands, Scrolling Commands, Top
+@chapter Selecting a New Node
+@cindex nodes, selection of
+
+This section details the numerous Info commands which select a new node
+to view in the current window.
+
+The most basic node commands are @samp{n}, @samp{p}, @samp{u}, and
+@samp{l}.
+
+When you are viewing a node, the top line of the node contains some Info
+@dfn{pointers} which describe where the next, previous, and up nodes
+are. Info uses this line to move about the node structure of the file
+when you use the following commands:
+
+@table @asis
+@item @code{n} (@code{next-node})
+@kindex n
+@findex next-node
+Select the `Next' node.
+
+@item @code{p} (@code{prev-node})
+@kindex p
+@findex prev-node
+Select the `Prev' node.
+
+@item @code{u} (@code{up-node})
+@kindex u
+@findex up-node
+Select the `Up' node.
+@end table
+
+You can easily select a node that you have already viewed in this window
+by using the @samp{l} command -- this name stands for "last", and
+actually moves through the list of already visited nodes for this
+window. @samp{l} with a negative numeric argument moves forward through
+the history of nodes for this window, so you can quickly step between
+two adjacent (in viewing history) nodes.
+
+@table @asis
+@item @code{l} (@code{history-node})
+@kindex l
+@findex history-node
+Select the most recently selected node in this window.
+@end table
+
+Two additional commands make it easy to select the most commonly
+selected nodes; they are @samp{t} and @samp{d}.
+
+@table @asis
+@item @code{t} (@code{top-node})
+@kindex t
+@findex top-node
+Select the node @samp{Top} in the current Info file.
+
+@item @code{d} (@code{dir-node})
+@kindex d
+@findex dir-node
+Select the directory node (i.e., the node @samp{(dir)}).
+@end table
+
+Here are some other commands which immediately result in the selection
+of a different node in the current window:
+
+@table @asis
+@item @code{<} (@code{first-node})
+@kindex <
+@findex first-node
+Selects the first node which appears in this file. This node is most
+often @samp{Top}, but it does not have to be.
+
+@item @code{>} (@code{last-node})
+@kindex >
+@findex last-node
+Select the last node which appears in this file.
+
+@item @code{]} (@code{global-next-node})
+@kindex ]
+@findex global-next-node
+Move forward or down through node structure. If the node that you are
+currently viewing has a @samp{Next} pointer, that node is selected.
+Otherwise, if this node has a menu, the first menu item is selected. If
+there is no @samp{Next} and no menu, the same process is tried with the
+@samp{Up} node of this node.
+
+@item @code{[} (@code{global-prev-node})
+@kindex [
+@findex global-prev-node
+Move backward or up through node structure. If the node that you are
+currently viewing has a @samp{Prev} pointer, that node is selected.
+Otherwise, if the node has an @samp{Up} pointer, that node is selected,
+and if it has a menu, the last item in the menu is selected.
+@end table
+
+You can get the same behavior as @code{global-next-node} and
+@code{global-prev-node} while simply scrolling through the file with
+@key{SPC} and @key{DEL}; @xref{Variables, @code{scroll-behavior}}, for
+more information.
+
+@table @asis
+@item @code{g} (@code{goto-node})
+@kindex g
+@findex goto-node
+Read the name of a node and select it. No completion is done while
+reading the node name, since the desired node may reside in a separate
+file. The node must be typed exactly as it appears in the Info file. A
+file name may be included as with any node specification, for example
+
+@example
+@code{g(emacs)Buffers}
+@end example
+
+finds the node @samp{Buffers} in the Info file @file{emacs}.
+
+@item @code{C-x k} (@code{kill-node})
+@kindex C-x k
+@findex kill-node
+Kill a node. The node name is prompted for in the echo area, with a
+default of the current node. @dfn{Killing} a node means that Info tries
+hard to forget about it, removing it from the list of history nodes kept
+for the window where that node is found. Another node is selected in
+the window which contained the killed node.
+
+@item @code{C-x C-f} (@code{view-file})
+@kindex C-x C-f
+@findex view-file
+Read the name of a file and selects the entire file. The command
+@example
+@code{C-x C-f @var{filename}}
+@end example
+is equivalent to typing
+@example
+@code{g(@var{filename})*}
+@end example
+
+@item @code{C-x C-b} (@code{list-visited-nodes})
+@kindex C-x C-b
+@findex list-visited-nodes
+Make a window containing a menu of all of the currently visited nodes.
+This window becomes the selected window, and you may use the standard
+Info commands within it.
+
+@item @code{C-x b} (@code{select-visited-node})
+@kindex C-x b
+@findex select-visited-node
+Select a node which has been previously visited in a visible window.
+This is similar to @samp{C-x C-b} followed by @samp{m}, but no window is
+created.
+@end table
+
+@node Searching Commands, Xref Commands, Node Commands, Top
+@chapter Searching an Info File
+@cindex searching
+
+GNU Info allows you to search for a sequence of characters throughout an
+entire Info file, search through the indices of an Info file, or find
+areas within an Info file which discuss a particular topic.
+
+@table @asis
+@item @code{s} (@code{search})
+@kindex s
+@findex search
+Read a string in the echo area and search for it.
+
+@item @code{C-s} (@code{isearch-forward})
+@kindex C-s
+@findex isearch-forward
+Interactively search forward through the Info file for a string as you
+type it.
+
+@item @code{C-r} (@code{isearch-backward})
+@kindex C-r
+@findex isearch-backward
+Interactively search backward through the Info file for a string as
+you type it.
+
+@item @code{i} (@code{index-search})
+@kindex i
+@findex index-search
+Look up a string in the indices for this Info file, and select a node
+where the found index entry points to.
+
+@item @code{,} (@code{next-index-match})
+@kindex ,
+@findex next-index-match
+Move to the node containing the next matching index item from the last
+@samp{i} command.
+@end table
+
+The most basic searching command is @samp{s} (@code{search}). The
+@samp{s} command prompts you for a string in the echo area, and then
+searches the remainder of the Info file for an occurrence of that string.
+If the string is found, the node containing it is selected, and the
+cursor is left positioned at the start of the found string. Subsequent
+@samp{s} commands show you the default search string within @samp{[} and
+@samp{]}; pressing @key{RET} instead of typing a new string will use the
+default search string.
+
+@dfn{Incremental searching} is similar to basic searching, but the
+string is looked up while you are typing it, instead of waiting until
+the entire search string has been specified.
+
+@node Xref Commands, Window Commands, Searching Commands, Top
+@chapter Selecting Cross References
+
+We have already discussed the @samp{Next}, @samp{Prev}, and @samp{Up}
+pointers which appear at the top of a node. In addition to these
+pointers, a node may contain other pointers which refer you to a
+different node, perhaps in another Info file. Such pointers are called
+@dfn{cross references}, or @dfn{xrefs} for short.
+
+@menu
+* Parts of an Xref:: What a cross reference is made of.
+* Selecting Xrefs:: Commands for selecting menu or note items.
+@end menu
+
+@node Parts of an Xref, Selecting Xrefs, , Xref Commands
+@section Parts of an Xref
+
+Cross references have two major parts: the first part is called the
+@dfn{label}; it is the name that you can use to refer to the cross
+reference, and the second is the @dfn{target}; it is the full name of
+the node that the cross reference points to.
+
+The target is separated from the label by a colon @samp{:}; first the
+label appears, and then the target. For example, in the sample menu
+cross reference below, the single colon separates the label from the
+target.
+
+@example
+* Foo Label: Foo Target. More information about Foo.
+@end example
+
+Note the @samp{.} which ends the name of the target. The @samp{.} is
+not part of the target; it serves only to let Info know where the target
+name ends.
+
+A shorthand way of specifying references allows two adjacent colons to
+stand for a target name which is the same as the label name:
+
+@example
+* Foo Commands:: Commands pertaining to Foo.
+@end example
+
+In the above example, the name of the target is the same as the name of
+the label, in this case @code{Foo Commands}.
+
+You will normally see two types of cross reference while viewing nodes:
+@dfn{menu} references, and @dfn{note} references. Menu references
+appear within a node's menu; they begin with a @samp{*} at the beginning
+of a line, and continue with a label, a target, and a comment which
+describes what the contents of the node pointed to contains.
+
+Note references appear within the body of the node text; they begin with
+@code{*Note}, and continue with a label and a target.
+
+Like @samp{Next}, @samp{Prev}, and @samp{Up} pointers, cross references
+can point to any valid node. They are used to refer you to a place
+where more detailed information can be found on a particular subject.
+Here is a cross reference which points to a node within the Texinfo
+documentation: @xref{xref, , Writing an Xref, texinfo, the Texinfo
+Manual}, for more information on creating your own texinfo cross
+references.
+
+@node Selecting Xrefs, , Parts of an Xref, Xref Commands
+@section Selecting Xrefs
+
+The following table lists the Info commands which operate on menu items.
+
+@table @asis
+@item @code{1} (@code{menu-digit})
+@itemx @code{2} @dots{} @code{9}
+@cindex 1 @dots{} 9, in Info windows
+@kindex 1 @dots{} 9, in Info windows
+@findex menu-digit
+Within an Info window, pressing a single digit, (such as @samp{1}),
+selects that menu item, and places its node in the current window.
+For convenience, there is one exception; pressing @samp{0} selects the
+@emph{last} item in the node's menu.
+
+@item @code{0} (@code{last-menu-item})
+@kindex 0, in Info windows
+@findex last-menu-item
+Select the last item in the current node's menu.
+
+@item @code{m} (@code{menu-item})
+@kindex m
+@findex menu-item
+Reads the name of a menu item in the echo area and selects its node.
+Completion is available while reading the menu label.
+
+@item @code{M-x find-menu}
+@findex find-menu
+Move the cursor to the start of this node's menu.
+@end table
+
+This table lists the Info commands which operate on note cross references.
+
+@table @asis
+@item @code{f} (@code{xref-item})
+@itemx @code{r}
+@kindex f
+@kindex r
+@findex xref-item
+Reads the name of a note cross reference in the echo area and selects
+its node. Completion is available while reading the cross reference
+label.
+@end table
+
+Finally, the next few commands operate on menu or note references alike:
+
+@table @asis
+@item @code{TAB} (@code{move-to-next-xref})
+@kindex TAB, in Info windows
+@findex move-to-next-xref
+Move the cursor to the start of the next nearest menu item or note
+reference in this node. You can then use @key{RET}
+(@code{select-reference-this-line}) to select the menu or note reference.
+
+@item @code{M-TAB} (@code{move-to-prev-xref})
+@kindex M-TAB, in Info windows
+@findex move-to-prev-xref
+Move the cursor the start of the nearest previous menu item or note
+reference in this node.
+
+@item @code{RET} (@code{select-reference-this-line})
+@kindex RET, in Info windows
+@findex select-reference-this-line
+Select the menu item or note reference appearing on this line.
+@end table
+
+@node Window Commands, Printing Nodes, Xref Commands, Top
+@chapter Manipulating Multiple Windows
+@cindex windows, manipulating
+
+A @dfn{window} is a place to show the text of a node. Windows have a
+view area where the text of the node is displayed, and an associated
+@dfn{mode line}, which briefly describes the node being viewed.
+
+GNU Info supports multiple windows appearing in a single screen; each
+window is separated from the next by its modeline. At any time, there
+is only one @dfn{active} window, that is, the window in which the cursor
+appears. There are commands available for creating windows, changing
+the size of windows, selecting which window is active, and for deleting
+windows.
+
+@menu
+* The Mode Line:: What appears in the mode line?
+* Basic Windows:: Manipulating windows in Info.
+* The Echo Area:: Used for displaying errors and reading input.
+@end menu
+
+@node The Mode Line, Basic Windows, , Window Commands
+@section The Mode Line
+
+A @dfn{mode line} is a line of inverse video which appears at the bottom
+of an Info window. It describes the contents of the window just above
+it; this information includes the name of the file and node appearing in
+that window, the number of screen lines it takes to display the node,
+and the percentage of text that is above the top of the window. It can
+also tell you if the indirect tags table for this Info file needs to be
+updated, and whether or not the Info file was compressed when stored on
+disk.
+
+Here is a sample mode line for a window containing an uncompressed file
+named @file{dir}, showing the node @samp{Top}.
+
+@example
+@group
+-----Info: (dir)Top, 40 lines --Top---------------------------------------
+ ^^ ^ ^^^ ^^
+ (file)Node #lines where
+@end group
+@end example
+
+When a node comes from a file which is compressed on disk, this is
+indicated in the mode line with two small @samp{z}'s. In addition, if
+the Info file containing the node has been split into subfiles, the name
+of the subfile containing the node appears in the modeline as well:
+
+@example
+--zz-Info: (emacs)Top, 291 lines --Top-- Subfile: emacs-1.Z---------------
+@end example
+
+When Info makes a node internally, such that there is no corresponding
+info file on disk, the name of the node is surrounded by asterisks
+(@samp{*}). The name itself tells you what the contents of the window
+are; the sample mode line below shows an internally constructed node
+showing possible completions:
+
+@example
+-----Info: *Completions*, 7 lines --All-----------------------------------
+@end example
+
+@node Basic Windows, The Echo Area, The Mode Line, Window Commands
+@section Window Commands
+
+It can be convenient to view more than one node at a time. To allow
+this, Info can display more than one @dfn{window}. Each window has its
+own mode line (@pxref{The Mode Line}) and history of nodes viewed in that
+window (@pxref{Node Commands, , @code{history-node}}).
+
+@table @asis
+@item @code{C-x o} (@code{next-window})
+@cindex windows, selecting
+@kindex C-x o
+@findex next-window
+Select the next window on the screen. Note that the echo area can only be
+selected if it is already in use, and you have left it temporarily.
+Normally, @samp{C-x o} simply moves the cursor into the next window on
+the screen, or if you are already within the last window, into the first
+window on the screen. Given a numeric argument, @samp{C-x o} moves over
+that many windows. A negative argument causes @samp{C-x o} to select
+the previous window on the screen.
+
+@item @code{M-x prev-window}
+@findex prev-window
+Select the previous window on the screen. This is identical to
+@samp{C-x o} with a negative argument.
+
+@item @code{C-x 2} (@code{split-window})
+@cindex windows, creating
+@kindex C-x 2
+@findex split-window
+Split the current window into two windows, both showing the same node.
+Each window is one half the size of the original window, and the cursor
+remains in the original window. The variable @code{automatic-tiling}
+can cause all of the windows on the screen to be resized for you
+automatically, please @pxref{Variables, , automatic-tiling} for more
+information.
+
+@item @code{C-x 0} (@code{delete-window})
+@cindex windows, deleting
+@kindex C-x 0
+@findex delete-window
+Delete the current window from the screen. If you have made too many
+windows and your screen appears cluttered, this is the way to get rid of
+some of them.
+
+@item @code{C-x 1} (@code{keep-one-window})
+@kindex C-x 1
+@findex keep-one-window
+Delete all of the windows excepting the current one.
+
+@item @code{ESC C-v} (@code{scroll-other-window})
+@kindex ESC C-v, in Info windows
+@findex scroll-other-window
+Scroll the other window, in the same fashion that @samp{C-v} might
+scroll the current window. Given a negative argument, scroll the
+"other" window backward.
+
+@item @code{C-x ^} (@code{grow-window})
+@kindex C-x ^
+@findex grow-window
+Grow (or shrink) the current window. Given a numeric argument, grow
+the current window that many lines; with a negative numeric argument,
+shrink the window instead.
+
+@item @code{C-x t} (@code{tile-windows})
+@cindex tiling
+@kindex C-x t
+@findex tile-windows
+Divide the available screen space among all of the visible windows.
+Each window is given an equal portion of the screen in which to display
+its contents. The variable @code{automatic-tiling} can cause
+@code{tile-windows} to be called when a window is created or deleted.
+@xref{Variables, , @code{automatic-tiling}}.
+@end table
+
+@node The Echo Area, , Basic Windows, Window Commands
+@section The Echo Area
+@cindex echo area
+
+The @dfn{echo area} is a one line window which appears at the bottom of
+the screen. It is used to display informative or error messages, and to
+read lines of input from you when that is necessary. Almost all of the
+commands available in the echo area are identical to their Emacs
+counterparts, so please refer to that documentation for greater depth of
+discussion on the concepts of editing a line of text. The following
+table briefly lists the commands that are available while input is being
+read in the echo area:
+
+@table @asis
+@item @code{C-f} (@code{echo-area-forward})
+@kindex C-f, in the echo area
+@findex echo-area-forward
+Move forward a character.
+
+@item @code{C-b} (@code{echo-area-backward})
+@kindex C-b, in the echo area
+@findex echo-area-backward
+Move backward a character.
+
+@item @code{C-a} (@code{echo-area-beg-of-line})
+@kindex C-a, in the echo area
+@findex echo-area-beg-of-line
+Move to the start of the input line.
+
+@item @code{C-e} (@code{echo-area-end-of-line})
+@kindex C-e, in the echo area
+@findex echo-area-end-of-line
+Move to the end of the input line.
+
+@item @code{M-f} (@code{echo-area-forward-word})
+@kindex M-f, in the echo area
+@findex echo-area-forward-word
+Move forward a word.
+
+@item @code{M-b} (@code{echo-area-backward-word})
+@kindex M-b, in the echo area
+@findex echo-area-backward-word
+Move backward a word.
+
+@item @code{C-d} (@code{echo-area-delete})
+@kindex C-d, in the echo area
+@findex echo-area-delete
+Delete the character under the cursor.
+
+@item @code{DEL} (@code{echo-area-rubout})
+@kindex DEL, in the echo area
+@findex echo-area-rubout
+Delete the character behind the cursor.
+
+@item @code{C-g} (@code{echo-area-abort})
+@kindex C-g, in the echo area
+@findex echo-area-abort
+Cancel or quit the current operation. If completion is being read,
+@samp{C-g} discards the text of the input line which does not match any
+completion. If the input line is empty, @samp{C-g} aborts the calling
+function.
+
+@item @code{RET} (@code{echo-area-newline})
+@kindex RET, in the echo area
+@findex echo-area-newline
+Accept (or forces completion of) the current input line.
+
+@item @code{C-q} (@code{echo-area-quoted-insert})
+@kindex C-q, in the echo area
+@findex echo-area-quoted-insert
+Insert the next character verbatim. This is how you can insert control
+characters into a search string, for example.
+
+@item @var{printing character} (@code{echo-area-insert})
+@kindex printing characters, in the echo area
+@findex echo-area-insert
+Insert the character.
+
+@item @code{M-TAB} (@code{echo-area-tab-insert})
+@kindex M-TAB, in the echo area
+@findex echo-area-tab-insert
+Insert a TAB character.
+
+@item @code{C-t} (@code{echo-area-transpose-chars})
+@kindex C-t, in the echo area
+@findex echo-area-transpose-chars
+Transpose the characters at the cursor.
+@end table
+
+The next group of commands deal with @dfn{killing}, and @dfn{yanking}
+text. For an in depth discussion of killing and yanking,
+@pxref{Killing, , Killing and Deleting, emacs, the GNU Emacs Manual}
+
+@table @asis
+@item @code{M-d} (@code{echo-area-kill-word})
+@kindex M-d, in the echo area
+@findex echo-area-kill-word
+Kill the word following the cursor.
+
+@item @code{M-DEL} (@code{echo-area-backward-kill-word})
+@kindex M-DEL, in the echo area
+@findex echo-area-backward-kill-word
+Kill the word preceding the cursor.
+
+@item @code{C-k} (@code{echo-area-kill-line})
+@kindex C-k, in the echo area
+@findex echo-area-kill-line
+Kill the text from the cursor to the end of the line.
+
+@item @code{C-x DEL} (@code{echo-area-backward-kill-line})
+@kindex C-x DEL, in the echo area
+@findex echo-area-backward-kill-line
+Kill the text from the cursor to the beginning of the line.
+
+@item @code{C-y} (@code{echo-area-yank})
+@kindex C-y, in the echo area
+@findex echo-area-yank
+Yank back the contents of the last kill.
+
+@item @code{M-y} (@code{echo-area-yank-pop})
+@kindex M-y, in the echo area
+@findex echo-area-yank-pop
+Yank back a previous kill, removing the last yanked text first.
+@end table
+
+Sometimes when reading input in the echo area, the command that needed
+input will only accept one of a list of several choices. The choices
+represent the @dfn{possible completions}, and you must respond with one
+of them. Since there are a limited number of responses you can make,
+Info allows you to abbreviate what you type, only typing as much of the
+response as is necessary to uniquely identify it. In addition, you can
+request Info to fill in as much of the response as is possible; this
+is called @dfn{completion}.
+
+The following commands are available when completing in the echo area:
+
+@table @asis
+@item @code{TAB} (@code{echo-area-complete})
+@itemx @code{SPC}
+@kindex TAB, in the echo area
+@kindex SPC, in the echo area
+@findex echo-area-complete
+Insert as much of a completion as is possible.
+
+@item @code{?} (@code{echo-area-possible-completions})
+@kindex ?, in the echo area
+@findex echo-area-possible-completions
+Display a window containing a list of the possible completions of what
+you have typed so far. For example, if the available choices are:
+
+@example
+@group
+bar
+foliate
+food
+forget
+@end group
+@end example
+
+@noindent
+and you have typed an @samp{f}, followed by @samp{?}, the possible
+completions would contain:
+
+@example
+@group
+foliate
+food
+forget
+@end group
+@end example
+
+@noindent
+i.e., all of the choices which begin with @samp{f}. Pressing @key{SPC}
+or @key{TAB} would result in @samp{fo} appearing in the echo area, since
+all of the choices which begin with @samp{f} continue with @samp{o}.
+Now, typing @samp{l} followed by @samp{TAB} results in @samp{foliate}
+appearing in the echo area, since that is the only choice which begins
+with @samp{fol}.
+
+@item @code{ESC C-v} (@code{echo-area-scroll-completions-window})
+@kindex ESC C-v, in the echo area
+@findex echo-area-scroll-completions-window
+Scroll the completions window, if that is visible, or the "other"
+window if not.
+@end table
+
+@node Printing Nodes, Miscellaneous Commands, Window Commands, Top
+@chapter Printing Out Nodes
+@cindex printing
+
+You may wish to print out the contents of a node as a quick reference
+document for later use. Info provides you with a command for doing
+this. In general, we recommend that you use @TeX{} to format the
+document and print sections of it, by running @code{tex} on the Texinfo
+source file.
+
+@table @asis
+@item @code{M-x print-node}
+@findex print-node
+@cindex INFO_PRINT_COMMAND, environment variable
+Pipe the contents of the current node through the command in the
+environment variable @code{INFO_PRINT_COMMAND}. If the variable does not
+exist, the node is simply piped to @code{lpr}.
+@end table
+
+@node Miscellaneous Commands, Variables, Printing Nodes, Top
+@chapter Miscellaneous Commands
+
+GNU Info contains several commands which self-document GNU Info:
+
+@table @asis
+@item @code{M-x describe-command}
+@cindex functions, describing
+@cindex commands, describing
+@findex describe-command
+Read the name of an Info command in the echo area and then display a
+brief description of what that command does.
+
+@item @code{M-x describe-key}
+@cindex keys, describing
+@findex describe-key
+Read a key sequence in the echo area, and then display the name and
+documentation of the Info command that the key sequence invokes.
+
+@item @code{M-x describe-variable}
+Read the name of a variable in the echo area and then display a brief
+description of what the variable affects.
+
+@item @code{M-x where-is}
+@findex where-is
+Read the name of an Info command in the echo area, and then display
+a key sequence which can be typed in order to invoke that command.
+
+@item @code{C-h} (@code{get-help-window})
+@itemx @code{?}
+@kindex C-h
+@kindex ?, in Info windows
+@findex get-help-window
+Create (or Move into) the window displaying @code{*Help*}, and place
+a node containing a quick reference card into it. This window displays
+the most concise information about GNU Info available.
+
+@item @code{h} (@code{get-info-help-node})
+@kindex h
+@findex get-info-help-node
+Try hard to visit the node @code{(info)Help}. The Info file
+@file{info.texi} distributed with GNU Info contains this node. Of
+course, the file must first be processed with @code{makeinfo}, and then
+placed into the location of your Info directory.
+@end table
+
+Here are the commands for creating a numeric argument:
+
+@table @asis
+@item @code{C-u} (@code{universal-argument})
+@cindex numeric arguments
+@kindex C-u
+@findex universal-argument
+Start (or multiply by 4) the current numeric argument. @samp{C-u} is
+a good way to give a small numeric argument to cursor movement or
+scrolling commands; @samp{C-u C-v} scrolls the screen 4 lines, while
+@samp{C-u C-u C-n} moves the cursor down 16 lines.
+
+@item @code{M-1} (@code{add-digit-to-numeric-arg})
+@itemx @code{M-2} @dots{} @code{M-9}
+@kindex M-1 @dots{} M-9
+@findex add-digit-to-numeric-arg
+Add the digit value of the invoking key to the current numeric
+argument. Once Info is reading a numeric argument, you may just type
+the digits of the argument, without the Meta prefix. For example, you
+might give @samp{C-l} a numeric argument of 32 by typing:
+
+@example
+@kbd{C-u 3 2 C-l}
+@end example
+
+@noindent
+or
+
+@example
+@kbd{M-3 2 C-l}
+@end example
+@end table
+
+@samp{C-g} is used to abort the reading of a multi-character key
+sequence, to cancel lengthy operations (such as multi-file searches) and
+to cancel reading input in the echo area.
+
+@table @asis
+@item @code{C-g} (@code{abort-key})
+@cindex cancelling typeahead
+@cindex cancelling the current operation
+@kindex C-g, in Info windows
+@findex abort-key
+Cancel current operation.
+@end table
+
+The @samp{q} command of Info simply quits running Info.
+
+@table @asis
+@item @code{q} (@code{quit})
+@cindex quitting
+@kindex q
+@findex quit
+Exit GNU Info.
+@end table
+
+If the operating system tells GNU Info that the screen is 60 lines tall,
+and it is actually only 40 lines tall, here is a way to tell Info that
+the operating system is correct.
+
+@table @asis
+@item @code{M-x set-screen-height}
+@findex set-screen-height
+@cindex screen, changing the height of
+Read a height value in the echo area and set the height of the
+displayed screen to that value.
+@end table
+
+Finally, Info provides a convenient way to display footnotes which might
+be associated with the current node that you are viewing:
+
+@table @asis
+@item @code{ESC C-f} (@code{show-footnotes})
+@kindex ESC C-f
+@findex show-footnotes
+@cindex footnotes, displaying
+Show the footnotes (if any) associated with the current node in another
+window. You can have Info automatically display the footnotes
+associated with a node when the node is selected by setting the variable
+@code{automatic-footnotes}. @xref{Variables, , @code{automatic-footnotes}}.
+@end table
+
+@node Variables, GNU Info Global Index, Miscellaneous Commands, Top
+@chapter Manipulating Variables
+
+GNU Info contains several @dfn{variables} whose values are looked at by
+various Info commands. You can change the values of these variables,
+and thus change the behavior of Info to more closely match your
+environment and Info file reading manner.
+
+@table @asis
+@item @code{M-x set-variable}
+@cindex variables, setting
+@findex set-variable
+Read the name of a variable, and the value for it, in the echo area and
+then set the variable to that value. Completion is available when
+reading the variable name; often, completion is available when reading
+the value to give to the variable, but that depends on the variable
+itself. If a variable does @emph{not} supply multiple choices to
+complete over, it expects a numeric value.
+
+@item @code{M-x describe-variable}
+@cindex variables, describing
+@findex describe-variable
+Read the name of a variable in the echo area and then display a brief
+description of what the variable affects.
+@end table
+
+Here is a list of the variables that you can set in Info.
+
+@table @code
+@item automatic-footnotes
+@vindex automatic-footnotes
+When set to @code{On}, footnotes appear and disappear automatically.
+This variable is @code{On} by default. When a node is selected, a
+window containing the footnotes which appear in that node is created,
+and the footnotes are displayed within the new window. The window that
+Info creates to contain the footnotes is called @samp{*Footnotes*}. If
+a node is selected which contains no footnotes, and a @samp{*Footnotes*}
+window is on the screen, the @samp{*Footnotes*} window is deleted.
+Footnote windows created in this fashion are not automatically tiled so
+that they can use as little of the display as is possible.
+
+@item automatic-tiling
+@vindex automatic-tiling
+When set to @code{On}, creating or deleting a window resizes other
+windows. This variable is @code{Off} by default. Normally, typing
+@samp{C-x 2} divides the current window into two equal parts. When
+@code{automatic-tiling} is set to @code{On}, all of the windows are
+resized automatically, keeping an equal number of lines visible in each
+window. There are exceptions to the automatic tiling; specifically, the
+windows @samp{*Completions*} and @samp{*Footnotes*} are @emph{not}
+resized through automatic tiling; they remain their original size.
+
+@item visible-bell
+@vindex visible-bell
+When set to @code{On}, GNU Info attempts to flash the screen instead of
+ringing the bell. This variable is @code{Off} by default. Of course,
+Info can only flash the screen if the terminal allows it; in the case
+that the terminal does not allow it, the setting of this variable has no
+effect. However, you can make Info perform quietly by setting the
+@code{errors-ring-bell} variable to @code{Off}.
+
+@item errors-ring-bell
+@vindex errors-ring-bell
+When set to @code{On}, errors cause the bell to ring. The default
+setting of this variable is @code{On}.
+
+@item gc-compressed-files
+@vindex gc-compressed-files
+When set to @code{On}, Info garbage collects files which had to be
+uncompressed. The default value of this variable is @code{Off}.
+Whenever a node is visited in Info, the Info file containing that node
+is read into core, and Info reads information about the tags and nodes
+contained in that file. Once the tags information is read by Info, it
+is never forgotten. However, the actual text of the nodes does not need
+to remain in core unless a particular Info window needs it. For
+non-compressed files, the text of the nodes does not remain in core when
+it is no longer in use. But de-compressing a file can be a time
+consuming operation, and so Info tries hard not to do it twice.
+@code{gc-compressed-files} tells Info it is okay to garbage collect the
+text of the nodes of a file which was compressed on disk.
+
+@item show-index-match
+@vindex show-index-match
+When set to @code{On}, the portion of the matched search string is
+highlighted in the message which explains where the matched search
+string was found. The default value of this variable is @code{On}.
+When Info displays the location where an index match was found,
+(@pxref{Searching Commands, , @code{next-index-match}}), the portion of the
+string that you had typed is highlighted by displaying it in the inverse
+case from its surrounding characters.
+
+@item scroll-behavior
+@vindex scroll-behavior
+Control what happens when forward scrolling is requested at the end of
+a node, or when backward scrolling is requested at the beginning of a
+node. The default value for this variable is @code{Continuous}. There
+are three possible values for this variable:
+
+@table @code
+@item Continuous
+Try to get the first item in this node's menu, or failing that, the
+@samp{Next} node, or failing that, the @samp{Next} of the @samp{Up}.
+This behavior is identical to using the @samp{]}
+(@code{global-next-node}) and @samp{[} (@code{global-prev-node})
+commands.
+
+@item Next Only
+Only try to get the @samp{Next} node.
+
+@item Page Only
+Simply give up, changing nothing. If @code{scroll-behavior} is
+@code{Page Only}, no scrolling command can change the node that is being
+viewed.
+@end table
+
+@item scroll-step
+@vindex scroll-step
+The number of lines to scroll when the cursor moves out of the window.
+Scrolling happens automatically if the cursor has moved out of the
+visible portion of the node text when it is time to display. Usually
+the scrolling is done so as to put the cursor on the center line of the
+current window. However, if the variable @code{scroll-step} has a
+nonzero value, Info attempts to scroll the node text by that many lines;
+if that is enough to bring the cursor back into the window, that is what
+is done. The default value of this variable is 0, thus placing the
+cursor (and the text it is attached to) in the center of the window.
+Setting this variable to 1 causes a kind of "smooth scrolling" which
+some people prefer.
+
+@item ISO-Latin
+@cindex ISO Latin characters
+@vindex ISO-Latin
+When set to @code{On}, Info accepts and displays ISO Latin characters.
+By default, Info assumes an ASCII character set. @code{ISO-Latin} tells
+Info that it is running in an environment where the European standard
+character set is in use, and allows you to input such characters to
+Info, as well as display them.
+@end table
+
+
+
+@c the following is incomplete
+@ignore
+@c node Info for Sys Admins
+@c chapter Info for System Administrators
+
+This text describes some common ways of setting up an Info hierarchy
+from scratch, and details the various options that are available when
+installing Info. This text is designed for the person who is installing
+GNU Info on the system; although users may find the information present
+in this section interesting, none of it is vital to understanding how to
+use GNU Info.
+
+@menu
+* Setting the INFOPATH:: Where are my Info files kept?
+* Editing the DIR node:: What goes in `DIR', and why?
+* Storing Info files:: Alternate formats allow flexibility in setups.
+* Using `localdir':: Building DIR on the fly.
+* Example setups:: Some common ways to organize Info files.
+@end menu
+
+@c node Setting the INFOPATH
+@c section Setting the INFOPATH
+
+Where are my Info files kept?
+
+@c node Editing the DIR node
+@c section Editing the DIR node
+
+What goes in `DIR', and why?
+
+@c node Storing Info files
+@c section Storing Info files
+
+Alternate formats allow flexibility in setups.
+
+@c node Using `localdir'
+@c section Using `localdir'
+
+Building DIR on the fly.
+
+@c node Example setups
+@c section Example setups
+
+Some common ways to organize Info files.
+@end ignore
+
+@node GNU Info Global Index, , Variables, Top
+@appendix Global Index
+
+@printindex cp
+
+@contents
+@bye
--- /dev/null
+# Makefile for the XEmacs Internals Manual.
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION=1.0
+NAME=internals
+manual = xemacs-internals-manual-19-$(VERSION)
+
+TEXI2DVI = texi2dvi
+MAKEINFO = makeinfo
+
+# Uncomment this line for permuted index.
+# permuted_index = 1
+
+# List of all the texinfo files in the manual:
+
+srcs = internals.texi index.unperm index.perm
+
+all : info
+info : ../../info/$(NAME).info
+
+../../info/$(NAME).info: $(srcs) index.texi
+ @echo "Expect a coredump if you are not using makeinfo 1.68 (or later)"
+ $(MAKEINFO) $(NAME).texi
+ @rm -f core
+
+dvi : $(NAME).dvi
+
+$(NAME).dvi: $(srcs) index.texi
+ # Avoid losing old contents of aux file entirely.
+ -mv $(NAME).aux $(NAME).oaux
+ # First shot to define xrefs:
+ $(TEX) $(NAME).texi
+ if [ a${permuted_index} != a ]; \
+ then ./permute-index && mv permuted.fns $(NAME).fns; \
+ else texindex $(NAME).??; \
+ fi
+ $(TEX) $(NAME).texi
+
+index.texi:
+ if [ a${permuted_index} != a ]; \
+ then ln -s index.perm index.texi; \
+ else ln -s index.unperm index.texi; \
+ fi
+
+.PHONY: mostlyclean clean distclean realclean extraclean
+mostlyclean:
+ rm -f *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \
+ *.vr *.vrs *.pg *.pgs *.ky *.kys
+clean: mostlyclean
+ rm -f *.dvi *.ps make.out core index.texi
+distclean: clean
+realclean: clean
+extraclean: clean
+ -rm -f *~ \#*
--- /dev/null
+@c -*-texinfo-*-
+@setfilename ../../info/index.info
+
+@c Indexing guidelines
+
+@c I assume that all indexes will be combined.
+@c Therefore, if a generated findex and permutations
+@c cover the ways an index user would look up the entry,
+@c then no cindex is added.
+@c Concept index (cindex) entries will also be permuted. Therefore, they
+@c have no commas and few irrelevant connectives in them.
+
+@c I tried to include words in a cindex that give the context of the entry,
+@c particularly if there is more than one entry for the same concept.
+@c For example, "nil in keymap"
+@c Similarly for explicit findex and vindex entries, e.g. "print example".
+
+@c Error codes are given cindex entries, e.g. "end-of-file error".
+
+@c pindex is used for .el files and Unix programs
+
+@node Index, , Interface to X Windows, Top
+@unnumbered Index
+
+
+All variables, functions, keys, programs, files, and concepts are
+in this one index.
+
+All names and concepts are permuted, so they appear several times, one
+for each permutation of the parts of the name. For example,
+@code{function-name} would appear as @b{function-name} and @b{name,
+function-}. Key entries are not permuted, however.
+
+
+@c Print the indices
+
+@printindex fn
--- /dev/null
+@c -*-texinfo-*-
+@setfilename ../../info/index.info
+
+@c Indexing guidelines
+
+@c I assume that all indexes will be combined.
+@c Therefore, if a generated findex and permutations
+@c cover the ways an index user would look up the entry,
+@c then no cindex is added.
+@c Concept index (cindex) entries will also be permuted. Therefore, they
+@c have no commas and few irrelevant connectives in them.
+
+@c I tried to include words in a cindex that give the context of the entry,
+@c particularly if there is more than one entry for the same concept.
+@c For example, "nil in keymap"
+@c Similarly for explicit findex and vindex entries, e.g. "print example".
+
+@c Error codes are given cindex entries, e.g. "end-of-file error".
+
+@c pindex is used for .el files and Unix programs
+
+@node Index, , Interface to X Windows, Top
+@unnumbered Index
+
+@ignore
+All variables, functions, keys, programs, files, and concepts are
+in this one index.
+
+All names and concepts are permuted, so they appear several times, one
+for each permutation of the parts of the name. For example,
+@code{function-name} would appear as @b{function-name} and @b{name,
+function-}. Key entries are not permuted, however.
+@end ignore
+
+@c Print the indices
+
+@printindex fn
--- /dev/null
+# Makefile for the XEmacs Lisp Programmer's Manual.
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION=2.4
+NAME=lispref
+manual = elisp-manual-19-$(VERSION)
+
+TEXI2DVI = texi2dvi
+MAKEINFO = makeinfo
+
+# Uncomment this line for permuted index.
+# permuted_index = 1
+
+# List of all the texinfo files in the manual:
+
+srcs = abbrevs.texi annotations.texi back.texi backups.texi buffers.texi \
+ building.texi commands.texi compile.texi consoles-devices.texi control.texi \
+ databases.texi debugging.texi dialog.texi display.texi edebug-inc.texi \
+ edebug.texi errors.texi eval.texi extents.texi faces.texi files.texi \
+ frames.texi functions.texi glyphs.texi hash-tables.texi help.texi \
+ hooks.texi index.texi internationalization.texi intro.texi \
+ keymaps.texi ldap.texi lispref.texi lists.texi loading.texi locals.texi \
+ macros.texi maps.texi markers.texi menus.texi minibuf.texi modes.texi \
+ mouse.texi mule.texi numbers.texi objects.texi os.texi positions.texi \
+ processes.texi range-tables.texi scrollbars.texi searching.texi \
+ sequences.texi specifiers.texi streams.texi strings.texi symbols.texi \
+ syntax.texi text.texi tips.texi toolbar.texi tooltalk.texi variables.texi \
+ windows.texi x-windows.texi index.unperm index.perm
+
+all : info
+info : ../../info/$(NAME).info
+
+../../info/$(NAME).info: $(srcs) index.texi
+ $(MAKEINFO) -o $@ $(NAME).texi
+
+dvi: $(NAME).dvi
+
+$(NAME).dvi: $(srcs) index.texi
+ # Avoid losing old contents of aux file entirely.
+ -mv $(NAME).aux $(NAME).oaux
+ # First shot to define xrefs:
+ $(TEX) $(NAME).texi
+ if [ a${permuted_index} != a ]; \
+ then ./permute-index && mv permuted.fns $(NAME).fns; \
+ else texindex $(NAME).??; \
+ fi
+ $(TEX) $(NAME).texi
+
+index.texi:
+ if [ a${permuted_index} != a ]; \
+ then ln -s index.perm index.texi; \
+ else ln -s index.unperm index.texi; \
+ fi
+
+.PHONY: mostlyclean clean distclean realclean extraclean
+mostlyclean:
+ rm -f *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \
+ *.vr *.vrs *.pg *.pgs *.ky *.kys
+clean: mostlyclean
+ rm -f *.dvi *.ps make.out core index.texi
+distclean: clean
+realclean: distclean
+extraclean: distclean
+ -rm -f *~ \#*
--- /dev/null
+@c -*-texinfo-*-
+@setfilename ../../info/index.info
+
+@c Indexing guidelines
+
+@c I assume that all indexes will be combined.
+@c Therefore, if a generated findex and permutations
+@c cover the ways an index user would look up the entry,
+@c then no cindex is added.
+@c Concept index (cindex) entries will also be permuted. Therefore, they
+@c have no commas and few irrelevant connectives in them.
+
+@c I tried to include words in a cindex that give the context of the entry,
+@c particularly if there is more than one entry for the same concept.
+@c For example, "nil in keymap"
+@c Similarly for explicit findex and vindex entries, e.g. "print example".
+
+@c Error codes are given cindex entries, e.g. "end-of-file error".
+
+@c pindex is used for .el files and Unix programs
+
+@node Index, , Standard Hooks, Top
+@unnumbered Index
+
+
+All variables, functions, keys, programs, files, and concepts are
+in this one index.
+
+All names and concepts are permuted, so they appear several times, one
+for each permutation of the parts of the name. For example,
+@code{function-name} would appear as @b{function-name} and @b{name,
+function-}. Key entries are not permuted, however.
+
+
+@c Print the indices
+
+@printindex fn
--- /dev/null
+@c -*-texinfo-*-
+@setfilename ../../info/index.info
+
+@c Indexing guidelines
+
+@c I assume that all indexes will be combined.
+@c Therefore, if a generated findex and permutations
+@c cover the ways an index user would look up the entry,
+@c then no cindex is added.
+@c Concept index (cindex) entries will also be permuted. Therefore, they
+@c have no commas and few irrelevant connectives in them.
+
+@c I tried to include words in a cindex that give the context of the entry,
+@c particularly if there is more than one entry for the same concept.
+@c For example, "nil in keymap"
+@c Similarly for explicit findex and vindex entries, e.g. "print example".
+
+@c Error codes are given cindex entries, e.g. "end-of-file error".
+
+@c pindex is used for .el files and Unix programs
+
+@node Index, , Standard Hooks, Top
+@unnumbered Index
+
+@ignore
+All variables, functions, keys, programs, files, and concepts are
+in this one index.
+
+All names and concepts are permuted, so they appear several times, one
+for each permutation of the parts of the name. For example,
+@code{function-name} would appear as @b{function-name} and @b{name,
+function-}. Key entries are not permuted, however.
+@end ignore
+
+@c Print the indices
+
+@printindex fn
--- /dev/null
+#!/bin/csh -f
+# Generate a permuted index of all names.
+# The result is a file called index.fns.
+
+# You will need to modify this for your needs.
+
+
+set TEXINDEX=texindex # path to texindex command
+#set EMACS=xemacs # your emacs command
+#set TEX=tex # your tex command
+
+set MANUAL=lispref # the base name of the manual
+
+# goto 3
+
+1:
+echo "Extract raw index from texinfo fn index."
+# Let texindex combine duplicate entries, later.
+# But it wants to protect non-alphanumerics thus confusing ptx.
+# Also change `\ ' to just a ` ', since texindex will fail. This is produced
+# by `@findex two words' in an example environment (no doubt among others).
+# delete wrapper parens
+# change dots {} to dots{}
+# change {-} to char form, so ptx wont ignore it.
+# delete leading \entry {
+# change '\ ' to ' '
+# change lines with = < > since they mess up field extraction.
+# separate into fields delimited by "
+cat ${MANUAL}.fn | \
+ sed \
+ -e 's/(\([^)]*\))/\1/' \
+ -e 's/\\dots {}/(\\dots{})/' \
+ -e "s/{-}/{{\\tt\\char'055}}/" \
+ -e 's,^[^ ]* {,,' \
+ -e 's, },},' \
+ -e 's,\\ , ,g' \
+ -e 's/{\\tt\\char61}/=/' \
+ -e 's/{\\tt\\gtr}/>/' \
+ -e 's/{\\tt\\less}/</' \
+ -e 's/}{/"/g' \
+ | awk -F\" '{print $2, $1}' >! permuted.raw
+
+2:
+# Build break file for ptx.
+cat <<EOF > permuted.break
+-
+:
+EOF
+# Build the ignore file for ptx.
+# We would like to ignore "and", "or", and "for",
+# but ptx ignores ignore words even if they stand alone.
+cat <<EOF > permuted.ignore
+the
+in
+to
+as
+a
+an
+of
+on
+them
+how
+from
+by
+EOF
+
+echo "Make troff permuted index."
+ptx -i permuted.ignore -b permuted.break -f -r -w 144 \
+ < permuted.raw >! permuted.t
+
+3:
+echo "Extract the desired fields."
+awk -F\" '{printf "%s\"%s\"%s\n", $4,$6,$9}' permuted.t >! permuted.fields
+
+4:
+echo "Format for texindex."
+# delete lines that start with "and ", "for "
+sed < permuted.fields \
+ -e 's/=/{\\tt\\char61}/' \
+ -e 's/>/{\\tt\\gtr}/' \
+ -e 's/</{\\tt\\less}/' \
+ -e '/"and /d' \
+ -e '/"for /d' \
+ | awk -F\" 'NF>0 {if ($1=="") {\
+ print "\entry {" $2 "}{" 0+$3 "}{" $2 "}" }\
+ else {\
+ print "\entry {" $2 ", " $1 "}{" 0+$3 "}{" $2 ", " $1 "}"} }'\
+ > permuted.fn
+
+5:
+echo "Sort with texindex."
+${TEXINDEX} permuted.fn
+#mv permuted.fns ${MANUAL}.fns
+
+# The resulting permuted.fns will be read when we run TeX
+# on the manual the second time. Or you can use permuted.texinfo here.
+#${TEX} permuted.texinfo
+
+6:
+echo "Clean up."
+rm -f permuted.fields permuted.t permuted.raw
+rm -f permuted.break permuted.ignore permuted.fn
--- /dev/null
+# Makefile for the XEmacs New Users Guide
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+NAME=new-users-guide
+
+SHELL = /bin/sh
+TEXI2DVI = texi2dvi
+MAKEINFO = makeinfo
+
+# List of all the texinfo files in the manual:
+
+srcs = new-users-guide.texi custom1.texi files.texi region.texi \
+ custom2.texi help.texi search.texi edit.texi modes.texi \
+ xmenu.texi enter.texi
+
+all : info
+info : ../../info/$(NAME).info
+
+../../info/$(NAME).info: $(srcs)
+ $(MAKEINFO) -o $@ $(NAME).texi
+
+dvi : $(NAME).dvi
+.texi.dvi :
+ $(TEXI2DVI) $<
+
+.PHONY: mostlyclean clean distclean realclean extraclean
+mostlyclean:
+ rm -f *.toc *.aux *.oaux *.log *.cp *.cps *.fn *.fns *.tp *.tps \
+ *.vr *.vrs *.pg *.pgs *.ky *.kys
+clean: mostlyclean
+ rm -f *.dvi *.ps make.out core
+distclean: clean
+realclean: clean
+extraclean: clean
+ -rm -f *~ \#*
--- /dev/null
+# Makefile for the XEmacs Reference Manual.
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# Modified by Ben Wing, February 1994
+
+NAME=xemacs
+
+MAKEINFO = makeinfo
+TEXI2DVI = texi2dvi
+
+# List of all the texinfo files in the manual:
+
+srcs = xemacs.texi abbrevs.texi basic.texi buffers.texi building.texi \
+ calendar.texi cmdargs.texi custom.texi display.texi entering.texi \
+ files.texi fixit.texi glossary.texi gnu.texi help.texi indent.texi \
+ keystrokes.texi killing.texi xemacs.texi m-x.texi major.texi mark.texi \
+ menus.texi mini.texi misc.texi mouse.texi new.texi picture.texi \
+ programs.texi reading.texi regs.texi frame.texi search.texi sending.texi \
+ text.texi trouble.texi undo.texi windows.texi
+
+all : info
+info : ../../info/$(NAME).info
+
+dvi: $(NAME).dvi
+.texi.dvi :
+ $(TEXI2DVI) $<
+
+../../info/$(NAME).info: $(srcs)
+ $(MAKEINFO) -o $@ $(NAME).texi
+
+.PHONY: mostlyclean clean distclean realclean extraclean
+mostlyclean:
+ rm -f *.toc *.aux *.oaux *.log *.cp *.cps *.fn *.fns *.tp *.tps \
+ *.vr *.vrs *.pg *.pgs *.ky *.kys
+clean: mostlyclean
+ rm -f *.dvi *.ps make.out core
+distclean: clean
+realclean: distclean
+extraclean: distclean
+ -rm -f *~ \#*
--- /dev/null
+MSW_LIBS =-luser32 -lgdi32 -lcomdlg32
+LDFLAGS =-Wl,--subsystem,windows
+CFLAGS =-g
+
+bindir =/usr/local/bin
+
+INSTALL = /usr/local/src/xemacs-21.0-b42/lib-src/installexe.sh /d/cygnus/h-i386-cygwin32/bin/install -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+runemacs.exe: runemacs.o
+ $(CC) $(LDFLAGS) runemacs.o $(MSW_LIBS) -o $@
+
+install: runemacs.exe
+ $(INSTALL_PROGRAM) runemacs.exe $(bindir)
--- /dev/null
+# List of problems with XEmacs. If anyone wants to work on these, please
+# mail me and I'll update the table below.
+
+# Core NT issues
+ 1. Subprocess support is completely broken.
+ 2. Networking support is completely broken. This is due to the fact that
+ the model relies on the subprocess support also working.
+ 4. No binary release. We know a binary release would be A Good Thing.
+ However we want to make things stable before producing one so we don't
+ have to field too many problems. Sorry.
+ 5. Support for dired is perhaps not quite there. We need to port ls-lisp.el
+ from FSF Emacs.
+ 6. Currently the backup files do not get the same permissions as the file
+ being edited. August Hill is looking at this one.
+ 7. Verify that CRLF issues are dealt with correctly. Marc Paquette is
+ looking at this.
+ 8. Use the registry to store the root directory(ies) of lisp packages; that
+ is the path name, not the elisp files.
+
+# X issues
+ 1. Redrawing on my (davidh) system seems fairly broken - I don't know if
+ this is the XEmacs redraw functionality, my X server or just something
+ strange with X under NT. Has anyone else experiences with this ?
+
+# Native GUI issues
+ 0. The entire event model.
+ 1. Calling mouse_[enter|leave]_frame_hook
+ 2. Can't change bold, italic or bold-italic face fonts
+ 3. Bogus delay when setting default- or initial-frame-plist
+ 4. Short timeouts don't seem to be very accurate
+ 5. Scrollbar dragging. Redisplay isn't called while dragging.
+ Also can't retrieve 32 bit tracking position with GetScrollInfo()
+ 6. Menubar
+ 7. Palette handling
+ 8. Middle mouse button emulation
+ 9. Drag'n'drop
+ 10. Images
+
+Old Issues.
+
+ 1. For some reason, HOME is a required environment variable.
+
--- /dev/null
+/* null version of <arpa/inet.h> - <sys/socket.h> has everything */
--- /dev/null
+/* null version of <netdb.h> - <sys/socket.h> has everything */
--- /dev/null
+/* null version of <netinet/in.h> - <sys/socket.h> has everything */
--- /dev/null
+#ifndef _PWD_H_
+#define _PWD_H_
+/*
+ * pwd.h doesn't exist on NT, so we put together our own.
+ */
+
+struct passwd {
+ char *pw_name;
+ char *pw_passwd;
+ int pw_uid;
+ int pw_gid;
+ int pw_quota;
+ char *pw_gecos;
+ char *pw_dir;
+ char *pw_shell;
+};
+
+#endif /* _PWD_H_ */
--- /dev/null
+/* This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: FSF 19.30. */
+
+/*
+ <dir.h> -- definitions for 4.2BSD-compatible directory access
+
+ last edit: 09-Jul-1983 D A Gwyn
+*/
+
+#ifdef VMS
+#ifndef FAB$C_BID
+#include <fab.h>
+#endif
+#ifndef NAM$C_BID
+#include <nam.h>
+#endif
+#ifndef RMS$_SUC
+#include <rmsdef.h>
+#endif
+#include "vms-dir.h"
+#endif /* VMS */
+
+#define DIRBLKSIZ 512 /* size of directory block */
+#ifdef VMS
+#define MAXNAMLEN (DIR$S_NAME + 7) /* 80 plus room for version #. */
+#define MAXFULLSPEC NAM$C_MAXRSS /* Maximum full spec */
+#else
+#ifdef WINDOWSNT
+#define MAXNAMLEN 255
+#else /* not WINDOWSNT */
+#define MAXNAMLEN 15 /* maximum filename length */
+#endif /* not WINDOWSNT */
+#endif /* VMS */
+ /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */
+
+struct direct /* data from readdir() */
+ {
+ long d_ino; /* inode number of entry */
+ unsigned short d_reclen; /* length of this record */
+ unsigned short d_namlen; /* length of string in d_name */
+ char d_name[MAXNAMLEN+1]; /* name of file */
+ };
+
+typedef struct
+ {
+ int dd_fd; /* file descriptor */
+ int dd_loc; /* offset in block */
+ int dd_size; /* amount of valid data */
+ char dd_buf[DIRBLKSIZ]; /* directory block */
+ } DIR; /* stream data from opendir() */
+
+DIR *opendir (CONST char *filename);
+void closedir (DIR *dirp);
+struct direct *readdir (DIR *dirp);
+struct direct *readdirver (DIR *dirp);
+long telldir (DIR *dirp);
+void seekdir (DIR *dirp, long loc);
+
+#define rewinddir( dirp ) seekdir( dirp, 0L )
--- /dev/null
+/*
+ * sys\file.h doesn't exist on NT - only needed for these constants
+ */
+
+#define F_OK 0
+#define X_OK 1
+#define W_OK 2
+#define R_OK 4
--- /dev/null
+/*
+ * sys\ioctl.h doesn't exist on NT...rather than including it conditionally
+ * in many of the source files, we just extend the include path so that the
+ * compiler will pick this up empty header instead.
+ */
--- /dev/null
+#ifndef _PARAM_H_
+#define _PARAM_H_
+
+/*
+ * sys\param.h doesn't exist on NT, so we'll make one.
+ */
+
+#define NBPG 4096
+
+#endif /* _PARAM_H_ */
--- /dev/null
+/* Workable version of <sys/socket.h> based on winsock.h */
+
+#ifndef _SOCKET_H_
+#define _SOCKET_H_
+
+/* defeat the multiple include protection */
+#ifdef _WINSOCKAPI_
+#undef _WINSOCKAPI_
+#endif
+
+#if 0 /* What's wrong with winsock.h version ? - kkm */
+/* avoid clashing with our version of FD_SET if already defined */
+#ifdef FD_SET
+#undef FD_SET
+#undef FD_CLR
+#undef FD_ISSET
+#undef FD_ZERO
+#endif
+
+/* allow us to provide our own version of fd_set */
+#define fd_set ws_fd_set
+#endif /* 0 */
+
+/* avoid duplicate definition of timeval */
+#ifdef HAVE_TIMEVAL
+#define timeval ws_timeval
+#endif
+
+#include <winsock.h>
+
+#if 0 /* What's wrong with winsock.h version ? - kkm */
+/* revert to our version of FD_SET */
+#undef FD_SET
+#undef FD_CLR
+#undef FD_ISSET
+#undef FD_ZERO
+#undef fd_set
+#include "nt.h"
+#endif /* 0 */
+
+#ifdef HAVE_TIMEVAL
+#undef timeval
+#endif
+
+/* map winsock error codes to standard names */
+#define EWOULDBLOCK WSAEWOULDBLOCK
+#define EINPROGRESS WSAEINPROGRESS
+#define EALREADY WSAEALREADY
+#define ENOTSOCK WSAENOTSOCK
+#define EDESTADDRREQ WSAEDESTADDRREQ
+#define EMSGSIZE WSAEMSGSIZE
+#define EPROTOTYPE WSAEPROTOTYPE
+#define ENOPROTOOPT WSAENOPROTOOPT
+#define EPROTONOSUPPORT WSAEPROTONOSUPPORT
+#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
+#define EOPNOTSUPP WSAEOPNOTSUPP
+#define EPFNOSUPPORT WSAEPFNOSUPPORT
+#define EAFNOSUPPORT WSAEAFNOSUPPORT
+#define EADDRINUSE WSAEADDRINUSE
+#define EADDRNOTAVAIL WSAEADDRNOTAVAIL
+#define ENETDOWN WSAENETDOWN
+#define ENETUNREACH WSAENETUNREACH
+#define ENETRESET WSAENETRESET
+#define ECONNABORTED WSAECONNABORTED
+#define ECONNRESET WSAECONNRESET
+#define ENOBUFS WSAENOBUFS
+#define EISCONN WSAEISCONN
+#define ENOTCONN WSAENOTCONN
+#define ESHUTDOWN WSAESHUTDOWN
+#define ETOOMANYREFS WSAETOOMANYREFS
+#define ETIMEDOUT WSAETIMEDOUT
+#define ECONNREFUSED WSAECONNREFUSED
+#define ELOOP WSAELOOP
+/* #define ENAMETOOLONG WSAENAMETOOLONG */
+#define EHOSTDOWN WSAEHOSTDOWN
+#define EHOSTUNREACH WSAEHOSTUNREACH
+/* #define ENOTEMPTY WSAENOTEMPTY */
+#define EPROCLIM WSAEPROCLIM
+#define EUSERS WSAEUSERS
+#define EDQUOT WSAEDQUOT
+#define ESTALE WSAESTALE
+#define EREMOTE WSAEREMOTE
+
+#endif /* _SOCKET_H_ */
+
+/* end of socket.h */
--- /dev/null
+/*
+ * sys/time.h doesn't exist on NT
+ */
+
+#include <time.h>
+
+struct timeval
+ {
+ long tv_sec; /* seconds */
+ long tv_usec; /* microseconds */
+ };
+
+struct timezone
+ {
+ int tz_minuteswest; /* minutes west of Greenwich */
+ int tz_dsttime; /* type of dst correction */
+ };
+
+#ifndef HAVE_X_WINDOWS
+/* X11R6 on NT provides the single parameter version of this command */
+void gettimeofday (struct timeval *, struct timezone *);
+#endif
+
+/* end of sys/time.h */
--- /dev/null
+/* Fake unistd.h: config.h already provides most of the relevant things. */
--- /dev/null
+/* Do not edit this file!
+ Automatically generated by XEmacs */
+# define PURESIZE_ADJUSTMENT (0)
--- /dev/null
+/*
+ Simple program to start Emacs with its console window hidden.
+
+ This program is provided purely for convenience, since most users will
+ use Emacs in windowing (GUI) mode, and will not want to have an extra
+ console window lying around. */
+
+/*
+ You may want to define this if you want to be able to install updated
+ emacs binaries even when other users are using the current version.
+ The problem with some file servers (notably Novell) is that an open
+ file cannot be overwritten, deleted, or even renamed. So if someone
+ is running emacs.exe already, you cannot install a newer version.
+ By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe
+ something else which matches "emacs*.exe", and runemacs will
+ automatically select the newest emacs executeable in the bin directory.
+ (So you'll probably be able to delete the old version some hours/days
+ later).
+*/
+
+/* #define CHOOSE_NEWEST_EXE */
+
+#define WIN32
+
+#include <windows.h>
+#include <string.h>
+#include <malloc.h>
+
+#if defined(__CYGWIN32__)
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+
+int WINAPI
+WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
+{
+ STARTUPINFO start;
+ SECURITY_ATTRIBUTES sec_attrs;
+ SECURITY_DESCRIPTOR sec_desc;
+ PROCESS_INFORMATION child;
+ int wait_for_child = FALSE;
+ DWORD ret_code = 0;
+ char *new_cmdline;
+ char *basename;
+ char *p;
+ char modname[MAX_PATH];
+
+ if (!GetModuleFileName (NULL, modname, MAX_PATH))
+ goto error;
+ if ((p = strrchr (modname, '\\')) == NULL)
+ goto error;
+
+ basename = alloca(strlen(p) + 1);
+ strcpy (basename, p + 1);
+
+ *p = 0;
+
+ new_cmdline = alloca (MAX_PATH + strlen (cmdline) + 1);
+ strcpy (new_cmdline, modname);
+
+#ifdef CHOOSE_NEWEST_EXE
+ {
+ /* Silly hack to allow new versions to be installed on
+ server even when current version is in use. */
+
+ char * best_name = alloca (MAX_PATH + 1);
+ FILETIME best_time = {0,0};
+ WIN32_FIND_DATA wfd;
+ HANDLE fh;
+ p = new_cmdline + strlen (new_cmdline);
+ strcpy (p, "\\xemacs*.exe ");
+ fh = FindFirstFile (new_cmdline, &wfd);
+ if (fh == INVALID_HANDLE_VALUE)
+ goto error;
+ do
+ {
+ if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime
+ || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime
+ && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime))
+ {
+ best_time = wfd.ftLastWriteTime;
+ strcpy (best_name, wfd.cFileName);
+ }
+ }
+ while (FindNextFile (fh, &wfd));
+ FindClose (fh);
+ *p++ = '\\';
+ strcpy (p, best_name);
+ strcat (p, " ");
+ }
+#else
+#if defined(__CYGWIN32__)
+ {
+ struct stat stbuf;
+ char sym_link_name[MAX_PATH+1], real_name[MAX_PATH+1];
+
+ strcpy(sym_link_name, new_cmdline);
+ if (strcmp(basename, "rungnuclient.exe") == 0)
+ strcat(new_cmdline, "\\gnuclient.exe ");
+ else if (strcmp(basename, "runemacs.exe") == 0)
+ {
+ strcat(sym_link_name, "\\xemacs");
+
+ if (lstat(sym_link_name, &stbuf) == 0)
+ {
+ if ((stbuf.st_mode & S_IFLNK) == S_IFLNK)
+ {
+ if (readlink(sym_link_name, real_name, sizeof(real_name)) == -1)
+ {
+ MessageBox (NULL, "Error reading symbolic link for xemacs",
+ "Error", MB_ICONSTOP);
+ return 1;
+ }
+ else
+ {
+ strcat(new_cmdline, "\\");
+ strcat(new_cmdline, real_name);
+ strcat(new_cmdline, " ");
+ }
+ }
+ else
+ strcat(new_cmdline, "\\xemacs ");
+ }
+ else
+ {
+ MessageBox (NULL, "can't locate XEmacs executable",
+ "Error", MB_ICONSTOP);
+ return 1;
+ }
+ }
+ }
+#else
+ if (strcmp(basename, "rungnuclient.exe") == 0)
+ strcat (new_cmdline, "\\gnuclient.exe ");
+ else
+ strcat (new_cmdline, "\\xemacs.exe ");
+#endif
+#endif
+
+ /* Append original arguments if any; first look for -wait as first
+ argument, and apply that ourselves. */
+ if (strncmp (cmdline, "-wait", 5) == 0)
+ {
+ wait_for_child = TRUE;
+ cmdline += 5;
+ }
+ strcat (new_cmdline, cmdline);
+
+ /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */
+ if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0)
+ {
+ *p = 0;
+ for (p = modname; *p; p++)
+ if (*p == '\\') *p = '/';
+ SetEnvironmentVariable ("emacs_dir", modname);
+ }
+
+ memset (&start, 0, sizeof (start));
+ start.cb = sizeof (start);
+ start.dwFlags = STARTF_USESHOWWINDOW;
+ start.wShowWindow = SW_HIDE;
+
+ sec_attrs.nLength = sizeof (sec_attrs);
+ sec_attrs.lpSecurityDescriptor = NULL;
+ sec_attrs.bInheritHandle = FALSE;
+
+ if (CreateProcess (NULL, new_cmdline, &sec_attrs, NULL, TRUE, 0,
+ NULL, NULL, &start, &child))
+ {
+ if (wait_for_child)
+ {
+ WaitForSingleObject (child.hProcess, INFINITE);
+ GetExitCodeProcess (child.hProcess, &ret_code);
+ }
+ CloseHandle (child.hThread);
+ CloseHandle (child.hProcess);
+ }
+ else
+ goto error;
+ return (int) ret_code;
+
+error:
+ MessageBox (NULL, "Could not start XEmacs or gnuclient.", "Error", MB_ICONSTOP);
+ return 1;
+}
--- /dev/null
+# -*- ksh -*-
+# Copyright (C) 1998 Free Software Foundation, Inc.
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# Author: Martin Buchholz
+
+# You can use this file to debug XEmacs using Sun WorkShop's dbx.
+# Add the contents of this file to $HOME/.dbxrc or
+# Source the contents of this file with something like:
+# if test -r ./dbxrc; then . ./dbxrc; fi
+
+# Some functions defined here require a running process, but most
+# don't. Considerable effort has been expended to this end.
+
+# See also the comments in gdbinit.
+
+# See also the question of the XEmacs FAQ, titled
+# "How to Debug an XEmacs problem with a debugger".
+
+ignore POLL
+ignore IO
+
+document lbt << 'end'
+Usage: lbt
+Print the current Lisp stack trace.
+Requires a running xemacs process.
+end
+
+function lbt {
+ call debug_backtrace()
+}
+
+document ldp << 'end'
+Usage: ldp lisp_object
+Print a Lisp Object value using the Lisp printer.
+Requires a running xemacs process.
+end
+
+function ldp {
+ call debug_print ($1);
+}
+
+# A bug in dbx prevents string variables from having values beginning with `-'!!
+function XEmacsInit {
+ function ToInt { eval "$1=\$[(int) $1]"; }
+ ToInt dbg_USE_MINIMAL_TAGBITS
+ ToInt dbg_USE_UNION_TYPE
+ ToInt dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
+ ToInt Lisp_Type_Int
+ ToInt Lisp_Type_Char
+ ToInt Lisp_Type_Cons
+ ToInt Lisp_Type_String
+ ToInt Lisp_Type_Vector
+ ToInt Lisp_Type_Symbol
+ ToInt Lisp_Type_Record
+ ToInt dbg_valbits
+ ToInt dbg_gctypebits
+ function ToLong { eval "$1=\$[(unsigned long) $1]"; }
+ ToLong dbg_valmask
+ ToLong dbg_typemask
+ xemacs_initted=yes
+}
+
+function printvar {
+ for i in $*; do eval "echo $i=\$$i"; done
+}
+
+document decode_object << 'end'
+Usage: decode_object lisp_object
+Extract implementation information from a Lisp Object.
+Defines variables $val, $type and $imp.
+end
+
+# Various dbx bugs cause ugliness in following code
+function decode_object {
+ if test -z "$xemacs_initted"; then XEmacsInit; fi;
+ if test $dbg_USE_UNION_TYPE = 1; then
+ # Repeat after me... dbx sux, dbx sux, dbx sux...
+ # Allow both `pobj Qnil' and `pobj 0x82746834' to work
+ case $(whatis $1) in
+ *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
+ *) obj="$[(unsigned long)($1)]";;
+ esac
+ else
+ obj="$[(unsigned long)($1)]";
+ fi
+ if test $dbg_USE_MINIMAL_TAGBITS = 1; then
+ if test $[(int)($obj & 1)] = 1; then
+ # It's an int
+ val=$[(long)(((unsigned long long)$obj) >> 1)]
+ type=$Lisp_Type_Int
+ else
+ type=$[(int)(((void*)$obj) & $dbg_typemask)]
+ if test $type = $Lisp_Type_Char; then
+ val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
+ else
+ # It's a record pointer
+ val=$[(void*)$obj]
+ if test "$val" = "(nil)"; then type=null_pointer; fi
+ fi
+ fi
+ else
+ # not dbg_USE_MINIMAL_TAGBITS
+ type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
+ if test "$type" = $Lisp_Type_Int; then
+ val=$[(int)($obj & $dbg_valmask)]
+ elif test "$type" = $Lisp_Type_Char; then
+ val=$[(int)($obj & $dbg_valmask)]
+ else
+ val=$[(void*)($obj & $dbg_valmask)]
+ if test "$val" = "(nil)"; then type=null_pointer; fi
+ fi
+ #val=$[(void*)($obj & $dbg_valmask)]
+ #printvar val type obj
+ fi
+
+ if test $type = $Lisp_Type_Record; then
+ typeset lheader="((struct lrecord_header *) $val)"
+ if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
+ imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
+ else
+ imp=$[(void*)($lheader->implementation)]
+ fi
+ else
+ imp="0xdeadbeef"
+ fi
+ # printvar obj val type imp
+}
+
+function xint {
+ decode_object "$*"
+ print (long) ($val)
+}
+
+function xtype {
+ decode_object "$*"
+ if test $type = $Lisp_Type_Int; then echo "int"
+ elif test $type = $Lisp_Type_Char; then echo "char"
+ elif test $type = $Lisp_Type_Symbol; then echo "symbol"
+ elif test $type = $Lisp_Type_String; then echo "string"
+ elif test $type = $Lisp_Type_Vector; then echo "vector"
+ elif test $type = $Lisp_Type_Cons; then echo "cons"
+ elif test $type = null_pointer; then echo "null_pointer"
+ else
+ echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
+ fi
+}
+
+function lisp-shadows {
+ run -batch -vanilla -f list-load-path-shadows
+}
+
+function environment-to-run-temacs {
+ unset EMACSLOADPATH
+ export EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ export EMACSBOOTSTRAPMODULEPATH=../modules/:..
+}
+
+document run-temacs << 'end'
+Usage: run-temacs
+Run temacs interactively, like xemacs.
+Use this with debugging tools (like purify) that cannot deal with dumping,
+or when temacs builds successfully, but xemacs does not.
+end
+
+function run-temacs {
+ environment-to-run-temacs
+ run -batch -l ../lisp/loadup.el run-temacs -q
+}
+
+document update-elc << 'end'
+Usage: update-elc
+Run the core lisp byte compilation part of the build procedure.
+Use when debugging temacs, not xemacs!
+Use this when temacs builds successfully, but xemacs does not.
+end
+
+function update-elc {
+ environment-to-run-temacs
+ run -batch -l ../lisp/update-elc.el
+}
+
+
+function dump-temacs {
+ environment-to-run-temacs
+ run -batch -l ../lisp/loadup.el dump
+}
+
+document dump-temacs << 'end'
+Usage: dump-temacs
+Run the dumping part of the build procedure.
+Use when debugging temacs, not xemacs!
+Use this when temacs builds successfully, but xemacs does not.
+end
+
+function pstruct {
+ xstruct="((struct $1 *) $val)"
+ print $xstruct
+ print *$xstruct
+}
+
+function lrecord_type_p {
+ if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
+}
+
+document pobj << 'end'
+Usage: pobj lisp_object
+Print the internal C structure of a underlying Lisp Object.
+end
+
+function pobj {
+ decode_object $1
+ if test $type = $Lisp_Type_Int; then
+ print -f"Integer: %d" $val
+ elif test $type = $Lisp_Type_Char; then
+ if test $[$val > 32 && $val < 128] = 1; then
+ print -f"Char: %c" $val
+ else
+ print -f"Char: %d" $val
+ fi
+ elif test $type = $Lisp_Type_String || lrecord_type_p string; then
+ pstruct Lisp_String
+ elif test $type = $Lisp_Type_Cons || lrecord_type_p cons; then
+ pstruct Lisp_Cons
+ elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
+ pstruct Lisp_Symbol
+ echo "Symbol name: $[(char *)($xstruct->name->data)]"
+ elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
+ pstruct Lisp_Vector
+ echo "Vector of length $[$xstruct->size]"
+ elif lrecord_type_p bit_vector; then
+ pstruct Lisp_Bit_Vector
+ elif lrecord_type_p buffer; then
+ pstruct buffer
+ elif lrecord_type_p char_table; then
+ pstruct Lisp_Char_Table
+ elif lrecord_type_p char_table_entry; then
+ pstruct Lisp_Char_Table_Entry
+ elif lrecord_type_p charset; then
+ pstruct Lisp_Charset
+ elif lrecord_type_p coding_system; then
+ pstruct Lisp_Coding_System
+ elif lrecord_type_p color_instance; then
+ pstruct Lisp_Color_Instance
+ elif lrecord_type_p command_builder; then
+ pstruct command_builder
+ elif lrecord_type_p compiled_function; then
+ pstruct Lisp_Compiled_Function
+ elif lrecord_type_p console; then
+ pstruct console
+ elif lrecord_type_p database; then
+ pstruct Lisp_Database
+ elif lrecord_type_p device; then
+ pstruct device
+ elif lrecord_type_p event; then
+ pstruct Lisp_Event
+ elif lrecord_type_p extent; then
+ pstruct extent
+ elif lrecord_type_p extent_auxiliary; then
+ pstruct extent_auxiliary
+ elif lrecord_type_p extent_info; then
+ pstruct extent_info
+ elif lrecord_type_p face; then
+ pstruct Lisp_Face
+ elif lrecord_type_p float; then
+ pstruct Lisp_Float
+ elif lrecord_type_p font_instance; then
+ pstruct Lisp_Font_Instance
+ elif lrecord_type_p frame; then
+ pstruct frame
+ elif lrecord_type_p glyph; then
+ pstruct Lisp_Glyph
+ elif lrecord_type_p hash_table; then
+ pstruct Lisp_Hash_Table
+ elif lrecord_type_p image_instance; then
+ pstruct Lisp_Image_Instance
+ elif lrecord_type_p keymap; then
+ pstruct Lisp_Keymap
+ elif lrecord_type_p lcrecord_list; then
+ pstruct lcrecord_list
+ elif lrecord_type_p lstream; then
+ pstruct lstream
+ elif lrecord_type_p marker; then
+ pstruct Lisp_Marker
+ elif lrecord_type_p opaque; then
+ pstruct Lisp_Opaque
+ elif lrecord_type_p opaque_list; then
+ pstruct Lisp_Opaque_List
+ elif lrecord_type_p popup_data; then
+ pstruct popup_data
+ elif lrecord_type_p process; then
+ pstruct Lisp_Process
+ elif lrecord_type_p range_table; then
+ pstruct Lisp_Range_Table
+ elif lrecord_type_p specifier; then
+ pstruct Lisp_Specifier
+ elif lrecord_type_p subr; then
+ pstruct Lisp_Subr
+ elif lrecord_type_p symbol_value_buffer_local; then
+ pstruct symbol_value_buffer_local
+ elif lrecord_type_p symbol_value_forward; then
+ pstruct symbol_value_forward
+ elif lrecord_type_p symbol_value_lisp_magic; then
+ pstruct symbol_value_lisp_magic
+ elif lrecord_type_p symbol_value_varalias; then
+ pstruct symbol_value_varalias
+ elif lrecord_type_p toolbar_button; then
+ pstruct toolbar_button
+ elif lrecord_type_p tooltalk_message; then
+ pstruct Lisp_Tooltalk_Message
+ elif lrecord_type_p tooltalk_pattern; then
+ pstruct Lisp_Tooltalk_Pattern
+ elif lrecord_type_p weak_list; then
+ pstruct weak_list
+ elif lrecord_type_p window; then
+ pstruct window
+ elif lrecord_type_p window_configuration; then
+ pstruct window_config
+ elif test "$type" = "null_pointer"; then
+ echo "Lisp Object is a null pointer!!"
+ else
+ echo "Unknown Lisp Object type"
+ print $1
+ fi
+}
+
+function pproc {
+ print *(`process.c`struct Lisp_Process*)$1 ;
+ ldp "(`process.c`struct Lisp_Process*)$1->name" ;
+ ldp "(`process.c`struct Lisp_Process*)$1->command" ;
+}
+
+dbxenv suppress_startup_message 4.0
+dbxenv mt_watchpoints on
+
+function dp_core {
+ print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
+}
+
+# Barf!
+function print_shell {
+ print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
+}
+
+# -------------------------------------------------------------
+# functions to test the debugging support itself.
+# If you change this file, make sure the following still work...
+# -------------------------------------------------------------
+function test_xtype {
+ function doit { echo -n "$1: "; xtype "$1"; }
+ test_various_objects
+}
+
+function test_pobj {
+ function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
+ test_various_objects
+}
+
+function test_various_objects {
+ doit Vemacs_major_version
+ doit Vhelp_char
+ doit Qnil
+ doit Qunbound
+ doit Vobarray
+ doit Vall_weak_lists
+ doit Vxemacs_codename
+}
--- /dev/null
+# -*- ksh -*-
+# Copyright (C) 1998 Free Software Foundation, Inc.
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# Author: Martin Buchholz
+
+# Some useful commands for debugging emacs with gdb 4.16 or better.
+# Install this as your .gdbinit file in your home directory,
+# or source this file from your .gdbinit
+# Configure xemacs with --debug, and compile with -g.
+#
+# See also the question of the XEmacs FAQ, titled
+# "How to Debug an XEmacs problem with a debugger".
+#
+# This can be used to debug XEmacs no matter how the following are
+# specified:
+
+# USE_UNION_TYPE
+# USE_MINIMAL_TAGBITS
+# USE_INDEXED_LRECORD_IMPLEMENTATION
+# LRECORD_(SYMBOL|STRING|VECTOR)
+
+# (the above all have configure equivalents)
+
+# Some functions defined here require a running process, but most
+# don't. Considerable effort has been expended to this end.
+
+# See the dbg_ C support code in src/alloc.c that allows the functions
+# defined in this file to work correctly.
+
+set print union off
+set print pretty off
+
+define decode_object
+ set $obj = (unsigned long) $arg0
+ if dbg_USE_MINIMAL_TAGBITS
+ if $obj & 1
+ # It's an int
+ set $val = $obj >> 1
+ set $type = Lisp_Type_Int
+ else
+ set $type = $obj & dbg_typemask
+ if $type == Lisp_Type_Char
+ set $val = ($obj & dbg_valmask) >> dbg_gctypebits
+ else
+ # It's a record pointer
+ set $val = $obj
+ end
+ end
+ else
+ # not dbg_USE_MINIMAL_TAGBITS
+ set $val = $obj & dbg_valmask
+ set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1)
+ end
+
+ if $type == Lisp_Type_Record
+ set $lheader = (struct lrecord_header *) $val
+ if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
+ set $imp = lrecord_implementations_table[$lheader->type]
+ else
+ set $imp = $lheader->implementation
+ end
+ else
+ set $imp = -1
+ end
+end
+
+document decode_object
+Usage: decode_object lisp_object
+Extract implementation information from a Lisp Object.
+Defines variables $val, $type and $imp.
+end
+
+define xint
+decode_object $arg0
+print ((long) $val)
+end
+
+define xtype
+ decode_object $arg0
+ if $type == Lisp_Type_Int
+ echo int\n
+ else
+ if $type == Lisp_Type_Char
+ echo char\n
+ else
+ if $type == Lisp_Type_Symbol
+ echo symbol\n
+ else
+ if $type == Lisp_Type_String
+ echo string\n
+ else
+ if $type == Lisp_Type_Vector
+ echo vector\n
+ else
+ if $type == Lisp_Type_Cons
+ echo cons\n
+ else
+ printf "record type: %s\n", $imp->name
+ # barf
+ end
+ end
+ end
+ end
+ end
+ end
+end
+
+define lisp-shadows
+ run -batch -vanilla -f list-load-path-shadows
+end
+
+document lisp-shadows
+Usage: lisp-shadows
+Run xemacs to check for lisp shadows
+end
+
+define environment-to-run-temacs
+ unset env EMACSLOADPATH
+ set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
+ set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
+end
+
+define run-temacs
+ environment-to-run-temacs
+ run -batch -l ../lisp/loadup.el run-temacs -q
+end
+
+document run-temacs
+Usage: run-temacs
+Run temacs interactively, like xemacs.
+Use this with debugging tools (like purify) that cannot deal with dumping,
+or when temacs builds successfully, but xemacs does not.
+end
+
+define update-elc
+ environment-to-run-temacs
+ run -batch -l ../lisp/update-elc.el
+end
+
+document update-elc
+Usage: update-elc
+Run the core lisp byte compilation part of the build procedure.
+Use when debugging temacs, not xemacs!
+Use this when temacs builds successfully, but xemacs does not.
+end
+
+define dump-temacs
+ environment-to-run-temacs
+ run -batch -l ../lisp/loadup.el dump
+end
+
+document dump-temacs
+Usage: dump-temacs
+Run the dumping part of the build procedure.
+Use when debugging temacs, not xemacs!
+Use this when temacs builds successfully, but xemacs does not.
+end
+
+# if you use Purify, do this:
+# export PURIFYOPTIONS='-pointer-mask=0x0fffffff'
+
+define ldp
+ printf "%s", "Lisp => "
+ call debug_print($arg0)
+end
+
+document ldp
+Usage: ldp lisp_object
+Print a Lisp Object value using the Lisp printer.
+Requires a running xemacs process.
+end
+
+define lbt
+call debug_backtrace()
+end
+
+document lbt
+Usage: lbt
+Print the current Lisp stack trace.
+Requires a running xemacs process.
+end
+
+
+define leval
+ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
+end
+
+document leval
+Usage: leval "SEXP"
+Eval a lisp expression.
+Requires a running xemacs process.
+
+Example:
+(gdb) leval "(+ 1 2)"
+Lisp ==> 3
+end
+
+
+define wtype
+print $arg0->core.widget_class->core_class.class_name
+end
+
+define xtname
+print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
+end
+
+# GDB's command language makes you want to ...
+
+define pstruct
+ set $xstruct = (struct $arg0 *) $val
+ print $xstruct
+ print *$xstruct
+end
+
+define pobj
+ decode_object $arg0
+ if $type == Lisp_Type_Int
+ printf "Integer: %d\n", $val
+ else
+ if $type == Lisp_Type_Char
+ if $val > 32 && $val < 128
+ printf "Char: %c\n", $val
+ else
+ printf "Char: %d\n", $val
+ end
+ else
+ if $type == Lisp_Type_String || $imp == lrecord_string
+ pstruct Lisp_String
+ else
+ if $type == Lisp_Type_Cons || $imp == lrecord_cons
+ pstruct Lisp_Cons
+ else
+ if $type == Lisp_Type_Symbol || $imp == lrecord_symbol
+ pstruct Lisp_Symbol
+ printf "Symbol name: %s\n", $xstruct->name->data
+ else
+ if $type == Lisp_Type_Vector || $imp == lrecord_vector
+ pstruct Lisp_Vector
+ printf "Vector of length %d\n", $xstruct->size
+ #print *($xstruct->data) @ $xstruct->size
+ else
+ if $imp == lrecord_bit_vector
+ pstruct Lisp_Bit_Vector
+ else
+ if $imp == lrecord_buffer
+ pstruct buffer
+ else
+ if $imp == lrecord_char_table
+ pstruct Lisp_Char_Table
+ else
+ if $imp == lrecord_char_table_entry
+ pstruct Lisp_Char_Table_Entry
+ else
+ if $imp == lrecord_charset
+ pstruct Lisp_Charset
+ else
+ if $imp == lrecord_coding_system
+ pstruct Lisp_Coding_System
+ else
+ if $imp == lrecord_color_instance
+ pstruct Lisp_Color_Instance
+ else
+ if $imp == lrecord_command_builder
+ pstruct command_builder
+ else
+ if $imp == lrecord_compiled_function
+ pstruct Lisp_Compiled_Function
+ else
+ if $imp == lrecord_console
+ pstruct console
+ else
+ if $imp == lrecord_database
+ pstruct Lisp_Database
+ else
+ if $imp == lrecord_device
+ pstruct device
+ else
+ if $imp == lrecord_event
+ pstruct Lisp_Event
+ else
+ if $imp == lrecord_extent
+ pstruct extent
+ else
+ if $imp == lrecord_extent_auxiliary
+ pstruct extent_auxiliary
+ else
+ if $imp == lrecord_extent_info
+ pstruct extent_info
+ else
+ if $imp == lrecord_face
+ pstruct Lisp_Face
+ else
+ if $imp == lrecord_float
+ pstruct Lisp_Float
+ else
+ if $imp == lrecord_font_instance
+ pstruct Lisp_Font_Instance
+ else
+ if $imp == lrecord_frame
+ pstruct frame
+ else
+ if $imp == lrecord_glyph
+ pstruct Lisp_Glyph
+ else
+ if $imp == lrecord_hash_table
+ pstruct Lisp_Hash_Table
+ else
+ if $imp == lrecord_image_instance
+ pstruct Lisp_Image_Instance
+ else
+ if $imp == lrecord_keymap
+ pstruct Lisp_Keymap
+ else
+ if $imp == lrecord_lcrecord_list
+ pstruct lcrecord_list
+ else
+ if $imp == lrecord_lstream
+ pstruct lstream
+ else
+ if $imp == lrecord_marker
+ pstruct Lisp_Marker
+ else
+ if $imp == lrecord_opaque
+ pstruct Lisp_Opaque
+ else
+ if $imp == lrecord_opaque_list
+ pstruct Lisp_Opaque_List
+ else
+ if $imp == lrecord_popup_data
+ pstruct popup_data
+ else
+ if $imp == lrecord_process
+ pstruct Lisp_Process
+ else
+ if $imp == lrecord_range_table
+ pstruct Lisp_Range_Table
+ else
+ if $imp == lrecord_specifier
+ pstruct Lisp_Specifier
+ else
+ if $imp == lrecord_subr
+ pstruct Lisp_Subr
+ else
+ if $imp == lrecord_symbol_value_buffer_local
+ pstruct symbol_value_buffer_local
+ else
+ if $imp == lrecord_symbol_value_forward
+ pstruct symbol_value_forward
+ else
+ if $imp == lrecord_symbol_value_lisp_magic
+ pstruct symbol_value_lisp_magic
+ else
+ if $imp == lrecord_symbol_value_varalias
+ pstruct symbol_value_varalias
+ else
+ if $imp == lrecord_toolbar_button
+ pstruct toolbar_button
+ else
+ if $imp == lrecord_tooltalk_message
+ pstruct Lisp_Tooltalk_Message
+ else
+ if $imp == lrecord_tooltalk_pattern
+ pstruct Lisp_Tooltalk_Pattern
+ else
+ if $imp == lrecord_weak_list
+ pstruct weak_list
+ else
+ if $imp == lrecord_window
+ pstruct window
+ else
+ if $imp == lrecord_window_configuration
+ pstruct window_config
+ else
+ echo Unknown Lisp Object type\n
+ print $arg0
+ # Barf, gag, retch
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ # Repeat after me... gdb sux, gdb sux, gdb sux...
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ # Are we having fun yet??
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+end
+
+document pobj
+Usage: pobj lisp_object
+Print the internal C structure of a underlying Lisp Object.
+end
+
+# -------------------------------------------------------------
+# functions to test the debugging support itself.
+# If you change this file, make sure the following still work...
+# -------------------------------------------------------------
+define test_xtype
+ printf "Vemacs_major_version: "
+ xtype Vemacs_major_version
+ printf "Vhelp_char: "
+ xtype Vhelp_char
+ printf "Qnil: "
+ xtype Qnil
+ printf "Qunbound: "
+ xtype Qunbound
+ printf "Vobarray: "
+ xtype Vobarray
+ printf "Vall_weak_lists: "
+ xtype Vall_weak_lists
+ printf "Vxemacs_codename: "
+ xtype Vxemacs_codename
+end
+
+define test_pobj
+ printf "Vemacs_major_version: "
+ pobj Vemacs_major_version
+ printf "Vhelp_char: "
+ pobj Vhelp_char
+ printf "Qnil: "
+ pobj Qnil
+ printf "Qunbound: "
+ pobj Qunbound
+ printf "Vobarray: "
+ pobj Vobarray
+ printf "Vall_weak_lists: "
+ pobj Vall_weak_lists
+ printf "Vxemacs_codename: "
+ pobj Vxemacs_codename
+end
+
--- /dev/null
+/* input-method-xfs.c provides just only locale initialize
+ for non Motif people. (stoled from input-method-xlib.c)
+ Why I made this code is to initialize X locale environment for
+ the purpose of use XFontSet correctly in lwlib/xlwmenu.c.
+ And this code donot provides input methods under Xlib while they
+ prefer to use Canna, Wnn, skk or something like that.
+ This code has been tested on FreeBSD 2.2.1 and Solaris2.5.
+
+ Copyright (C) 1997 Kazuyuki IENAGA.
+
+This file is a part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+#include <config.h>
+#include <X11/Xlocale.h> /* More portable than <locale.h> ? */
+#include "lisp.h"
+#include "frame.h"
+#include "device.h"
+#include "window.h"
+#include "buffer.h"
+#include "console-x.h"
+#include "EmacsFrame.h"
+#include "events.h"
+
+#ifdef USE_XFONTSET
+void
+Initialize_Locale (void)
+{
+ char *locale;
+
+ /* dverna - Nov. 98: ### DON'T DO THIS !!! The default XtLanguageProc
+ routine calls setlocale(LC_ALL, lang) which fucks up our lower-level
+ locale management, and especially the value of LC_NUMERIC. Anyway, since
+ at this point, we don't know yet whether we're gonna need an X11 frame,
+ we should really do it manually and not use Xlib's dumb default routine */
+ /*XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL);*/
+ if ((locale = setlocale (LC_ALL, "")) == NULL)
+ {
+ stderr_out ("Can't set locale.\n");
+ stderr_out ("Using C locale instead.\n");
+ putenv ("LANG=C");
+ putenv ("LC_ALL=C");
+ if ((locale = setlocale (LC_ALL, "C")) == NULL)
+ {
+ stderr_out ("Can't even set locale to `C'!\n");
+ return;
+ }
+ }
+
+ if (!XSupportsLocale ())
+ {
+ stderr_out ("X Windows does not support locale `%s'\n", locale);
+ stderr_out ("Using C Locale instead\n");
+ putenv ("LANG=C");
+ putenv ("LC_ALL=C");
+ if ((locale = setlocale (LC_ALL, "C")) == NULL)
+ {
+ stderr_out ("Can't even set locale to `C'!\n");
+ return;
+ }
+ if (!XSupportsLocale ())
+ {
+ stderr_out ("X Windows does not even support locale `C'!\n");
+ return;
+ }
+ }
+
+ setlocale(LC_NUMERIC, "C");
+ setlocale(LC_CTYPE, ""); /* take back CTYPE to previous state */
+
+ if (XSetLocaleModifiers ("") == NULL)
+ {
+ stderr_out ("XSetLocaleModifiers(\"\") failed\n");
+ stderr_out ("Check the value of the XMODIFIERS environment variable.\n");
+ }
+}
+#endif /* USE_XFONTSET */
--- /dev/null
+/* Code conversion functions.
+ Copyright (C) 1991, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Mule 2.3. Not in FSF. */
+
+/* Rewritten by Ben Wing <ben@xemacs.org>. */
+
+#if 0 /* while file-coding not split up */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "elhash.h"
+#include "insdel.h"
+#include "lstream.h"
+#include "mule-ccl.h"
+#include "mule-coding.h"
+
+Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error;
+
+Lisp_Object Vkeyboard_coding_system;
+Lisp_Object Vterminal_coding_system;
+Lisp_Object Vcoding_system_for_read;
+Lisp_Object Vcoding_system_for_write;
+Lisp_Object Vfile_name_coding_system;
+
+/* Table of symbols identifying each coding category. */
+Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST + 1];
+
+/* Coding system currently associated with each coding category. */
+Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1];
+
+/* Table of all coding categories in decreasing order of priority.
+ This describes a permutation of the possible coding categories. */
+int coding_category_by_priority[CODING_CATEGORY_LAST + 1];
+
+Lisp_Object Qcoding_system_p;
+
+Lisp_Object Qbig5, Qshift_jis, Qno_conversion, Qccl, Qiso2022;
+/* Qinternal in general.c */
+
+Lisp_Object Qmnemonic, Qeol_type;
+Lisp_Object Qcr, Qcrlf, Qlf;
+Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf;
+Lisp_Object Qpost_read_conversion;
+Lisp_Object Qpre_write_conversion;
+
+Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3;
+Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output;
+Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output;
+Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift;
+Lisp_Object Qno_iso6429, Qescape_quoted;
+Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion;
+
+Lisp_Object Qencode, Qdecode;
+
+Lisp_Object Qctext;
+
+Lisp_Object Vcoding_system_hash_table;
+
+int enable_multibyte_characters;
+
+/* Additional information used by the ISO2022 decoder and detector. */
+struct iso2022_decoder
+{
+ /* CHARSET holds the character sets currently assigned to the G0
+ through G3 variables. It is initialized from the array
+ INITIAL_CHARSET in CODESYS. */
+ Lisp_Object charset[4];
+
+ /* Which registers are currently invoked into the left (GL) and
+ right (GR) halves of the 8-bit encoding space? */
+ int register_left, register_right;
+
+ /* ISO_ESC holds a value indicating part of an escape sequence
+ that has already been seen. */
+ enum iso_esc_flag esc;
+
+ /* This records the bytes we've seen so far in an escape sequence,
+ in case the sequence is invalid (we spit out the bytes unchanged). */
+ unsigned char esc_bytes[8];
+
+ /* Index for next byte to store in ISO escape sequence. */
+ int esc_bytes_index;
+
+ /* Stuff seen so far when composing a string. */
+ unsigned_char_dynarr *composite_chars;
+
+ /* If we saw an invalid designation sequence for a particular
+ register, we flag it here and switch to ASCII. The next time we
+ see a valid designation for this register, we turn off the flag
+ and do the designation normally, but pretend the sequence was
+ invalid. The effect of all this is that (most of the time) the
+ escape sequences for both the switch to the unknown charset, and
+ the switch back to the known charset, get inserted literally into
+ the buffer and saved out as such. The hope is that we can
+ preserve the escape sequences so that the resulting written out
+ file makes sense. If we don't do any of this, the designation
+ to the invalid charset will be preserved but that switch back
+ to the known charset will probably get eaten because it was
+ the same charset that was already present in the register. */
+ unsigned char invalid_designated[4];
+
+ /* We try to do similar things as above for direction-switching
+ sequences. If we encountered a direction switch while an
+ invalid designation was present, or an invalid designation
+ just after a direction switch (i.e. no valid designation
+ encountered yet), we insert the direction-switch escape
+ sequence literally into the output stream, and later on
+ insert the corresponding direction-restoring escape sequence
+ literally also. */
+ unsigned int switched_dir_and_no_valid_charset_yet :1;
+ unsigned int invalid_switch_dir :1;
+
+ /* Tells the decoder to output the escape sequence literally
+ even though it was valid. Used in the games we play to
+ avoid lossage when we encounter invalid designations. */
+ unsigned int output_literally :1;
+ /* We encountered a direction switch followed by an invalid
+ designation. We didn't output the direction switch
+ literally because we didn't know about the invalid designation;
+ but we have to do so now. */
+ unsigned int output_direction_sequence :1;
+};
+
+EXFUN (Fcopy_coding_system, 2);
+struct detection_state;
+static int detect_coding_sjis (struct detection_state *st,
+ CONST unsigned char *src,
+ unsigned int n);
+static void decode_coding_sjis (Lstream *decoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst,
+ unsigned int n);
+static void encode_coding_sjis (Lstream *encoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst,
+ unsigned int n);
+static int detect_coding_big5 (struct detection_state *st,
+ CONST unsigned char *src,
+ unsigned int n);
+static void decode_coding_big5 (Lstream *decoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+static void encode_coding_big5 (Lstream *encoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+static int postprocess_iso2022_mask (int mask);
+static void reset_iso2022 (Lisp_Object coding_system,
+ struct iso2022_decoder *iso);
+static int detect_coding_iso2022 (struct detection_state *st,
+ CONST unsigned char *src,
+ unsigned int n);
+static void decode_coding_iso2022 (Lstream *decoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+static void encode_coding_iso2022 (Lstream *encoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+static void decode_coding_no_conversion (Lstream *decoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst,
+ unsigned int n);
+static void encode_coding_no_conversion (Lstream *encoding,
+ CONST unsigned char *src,
+ unsigned_char_dynarr *dst,
+ unsigned int n);
+static void mule_decode (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+static void mule_encode (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n);
+
+typedef struct codesys_prop codesys_prop;
+struct codesys_prop
+{
+ Lisp_Object sym;
+ int prop_type;
+};
+
+typedef struct
+{
+ Dynarr_declare (codesys_prop);
+} codesys_prop_dynarr;
+
+codesys_prop_dynarr *the_codesys_prop_dynarr;
+
+enum codesys_prop_enum
+{
+ CODESYS_PROP_ALL_OK,
+ CODESYS_PROP_ISO2022,
+ CODESYS_PROP_CCL
+};
+
+\f
+/************************************************************************/
+/* Coding system functions */
+/************************************************************************/
+
+static Lisp_Object
+mark_coding_system (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+ struct Lisp_Coding_System *codesys = XCODING_SYSTEM (obj);
+
+ markobj (CODING_SYSTEM_NAME (codesys));
+ markobj (CODING_SYSTEM_DOC_STRING (codesys));
+ markobj (CODING_SYSTEM_MNEMONIC (codesys));
+ markobj (CODING_SYSTEM_EOL_LF (codesys));
+ markobj (CODING_SYSTEM_EOL_CRLF (codesys));
+ markobj (CODING_SYSTEM_EOL_CR (codesys));
+
+ switch (CODING_SYSTEM_TYPE (codesys))
+ {
+ int i;
+ case CODESYS_ISO2022:
+ for (i = 0; i < 4; i++)
+ markobj (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i));
+ if (codesys->iso2022.input_conv)
+ {
+ for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++)
+ {
+ struct charset_conversion_spec *ccs =
+ Dynarr_atp (codesys->iso2022.input_conv, i);
+ markobj (ccs->from_charset);
+ markobj (ccs->to_charset);
+ }
+ }
+ if (codesys->iso2022.output_conv)
+ {
+ for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++)
+ {
+ struct charset_conversion_spec *ccs =
+ Dynarr_atp (codesys->iso2022.output_conv, i);
+ markobj (ccs->from_charset);
+ markobj (ccs->to_charset);
+ }
+ }
+ break;
+
+ case CODESYS_CCL:
+ markobj (CODING_SYSTEM_CCL_DECODE (codesys));
+ markobj (CODING_SYSTEM_CCL_ENCODE (codesys));
+ break;
+ default:
+ break;
+ }
+
+ markobj (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys));
+ return CODING_SYSTEM_POST_READ_CONVERSION (codesys);
+}
+
+static void
+print_coding_system (Lisp_Object obj, Lisp_Object printcharfun,
+ int escapeflag)
+{
+ struct Lisp_Coding_System *c = XCODING_SYSTEM (obj);
+ if (print_readably)
+ error ("printing unreadable object #<coding_system 0x%x>",
+ c->header.uid);
+
+ write_c_string ("#<coding_system ", printcharfun);
+ print_internal (c->name, printcharfun, 1);
+ write_c_string (">", printcharfun);
+}
+
+static void
+finalize_coding_system (void *header, int for_disksave)
+{
+ struct Lisp_Coding_System *c = (struct Lisp_Coding_System *) header;
+ /* Since coding systems never go away, this function is not
+ necessary. But it would be necessary if we changed things
+ so that coding systems could go away. */
+ if (!for_disksave) /* see comment in lstream.c */
+ {
+ switch (CODING_SYSTEM_TYPE (c))
+ {
+ case CODESYS_ISO2022:
+ if (c->iso2022.input_conv)
+ {
+ Dynarr_free (c->iso2022.input_conv);
+ c->iso2022.input_conv = 0;
+ }
+ if (c->iso2022.output_conv)
+ {
+ Dynarr_free (c->iso2022.output_conv);
+ c->iso2022.output_conv = 0;
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system,
+ mark_coding_system, print_coding_system,
+ finalize_coding_system,
+ 0, 0, struct Lisp_Coding_System);
+
+static enum eol_type
+symbol_to_eol_type (Lisp_Object symbol)
+{
+ CHECK_SYMBOL (symbol);
+ if (NILP (symbol)) return EOL_AUTODETECT;
+ if (EQ (symbol, Qlf)) return EOL_LF;
+ if (EQ (symbol, Qcrlf)) return EOL_CRLF;
+ if (EQ (symbol, Qcr)) return EOL_CR;
+
+ signal_simple_error ("Unrecognized eol type", symbol);
+ return EOL_AUTODETECT; /* not reached */
+}
+
+static Lisp_Object
+eol_type_to_symbol (enum eol_type type)
+{
+ switch (type)
+ {
+ default: abort ();
+ case EOL_LF: return Qlf;
+ case EOL_CRLF: return Qcrlf;
+ case EOL_CR: return Qcr;
+ case EOL_AUTODETECT: return Qnil;
+ }
+}
+
+static void
+setup_eol_coding_systems (struct Lisp_Coding_System *codesys)
+{
+ Lisp_Object codesys_obj;
+ int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name);
+ char *codesys_name = (char *) alloca (len + 7);
+ Lisp_Object codesys_name_sym, sub_codesys_obj;
+
+ /* kludge */
+
+ XSETCODING_SYSTEM (codesys_obj, codesys);
+
+ memcpy (codesys_name,
+ string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len);
+
+#define DEFINE_SUB_CODESYS(op_sys, Type) do { \
+ strcpy (codesys_name + len, "-" op_sys); \
+ codesys_name_sym = intern (codesys_name); \
+ sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym); \
+ XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type; \
+ CODING_SYSTEM_##Type (codesys) = sub_codesys_obj; \
+} while (0)
+
+ DEFINE_SUB_CODESYS("unix", EOL_LF);
+ DEFINE_SUB_CODESYS("dos", EOL_CRLF);
+ DEFINE_SUB_CODESYS("mac", EOL_CR);
+}
+
+DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /*
+Return t if OBJECT is a coding system.
+A coding system is an object that defines how text containing multiple
+character sets is encoded into a stream of (typically 8-bit) bytes.
+The coding system is used to decode the stream into a series of
+characters (which may be from multiple charsets) when the text is read
+from a file or process, and is used to encode the text back into the
+same format when it is written out to a file or process.
+
+For example, many ISO2022-compliant coding systems (such as Compound
+Text, which is used for inter-client data under the X Window System)
+use escape sequences to switch between different charsets -- Japanese
+Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked
+with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See
+`make-coding-system' for more information.
+
+Coding systems are normally identified using a symbol, and the
+symbol is accepted in place of the actual coding system object whenever
+a coding system is called for. (This is similar to how faces work.)
+*/
+ (object))
+{
+ return CODING_SYSTEMP (object) ? Qt : Qnil;
+}
+
+DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /*
+Retrieve the coding system of the given name.
+
+If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply
+returned. Otherwise, CODING-SYSTEM-OR-NAME should be a symbol.
+If there is no such coding system, nil is returned. Otherwise the
+associated coding system object is returned.
+*/
+ (coding_system_or_name))
+{
+ if (NILP (coding_system_or_name))
+ coding_system_or_name = Qbinary;
+ if (CODING_SYSTEMP (coding_system_or_name))
+ return coding_system_or_name;
+ CHECK_SYMBOL (coding_system_or_name);
+
+ return Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil);
+}
+
+DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /*
+Retrieve the coding system of the given name.
+Same as `find-coding-system' except that if there is no such
+coding system, an error is signaled instead of returning nil.
+*/
+ (name))
+{
+ Lisp_Object coding_system = Ffind_coding_system (name);
+
+ if (NILP (coding_system))
+ signal_simple_error ("No such coding system", name);
+ return coding_system;
+}
+
+/* We store the coding systems in hash tables with the names as the key and the
+ actual coding system object as the value. Occasionally we need to use them
+ in a list format. These routines provide us with that. */
+struct coding_system_list_closure
+{
+ Lisp_Object *coding_system_list;
+};
+
+static int
+add_coding_system_to_list_mapper (CONST void *hash_key, void *hash_contents,
+ void *coding_system_list_closure)
+{
+ /* This function can GC */
+ Lisp_Object key, contents;
+ Lisp_Object *coding_system_list;
+ struct coding_system_list_closure *cscl =
+ (struct coding_system_list_closure *) coding_system_list_closure;
+ CVOID_TO_LISP (key, hash_key);
+ VOID_TO_LISP (contents, hash_contents);
+ coding_system_list = cscl->coding_system_list;
+
+ *coding_system_list = Fcons (XCODING_SYSTEM (contents)->name,
+ *coding_system_list);
+ return 0;
+}
+
+DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /*
+Return a list of the names of all defined coding systems.
+*/
+ ())
+{
+ Lisp_Object coding_system_list = Qnil;
+ struct gcpro gcpro1;
+ struct coding_system_list_closure coding_system_list_closure;
+
+ GCPRO1 (coding_system_list);
+ coding_system_list_closure.coding_system_list = &coding_system_list;
+ elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table,
+ &coding_system_list_closure);
+ UNGCPRO;
+
+ return coding_system_list;
+}
+
+DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /*
+Return the name of the given coding system.
+*/
+ (coding_system))
+{
+ coding_system = Fget_coding_system (coding_system);
+ return XCODING_SYSTEM_NAME (coding_system);
+}
+
+static struct Lisp_Coding_System *
+allocate_coding_system (enum coding_system_type type, Lisp_Object name)
+{
+ struct Lisp_Coding_System *codesys =
+ alloc_lcrecord_type (struct Lisp_Coding_System, lrecord_coding_system);
+
+ zero_lcrecord (codesys);
+ CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil;
+ CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil;
+ CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT;
+ CODING_SYSTEM_EOL_CRLF (codesys) = Qnil;
+ CODING_SYSTEM_EOL_CR (codesys) = Qnil;
+ CODING_SYSTEM_EOL_LF (codesys) = Qnil;
+ CODING_SYSTEM_TYPE (codesys) = type;
+
+ if (type == CODESYS_ISO2022)
+ {
+ int i;
+ for (i = 0; i < 4; i++)
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil;
+ }
+ else if (type == CODESYS_CCL)
+ {
+ CODING_SYSTEM_CCL_DECODE (codesys) = Qnil;
+ CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil;
+ }
+
+ CODING_SYSTEM_NAME (codesys) = name;
+
+ return codesys;
+}
+
+/* Given a list of charset conversion specs as specified in a Lisp
+ program, parse it into STORE_HERE. */
+
+static void
+parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here,
+ Lisp_Object spec_list)
+{
+ Lisp_Object rest;
+
+ EXTERNAL_LIST_LOOP (rest, spec_list)
+ {
+ Lisp_Object car = XCAR (rest);
+ Lisp_Object from, to;
+ struct charset_conversion_spec spec;
+
+ if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car))))
+ signal_simple_error ("Invalid charset conversion spec", car);
+ from = Fget_charset (XCAR (car));
+ to = Fget_charset (XCAR (XCDR (car)));
+ if (XCHARSET_TYPE (from) != XCHARSET_TYPE (to))
+ signal_simple_error_2
+ ("Attempted conversion between different charset types",
+ from, to);
+ spec.from_charset = from;
+ spec.to_charset = to;
+
+ Dynarr_add (store_here, spec);
+ }
+}
+
+/* Given a dynarr LOAD_HERE of internally-stored charset conversion
+ specs, return the equivalent as the Lisp programmer would see it.
+
+ If LOAD_HERE is 0, return Qnil. */
+
+static Lisp_Object
+unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here)
+{
+ int i;
+ Lisp_Object result = Qnil;
+
+ if (!load_here)
+ return Qnil;
+ for (i = 0; i < Dynarr_length (load_here); i++)
+ {
+ struct charset_conversion_spec *ccs =
+ Dynarr_atp (load_here, i);
+ result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result);
+ }
+
+ return Fnreverse (result);
+}
+
+DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /*
+Register symbol NAME as a coding system.
+
+TYPE describes the conversion method used and should be one of
+
+nil or 'undecided
+ Automatic conversion. XEmacs attempts to detect the coding system
+ used in the file.
+'no-conversion
+ No conversion. Use this for binary files and such. On output,
+ graphic characters that are not in ASCII or Latin-1 will be
+ replaced by a ?. (For a no-conversion-encoded buffer, these
+ characters will only be present if you explicitly insert them.)
+'shift-jis
+ Shift-JIS (a Japanese encoding commonly used in PC operating systems).
+'iso2022
+ Any ISO2022-compliant encoding. Among other things, this includes
+ JIS (the Japanese encoding commonly used for e-mail), EUC (the
+ standard Unix encoding for Japanese and other languages), and
+ Compound Text (the encoding used in X11). You can specify more
+ specific information about the conversion with the FLAGS argument.
+'big5
+ Big5 (the encoding commonly used for Taiwanese).
+'ccl
+ The conversion is performed using a user-written pseudo-code
+ program. CCL (Code Conversion Language) is the name of this
+ pseudo-code.
+'internal
+ Write out or read in the raw contents of the memory representing
+ the buffer's text. This is primarily useful for debugging
+ purposes, and is only enabled when XEmacs has been compiled with
+ DEBUG_XEMACS defined (via the --debug configure option).
+ WARNING: Reading in a file using 'internal conversion can result
+ in an internal inconsistency in the memory representing a
+ buffer's text, which will produce unpredictable results and may
+ cause XEmacs to crash. Under normal circumstances you should
+ never use 'internal conversion.
+
+DOC-STRING is a string describing the coding system.
+
+PROPS is a property list, describing the specific nature of the
+character set. Recognized properties are:
+
+'mnemonic
+ String to be displayed in the modeline when this coding system is
+ active.
+
+'eol-type
+ End-of-line conversion to be used. It should be one of
+
+ nil
+ Automatically detect the end-of-line type (LF, CRLF,
+ or CR). Also generate subsidiary coding systems named
+ `NAME-unix', `NAME-dos', and `NAME-mac', that are
+ identical to this coding system but have an EOL-TYPE
+ value of 'lf, 'crlf, and 'cr, respectively.
+ 'lf
+ The end of a line is marked externally using ASCII LF.
+ Since this is also the way that XEmacs represents an
+ end-of-line internally, specifying this option results
+ in no end-of-line conversion. This is the standard
+ format for Unix text files.
+ 'crlf
+ The end of a line is marked externally using ASCII
+ CRLF. This is the standard format for MS-DOS text
+ files.
+ 'cr
+ The end of a line is marked externally using ASCII CR.
+ This is the standard format for Macintosh text files.
+ t
+ Automatically detect the end-of-line type but do not
+ generate subsidiary coding systems. (This value is
+ converted to nil when stored internally, and
+ `coding-system-property' will return nil.)
+
+'post-read-conversion
+ Function called after a file has been read in, to perform the
+ decoding. Called with two arguments, BEG and END, denoting
+ a region of the current buffer to be decoded.
+
+'pre-write-conversion
+ Function called before a file is written out, to perform the
+ encoding. Called with two arguments, BEG and END, denoting
+ a region of the current buffer to be encoded.
+
+
+The following additional properties are recognized if TYPE is 'iso2022:
+
+'charset-g0
+'charset-g1
+'charset-g2
+'charset-g3
+ The character set initially designated to the G0 - G3 registers.
+ The value should be one of
+
+ -- A charset object (designate that character set)
+ -- nil (do not ever use this register)
+ -- t (no character set is initially designated to
+ the register, but may be later on; this automatically
+ sets the corresponding `force-g*-on-output' property)
+
+'force-g0-on-output
+'force-g1-on-output
+'force-g2-on-output
+'force-g2-on-output
+ If non-nil, send an explicit designation sequence on output before
+ using the specified register.
+
+'short
+ If non-nil, use the short forms "ESC $ @", "ESC $ A", and
+ "ESC $ B" on output in place of the full designation sequences
+ "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B".
+
+'no-ascii-eol
+ If non-nil, don't designate ASCII to G0 at each end of line on output.
+ Setting this to non-nil also suppresses other state-resetting that
+ normally happens at the end of a line.
+
+'no-ascii-cntl
+ If non-nil, don't designate ASCII to G0 before control chars on output.
+
+'seven
+ If non-nil, use 7-bit environment on output. Otherwise, use 8-bit
+ environment.
+
+'lock-shift
+ If non-nil, use locking-shift (SO/SI) instead of single-shift
+ or designation by escape sequence.
+
+'no-iso6429
+ If non-nil, don't use ISO6429's direction specification.
+
+'escape-quoted
+ If non-nil, literal control characters that are the same as
+ the beginning of a recognized ISO2022 or ISO6429 escape sequence
+ (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E),
+ SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character
+ so that they can be properly distinguished from an escape sequence.
+ (Note that doing this results in a non-portable encoding.) This
+ encoding flag is used for byte-compiled files. Note that ESC
+ is a good choice for a quoting character because there are no
+ escape sequences whose second byte is a character from the Control-0
+ or Control-1 character sets; this is explicitly disallowed by the
+ ISO2022 standard.
+
+'input-charset-conversion
+ A list of conversion specifications, specifying conversion of
+ characters in one charset to another when decoding is performed.
+ Each specification is a list of two elements: the source charset,
+ and the destination charset.
+
+'output-charset-conversion
+ A list of conversion specifications, specifying conversion of
+ characters in one charset to another when encoding is performed.
+ The form of each specification is the same as for
+ 'input-charset-conversion.
+
+
+The following additional properties are recognized (and required)
+if TYPE is 'ccl:
+
+'decode
+ CCL program used for decoding (converting to internal format).
+
+'encode
+ CCL program used for encoding (converting to external format).
+*/
+ (name, type, doc_string, props))
+{
+ struct Lisp_Coding_System *codesys;
+ Lisp_Object rest, key, value;
+ enum coding_system_type ty;
+ int need_to_setup_eol_systems = 1;
+
+ /* Convert type to constant */
+ if (NILP (type) || EQ (type, Qundecided))
+ { ty = CODESYS_AUTODETECT; }
+ else if (EQ (type, Qshift_jis)) { ty = CODESYS_SHIFT_JIS; }
+ else if (EQ (type, Qiso2022)) { ty = CODESYS_ISO2022; }
+ else if (EQ (type, Qbig5)) { ty = CODESYS_BIG5; }
+ else if (EQ (type, Qccl)) { ty = CODESYS_CCL; }
+ else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; }
+#ifdef DEBUG_XEMACS
+ else if (EQ (type, Qinternal)) { ty = CODESYS_INTERNAL; }
+#endif
+ else
+ signal_simple_error ("Invalid coding system type", type);
+
+ CHECK_SYMBOL (name);
+
+ codesys = allocate_coding_system (ty, name);
+
+ if (NILP (doc_string))
+ doc_string = build_string ("");
+ else
+ CHECK_STRING (doc_string);
+ CODING_SYSTEM_DOC_STRING (codesys) = doc_string;
+
+ EXTERNAL_PROPERTY_LIST_LOOP (rest, key, value, props)
+ {
+ if (EQ (key, Qmnemonic))
+ {
+ if (!NILP (value))
+ CHECK_STRING (value);
+ CODING_SYSTEM_MNEMONIC (codesys) = value;
+ }
+
+ else if (EQ (key, Qeol_type))
+ {
+ need_to_setup_eol_systems = NILP (value);
+ if (EQ (value, Qt))
+ value = Qnil;
+ CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value);
+ }
+
+ else if (EQ (key, Qpost_read_conversion)) CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value;
+ else if (EQ (key, Qpre_write_conversion)) CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value;
+ else if (ty == CODESYS_ISO2022)
+ {
+#define FROB_INITIAL_CHARSET(charset_num) \
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \
+ ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value))
+
+ if (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
+ else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1);
+ else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2);
+ else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3);
+
+#define FROB_FORCE_CHARSET(charset_num) \
+ CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value)
+
+ else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0);
+ else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1);
+ else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2);
+ else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3);
+
+#define FROB_BOOLEAN_PROPERTY(prop) \
+ CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value)
+
+ else if (EQ (key, Qshort)) FROB_BOOLEAN_PROPERTY (SHORT);
+ else if (EQ (key, Qno_ascii_eol)) FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL);
+ else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL);
+ else if (EQ (key, Qseven)) FROB_BOOLEAN_PROPERTY (SEVEN);
+ else if (EQ (key, Qlock_shift)) FROB_BOOLEAN_PROPERTY (LOCK_SHIFT);
+ else if (EQ (key, Qno_iso6429)) FROB_BOOLEAN_PROPERTY (NO_ISO6429);
+ else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED);
+
+ else if (EQ (key, Qinput_charset_conversion))
+ {
+ codesys->iso2022.input_conv =
+ Dynarr_new (charset_conversion_spec);
+ parse_charset_conversion_specs (codesys->iso2022.input_conv,
+ value);
+ }
+ else if (EQ (key, Qoutput_charset_conversion))
+ {
+ codesys->iso2022.output_conv =
+ Dynarr_new (charset_conversion_spec);
+ parse_charset_conversion_specs (codesys->iso2022.output_conv,
+ value);
+ }
+ else
+ signal_simple_error ("Unrecognized property", key);
+ }
+ else if (EQ (type, Qccl))
+ {
+ if (EQ (key, Qdecode))
+ {
+ CHECK_VECTOR (value);
+ CODING_SYSTEM_CCL_DECODE (codesys) = value;
+ }
+ else if (EQ (key, Qencode))
+ {
+ CHECK_VECTOR (value);
+ CODING_SYSTEM_CCL_ENCODE (codesys) = value;
+ }
+ else
+ signal_simple_error ("Unrecognized property", key);
+ }
+ else
+ signal_simple_error ("Unrecognized property", key);
+ }
+
+ if (need_to_setup_eol_systems)
+ setup_eol_coding_systems (codesys);
+
+ {
+ Lisp_Object codesys_obj;
+ XSETCODING_SYSTEM (codesys_obj, codesys);
+ Fputhash (name, codesys_obj, Vcoding_system_hash_table);
+ return codesys_obj;
+ }
+}
+
+DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /*
+Copy OLD-CODING-SYSTEM to NEW-NAME.
+If NEW-NAME does not name an existing coding system, a new one will
+be created.
+*/
+ (old_coding_system, new_name))
+{
+ Lisp_Object new_coding_system;
+ old_coding_system = Fget_coding_system (old_coding_system);
+ new_coding_system = Ffind_coding_system (new_name);
+ if (NILP (new_coding_system))
+ {
+ XSETCODING_SYSTEM (new_coding_system,
+ allocate_coding_system
+ (XCODING_SYSTEM_TYPE (old_coding_system),
+ new_name));
+ Fputhash (new_name, new_coding_system, Vcoding_system_hash_table);
+ }
+
+ {
+ struct Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system);
+ struct Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system);
+ memcpy (((char *) to ) + sizeof (to->header),
+ ((char *) from) + sizeof (from->header),
+ sizeof (*from) - sizeof (from->header));
+ to->name = new_name;
+ }
+ return new_coding_system;
+}
+
+static Lisp_Object
+subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type)
+{
+ struct Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
+ Lisp_Object new_coding_system;
+
+ if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
+ return coding_system;
+
+ switch (type)
+ {
+ case EOL_AUTODETECT: return coding_system;
+ case EOL_LF: new_coding_system = CODING_SYSTEM_EOL_LF (cs); break;
+ case EOL_CR: new_coding_system = CODING_SYSTEM_EOL_CR (cs); break;
+ case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break;
+ default: abort ();
+ }
+
+ return NILP (new_coding_system) ? coding_system : new_coding_system;
+}
+
+DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /*
+Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE.
+*/
+ (coding_system, eol_type))
+{
+ coding_system = Fget_coding_system (coding_system);
+
+ return subsidiary_coding_system (coding_system,
+ symbol_to_eol_type (eol_type));
+}
+
+\f
+/************************************************************************/
+/* Coding system accessors */
+/************************************************************************/
+
+DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /*
+Return the doc string for CODING-SYSTEM.
+*/
+ (coding_system))
+{
+ coding_system = Fget_coding_system (coding_system);
+ return XCODING_SYSTEM_DOC_STRING (coding_system);
+}
+
+DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /*
+Return the type of CODING-SYSTEM.
+*/
+ (coding_system))
+{
+ switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system)))
+ {
+ case CODESYS_AUTODETECT: return Qundecided;
+ case CODESYS_SHIFT_JIS: return Qshift_jis;
+ case CODESYS_ISO2022: return Qiso2022;
+ case CODESYS_BIG5: return Qbig5;
+ case CODESYS_CCL: return Qccl;
+ case CODESYS_NO_CONVERSION: return Qno_conversion;
+#ifdef DEBUG_XEMACS
+ case CODESYS_INTERNAL: return Qinternal;
+#endif
+ default:
+ abort ();
+ }
+
+ return Qnil; /* not reached */
+}
+
+static
+Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum)
+{
+ Lisp_Object cs
+ = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum);
+
+ return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil;
+}
+
+DEFUN ("coding-system-charset", Fcoding_system_charset, 2, 2, 0, /*
+Return initial charset of CODING-SYSTEM designated to GNUM.
+GNUM allows 0 .. 3.
+*/
+ (coding_system, gnum))
+{
+ coding_system = Fget_coding_system (coding_system);
+ CHECK_INT (gnum);
+
+ return coding_system_charset (coding_system, XINT (gnum));
+}
+
+DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /*
+Return the PROP property of CODING-SYSTEM.
+*/
+ (coding_system, prop))
+{
+ int i, ok = 0;
+ enum coding_system_type type;
+
+ coding_system = Fget_coding_system (coding_system);
+ CHECK_SYMBOL (prop);
+ type = XCODING_SYSTEM_TYPE (coding_system);
+
+ for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++)
+ if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop))
+ {
+ ok = 1;
+ switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type)
+ {
+ case CODESYS_PROP_ALL_OK:
+ break;
+
+ case CODESYS_PROP_ISO2022:
+ if (type != CODESYS_ISO2022)
+ signal_simple_error
+ ("Property only valid in ISO2022 coding systems",
+ prop);
+ break;
+
+ case CODESYS_PROP_CCL:
+ if (type != CODESYS_CCL)
+ signal_simple_error
+ ("Property only valid in CCL coding systems",
+ prop);
+ break;
+
+ default:
+ abort ();
+ }
+ }
+
+ if (!ok)
+ signal_simple_error ("Unrecognized property", prop);
+
+ if (EQ (prop, Qname))
+ return XCODING_SYSTEM_NAME (coding_system);
+ else if (EQ (prop, Qtype))
+ return Fcoding_system_type (coding_system);
+ else if (EQ (prop, Qdoc_string))
+ return XCODING_SYSTEM_DOC_STRING (coding_system);
+ else if (EQ (prop, Qmnemonic))
+ return XCODING_SYSTEM_MNEMONIC (coding_system);
+ else if (EQ (prop, Qeol_type))
+ return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system));
+ else if (EQ (prop, Qeol_lf))
+ return XCODING_SYSTEM_EOL_LF (coding_system);
+ else if (EQ (prop, Qeol_crlf))
+ return XCODING_SYSTEM_EOL_CRLF (coding_system);
+ else if (EQ (prop, Qeol_cr))
+ return XCODING_SYSTEM_EOL_CR (coding_system);
+ else if (EQ (prop, Qpost_read_conversion))
+ return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system);
+ else if (EQ (prop, Qpre_write_conversion))
+ return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system);
+ else if (type == CODESYS_ISO2022)
+ {
+ if (EQ (prop, Qcharset_g0))
+ return coding_system_charset (coding_system, 0);
+ else if (EQ (prop, Qcharset_g1))
+ return coding_system_charset (coding_system, 1);
+ else if (EQ (prop, Qcharset_g2))
+ return coding_system_charset (coding_system, 2);
+ else if (EQ (prop, Qcharset_g3))
+ return coding_system_charset (coding_system, 3);
+
+#define FORCE_CHARSET(charset_num) \
+ (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \
+ (coding_system, charset_num) ? Qt : Qnil)
+
+ else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0);
+ else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1);
+ else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2);
+ else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3);
+
+#define LISP_BOOLEAN(prop) \
+ (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil)
+
+ else if (EQ (prop, Qshort)) return LISP_BOOLEAN (SHORT);
+ else if (EQ (prop, Qno_ascii_eol)) return LISP_BOOLEAN (NO_ASCII_EOL);
+ else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL);
+ else if (EQ (prop, Qseven)) return LISP_BOOLEAN (SEVEN);
+ else if (EQ (prop, Qlock_shift)) return LISP_BOOLEAN (LOCK_SHIFT);
+ else if (EQ (prop, Qno_iso6429)) return LISP_BOOLEAN (NO_ISO6429);
+ else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED);
+
+ else if (EQ (prop, Qinput_charset_conversion))
+ return
+ unparse_charset_conversion_specs
+ (XCODING_SYSTEM (coding_system)->iso2022.input_conv);
+ else if (EQ (prop, Qoutput_charset_conversion))
+ return
+ unparse_charset_conversion_specs
+ (XCODING_SYSTEM (coding_system)->iso2022.output_conv);
+ else
+ abort ();
+ }
+ else if (type == CODESYS_CCL)
+ {
+ if (EQ (prop, Qdecode))
+ return XCODING_SYSTEM_CCL_DECODE (coding_system);
+ else if (EQ (prop, Qencode))
+ return XCODING_SYSTEM_CCL_ENCODE (coding_system);
+ else
+ abort ();
+ }
+ else
+ abort ();
+
+ return Qnil; /* not reached */
+}
+
+\f
+/************************************************************************/
+/* Coding category functions */
+/************************************************************************/
+
+static int
+decode_coding_category (Lisp_Object symbol)
+{
+ int i;
+
+ CHECK_SYMBOL (symbol);
+ for (i = 0; i <= CODING_CATEGORY_LAST; i++)
+ if (EQ (coding_category_symbol[i], symbol))
+ return i;
+
+ signal_simple_error ("Unrecognized coding category", symbol);
+ return 0; /* not reached */
+}
+
+DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /*
+Return a list of all recognized coding categories.
+*/
+ ())
+{
+ int i;
+ Lisp_Object list = Qnil;
+
+ for (i = CODING_CATEGORY_LAST; i >= 0; i--)
+ list = Fcons (coding_category_symbol[i], list);
+ return list;
+}
+
+DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /*
+Change the priority order of the coding categories.
+LIST should be list of coding categories, in descending order of
+priority. Unspecified coding categories will be lower in priority
+than all specified ones, in the same relative order they were in
+previously.
+*/
+ (list))
+{
+ int category_to_priority[CODING_CATEGORY_LAST + 1];
+ int i, j;
+ Lisp_Object rest;
+
+ /* First generate a list that maps coding categories to priorities. */
+
+ for (i = 0; i <= CODING_CATEGORY_LAST; i++)
+ category_to_priority[i] = -1;
+
+ /* Highest priority comes from the specified list. */
+ i = 0;
+ EXTERNAL_LIST_LOOP (rest, list)
+ {
+ int cat = decode_coding_category (XCAR (rest));
+
+ if (category_to_priority[cat] >= 0)
+ signal_simple_error ("Duplicate coding category in list", XCAR (rest));
+ category_to_priority[cat] = i++;
+ }
+
+ /* Now go through the existing categories by priority to retrieve
+ the categories not yet specified and preserve their priority
+ order. */
+ for (j = 0; j <= CODING_CATEGORY_LAST; j++)
+ {
+ int cat = coding_category_by_priority[j];
+ if (category_to_priority[cat] < 0)
+ category_to_priority[cat] = i++;
+ }
+
+ /* Now we need to construct the inverse of the mapping we just
+ constructed. */
+
+ for (i = 0; i <= CODING_CATEGORY_LAST; i++)
+ coding_category_by_priority[category_to_priority[i]] = i;
+
+ /* Phew! That was confusing. */
+ return Qnil;
+}
+
+DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /*
+Return a list of coding categories in descending order of priority.
+*/
+ ())
+{
+ int i;
+ Lisp_Object list = Qnil;
+
+ for (i = CODING_CATEGORY_LAST; i >= 0; i--)
+ list = Fcons (coding_category_symbol[coding_category_by_priority[i]],
+ list);
+ return list;
+}
+
+DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /*
+Change the coding system associated with a coding category.
+*/
+ (coding_category, coding_system))
+{
+ int cat = decode_coding_category (coding_category);
+
+ coding_system = Fget_coding_system (coding_system);
+ coding_category_system[cat] = coding_system;
+ return Qnil;
+}
+
+DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /*
+Return the coding system associated with a coding category.
+*/
+ (coding_category))
+{
+ int cat = decode_coding_category (coding_category);
+ Lisp_Object sys = coding_category_system[cat];
+
+ if (!NILP (sys))
+ return XCODING_SYSTEM_NAME (sys);
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* Detecting the encoding of data */
+/************************************************************************/
+
+struct detection_state
+{
+ enum eol_type eol_type;
+ int seen_non_ascii;
+ int mask;
+
+ struct
+ {
+ int mask;
+ int in_second_byte;
+ }
+ big5;
+
+ struct
+ {
+ int mask;
+ int in_second_byte;
+ }
+ shift_jis;
+
+ struct
+ {
+ int mask;
+ int initted;
+ struct iso2022_decoder iso;
+ unsigned int flags;
+ int high_byte_count;
+ unsigned int saw_single_shift:1;
+ }
+ iso2022;
+
+ struct
+ {
+ int seen_anything;
+ int just_saw_cr;
+ }
+ eol;
+};
+
+static int
+acceptable_control_char_p (int c)
+{
+ switch (c)
+ {
+ /* Allow and ignore control characters that you might
+ reasonably see in a text file */
+ case '\r':
+ case '\n':
+ case '\t':
+ case 7: /* bell */
+ case 8: /* backspace */
+ case 11: /* vertical tab */
+ case 12: /* form feed */
+ case 26: /* MS-DOS C-z junk */
+ case 31: /* '^_' -- for info */
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+static int
+mask_has_at_most_one_bit_p (int mask)
+{
+ /* Perhaps the only thing useful you learn from intensive Microsoft
+ technical interviews */
+ return (mask & (mask - 1)) == 0;
+}
+
+static enum eol_type
+detect_eol_type (struct detection_state *st, CONST unsigned char *src,
+ unsigned int n)
+{
+ int c;
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == '\r')
+ st->eol.just_saw_cr = 1;
+ else
+ {
+ if (c == '\n')
+ {
+ if (st->eol.just_saw_cr)
+ return EOL_CRLF;
+ else if (st->eol.seen_anything)
+ return EOL_LF;
+ }
+ else if (st->eol.just_saw_cr)
+ return EOL_CR;
+ st->eol.just_saw_cr = 0;
+ }
+ st->eol.seen_anything = 1;
+ }
+
+ return EOL_AUTODETECT;
+}
+
+/* Attempt to determine the encoding and EOL type of the given text.
+ Before calling this function for the first type, you must initialize
+ st->eol_type as appropriate and initialize st->mask to ~0.
+
+ st->eol_type holds the determined EOL type, or EOL_AUTODETECT if
+ not yet known.
+
+ st->mask holds the determined coding category mask, or ~0 if only
+ ASCII has been seen so far.
+
+ Returns:
+
+ 0 == st->eol_type is EOL_AUTODETECT and/or more than coding category
+ is present in st->mask
+ 1 == definitive answers are here for both st->eol_type and st->mask
+*/
+
+static int
+detect_coding_type (struct detection_state *st, CONST unsigned char *src,
+ unsigned int n, int just_do_eol)
+{
+ int c;
+
+ if (st->eol_type == EOL_AUTODETECT)
+ st->eol_type = detect_eol_type (st, src, n);
+
+ if (just_do_eol)
+ return st->eol_type != EOL_AUTODETECT;
+
+ if (!st->seen_non_ascii)
+ {
+ for (; n; n--, src++)
+ {
+ c = *src;
+ if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80)
+ {
+ st->seen_non_ascii = 1;
+ st->shift_jis.mask = ~0;
+ st->big5.mask = ~0;
+ st->iso2022.mask = ~0;
+ break;
+ }
+ }
+ }
+
+ if (!n)
+ return 0;
+
+ if (!mask_has_at_most_one_bit_p (st->iso2022.mask))
+ st->iso2022.mask = detect_coding_iso2022 (st, src, n);
+ if (!mask_has_at_most_one_bit_p (st->shift_jis.mask))
+ st->shift_jis.mask = detect_coding_sjis (st, src, n);
+ if (!mask_has_at_most_one_bit_p (st->big5.mask))
+ st->big5.mask = detect_coding_big5 (st, src, n);
+
+ st->mask = st->iso2022.mask | st->shift_jis.mask | st->big5.mask;
+
+ {
+ int retval = mask_has_at_most_one_bit_p (st->mask);
+ st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK;
+ return retval && st->eol_type != EOL_AUTODETECT;
+ }
+}
+
+static Lisp_Object
+coding_system_from_mask (int mask)
+{
+ if (mask == ~0)
+ {
+ /* If the file was entirely or basically ASCII, use the
+ default value of `buffer-file-coding-system'. */
+ Lisp_Object retval =
+ XBUFFER (Vbuffer_defaults)->buffer_file_coding_system;
+ if (!NILP (retval))
+ {
+ retval = Ffind_coding_system (retval);
+ if (NILP (retval))
+ {
+ warn_when_safe
+ (Qbad_variable, Qwarning,
+ "Invalid `default-buffer-file-coding-system', set to nil");
+ XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil;
+ }
+ }
+ if (NILP (retval))
+ retval = Fget_coding_system (Qno_conversion);
+ return retval;
+ }
+ else
+ {
+ int i;
+ int cat = -1;
+
+ mask = postprocess_iso2022_mask (mask);
+
+ /* Look through the coding categories by priority and find
+ the first one that is allowed. */
+ for (i = 0; i <= CODING_CATEGORY_LAST; i++)
+ {
+ cat = coding_category_by_priority[i];
+ if ((mask & (1 << cat)) &&
+ !NILP (coding_category_system[cat]))
+ break;
+ }
+ if (cat >= 0)
+ return coding_category_system[cat];
+ else
+ return Fget_coding_system (Qno_conversion);
+ }
+}
+
+/* Given a seekable read stream and potential coding system and EOL type
+ as specified, do any autodetection that is called for. If the
+ coding system and/or EOL type are not autodetect, they will be left
+ alone; but this function will never return an autodetect coding system
+ or EOL type.
+
+ This function does not automatically fetch subsidiary coding systems;
+ that should be unnecessary with the explicit eol-type argument. */
+
+void
+determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out,
+ enum eol_type *eol_type_in_out)
+{
+ struct detection_state decst;
+
+ if (*eol_type_in_out == EOL_AUTODETECT)
+ *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out);
+
+ xzero (decst);
+ decst.eol_type = *eol_type_in_out;
+ decst.mask = ~0;
+
+ /* If autodetection is called for, do it now. */
+ if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT ||
+ *eol_type_in_out == EOL_AUTODETECT)
+ {
+
+ while (1)
+ {
+ unsigned char random_buffer[4096];
+ int nread;
+
+ nread = Lstream_read (stream, random_buffer, sizeof (random_buffer));
+ if (!nread)
+ break;
+ if (detect_coding_type (&decst, random_buffer, nread,
+ XCODING_SYSTEM_TYPE (*codesys_in_out) !=
+ CODESYS_AUTODETECT))
+ break;
+ }
+
+ *eol_type_in_out = decst.eol_type;
+ if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT)
+ *codesys_in_out = coding_system_from_mask (decst.mask);
+ }
+
+ /* If we absolutely can't determine the EOL type, just assume LF. */
+ if (*eol_type_in_out == EOL_AUTODETECT)
+ *eol_type_in_out = EOL_LF;
+
+ Lstream_rewind (stream);
+}
+
+DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /*
+Detect coding system of the text in the region between START and END.
+Returned a list of possible coding systems ordered by priority.
+If only ASCII characters are found, it returns 'undecided or one of
+its subsidiary coding systems according to a detected end-of-line
+type. Optional arg BUFFER defaults to the current buffer.
+*/
+ (start, end, buffer))
+{
+ Lisp_Object val = Qnil;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Bufpos b, e;
+ Lisp_Object instream, lb_instream;
+ Lstream *istr, *lb_istr;
+ struct detection_state decst;
+ struct gcpro gcpro1, gcpro2;
+
+ get_buffer_range_char (buf, start, end, &b, &e, 0);
+ lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0);
+ lb_istr = XLSTREAM (lb_instream);
+ instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary));
+ istr = XLSTREAM (instream);
+ GCPRO2 (instream, lb_instream);
+ xzero (decst);
+ decst.eol_type = EOL_AUTODETECT;
+ decst.mask = ~0;
+ while (1)
+ {
+ unsigned char random_buffer[4096];
+ int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer));
+
+ if (!nread)
+ break;
+ if (detect_coding_type (&decst, random_buffer, nread, 0))
+ break;
+ }
+
+ if (decst.mask == ~0)
+ val = subsidiary_coding_system (Fget_coding_system (Qundecided),
+ decst.eol_type);
+ else
+ {
+ int i;
+
+ val = Qnil;
+
+ decst.mask = postprocess_iso2022_mask (decst.mask);
+
+ for (i = CODING_CATEGORY_LAST; i >= 0; i--)
+ {
+ int sys = coding_category_by_priority[i];
+ if (decst.mask & (1 << sys))
+ {
+ Lisp_Object codesys = coding_category_system[sys];
+ if (!NILP (codesys))
+ codesys = subsidiary_coding_system (codesys, decst.eol_type);
+ val = Fcons (codesys, val);
+ }
+ }
+ }
+ Lstream_close (istr);
+ UNGCPRO;
+ Lstream_delete (istr);
+ Lstream_delete (lb_istr);
+ return val;
+}
+
+\f
+/************************************************************************/
+/* Converting to internal Mule format ("decoding") */
+/************************************************************************/
+
+/* A decoding stream is a stream used for decoding text (i.e.
+ converting from some external format to internal format).
+ The decoding-stream object keeps track of the actual coding
+ stream, the stream that is at the other end, and data that
+ needs to be persistent across the lifetime of the stream. */
+
+/* Handle the EOL stuff related to just-read-in character C.
+ EOL_TYPE is the EOL type of the coding stream.
+ FLAGS is the current value of FLAGS in the coding stream, and may
+ be modified by this macro. (The macro only looks at the
+ CODING_STATE_CR flag.) DST is the Dynarr to which the decoded
+ bytes are to be written. You need to also define a local goto
+ label "label_continue_loop" that is at the end of the main
+ character-reading loop.
+
+ If C is a CR character, then this macro handles it entirely and
+ jumps to label_continue_loop. Otherwise, this macro does not add
+ anything to DST, and continues normally. You should continue
+ processing C normally after this macro. */
+
+#define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst) \
+do { \
+ if (c == '\r') \
+ { \
+ if (eol_type == EOL_CR) \
+ Dynarr_add (dst, '\n'); \
+ else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \
+ Dynarr_add (dst, c); \
+ else \
+ flags |= CODING_STATE_CR; \
+ goto label_continue_loop; \
+ } \
+ else if (flags & CODING_STATE_CR) \
+ { /* eol_type == CODING_SYSTEM_EOL_CRLF */ \
+ if (c != '\n') \
+ Dynarr_add (dst, '\r'); \
+ flags &= ~CODING_STATE_CR; \
+ } \
+} while (0)
+
+/* C should be a binary character in the range 0 - 255; convert
+ to internal format and add to Dynarr DST. */
+
+#define DECODE_ADD_BINARY_CHAR(c, dst) \
+do { \
+ if (BYTE_ASCII_P (c)) \
+ Dynarr_add (dst, c); \
+ else if (BYTE_C1_P (c)) \
+ { \
+ Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \
+ Dynarr_add (dst, c + 0x20); \
+ } \
+ else \
+ { \
+ Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \
+ Dynarr_add (dst, c); \
+ } \
+} while (0)
+
+#define DECODE_OUTPUT_PARTIAL_CHAR(ch) \
+do { \
+ if (ch) \
+ { \
+ DECODE_ADD_BINARY_CHAR (ch, dst); \
+ ch = 0; \
+ } \
+} while (0)
+
+#define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \
+do { \
+ DECODE_OUTPUT_PARTIAL_CHAR (ch); \
+ if ((flags & CODING_STATE_END) && \
+ (flags & CODING_STATE_CR)) \
+ Dynarr_add (dst, '\r'); \
+} while (0)
+
+#define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding)
+
+struct decoding_stream
+{
+ /* Coding system that governs the conversion. */
+ struct Lisp_Coding_System *codesys;
+
+ /* Stream that we read the encoded data from or
+ write the decoded data to. */
+ Lstream *other_end;
+
+ /* If we are reading, then we can return only a fixed amount of
+ data, so if the conversion resulted in too much data, we store it
+ here for retrieval the next time around. */
+ unsigned_char_dynarr *runoff;
+
+ /* FLAGS holds flags indicating the current state of the decoding.
+ Some of these flags are dependent on the coding system. */
+ unsigned int flags;
+
+ /* CH holds a partially built-up character. Since we only deal
+ with one- and two-byte characters at the moment, we only use
+ this to store the first byte of a two-byte character. */
+ unsigned int ch;
+
+ /* EOL_TYPE specifies the type of end-of-line conversion that
+ currently applies. We need to keep this separate from the
+ EOL type stored in CODESYS because the latter might indicate
+ automatic EOL-type detection while the former will always
+ indicate a particular EOL type. */
+ enum eol_type eol_type;
+
+ /* Additional ISO2022 information. We define the structure above
+ because it's also needed by the detection routines. */
+ struct iso2022_decoder iso2022;
+
+ /* Additional information (the state of the running CCL program)
+ used by the CCL decoder. */
+ struct ccl_program ccl;
+
+ struct detection_state decst;
+};
+
+static int decoding_reader (Lstream *stream, unsigned char *data, size_t size);
+static int decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size);
+static int decoding_rewinder (Lstream *stream);
+static int decoding_seekable_p (Lstream *stream);
+static int decoding_flusher (Lstream *stream);
+static int decoding_closer (Lstream *stream);
+static Lisp_Object decoding_marker (Lisp_Object stream,
+ void (*markobj) (Lisp_Object));
+
+DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding,
+ sizeof (struct decoding_stream));
+
+static Lisp_Object
+decoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
+{
+ Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end;
+ Lisp_Object str_obj;
+
+ /* We do not need to mark the coding systems or charsets stored
+ within the stream because they are stored in a global list
+ and automatically marked. */
+
+ XSETLSTREAM (str_obj, str);
+ markobj (str_obj);
+ if (str->imp->marker)
+ return (str->imp->marker) (str_obj, markobj);
+ else
+ return Qnil;
+}
+
+/* Read SIZE bytes of data and store it into DATA. We are a decoding stream
+ so we read data from the other end, decode it, and store it into DATA. */
+
+static int
+decoding_reader (Lstream *stream, unsigned char *data, size_t size)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ unsigned char *orig_data = data;
+ int read_size;
+ int error_occurred = 0;
+
+ /* We need to interface to mule_decode(), which expects to take some
+ amount of data and store the result into a Dynarr. We have
+ mule_decode() store into str->runoff, and take data from there
+ as necessary. */
+
+ /* We loop until we have enough data, reading chunks from the other
+ end and decoding it. */
+ while (1)
+ {
+ /* Take data from the runoff if we can. Make sure to take at
+ most SIZE bytes, and delete the data from the runoff. */
+ if (Dynarr_length (str->runoff) > 0)
+ {
+ size_t chunk = min (size, (size_t) Dynarr_length (str->runoff));
+ memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
+ Dynarr_delete_many (str->runoff, 0, chunk);
+ data += chunk;
+ size -= chunk;
+ }
+
+ if (size == 0)
+ break; /* No more room for data */
+
+ if (str->flags & CODING_STATE_END)
+ /* This means that on the previous iteration, we hit the EOF on
+ the other end. We loop once more so that mule_decode() can
+ output any final stuff it may be holding, or any "go back
+ to a sane state" escape sequences. (This latter makes sense
+ during encoding.) */
+ break;
+
+ /* Exhausted the runoff, so get some more. DATA has at least
+ SIZE bytes left of storage in it, so it's OK to read directly
+ into it. (We'll be overwriting above, after we've decoded it
+ into the runoff.) */
+ read_size = Lstream_read (str->other_end, data, size);
+ if (read_size < 0)
+ {
+ error_occurred = 1;
+ break;
+ }
+ if (read_size == 0)
+ /* There might be some more end data produced in the translation.
+ See the comment above. */
+ str->flags |= CODING_STATE_END;
+ mule_decode (stream, data, str->runoff, read_size);
+ }
+
+ if (data - orig_data == 0)
+ return error_occurred ? -1 : 0;
+ else
+ return data - orig_data;
+}
+
+static int
+decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ int retval;
+
+ /* Decode all our data into the runoff, and then attempt to write
+ it all out to the other end. Remove whatever chunk we succeeded
+ in writing. */
+ mule_decode (stream, data, str->runoff, size);
+ retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
+ Dynarr_length (str->runoff));
+ if (retval > 0)
+ Dynarr_delete_many (str->runoff, 0, retval);
+ /* Do NOT return retval. The return value indicates how much
+ of the incoming data was written, not how many bytes were
+ written. */
+ return size;
+}
+
+static void
+reset_decoding_stream (struct decoding_stream *str)
+{
+ if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022)
+ {
+ Lisp_Object coding_system;
+ XSETCODING_SYSTEM (coding_system, str->codesys);
+ reset_iso2022 (coding_system, &str->iso2022);
+ }
+ else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL)
+ {
+ setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys));
+ }
+
+ str->flags = str->ch = 0;
+}
+
+static int
+decoding_rewinder (Lstream *stream)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ reset_decoding_stream (str);
+ Dynarr_reset (str->runoff);
+ return Lstream_rewind (str->other_end);
+}
+
+static int
+decoding_seekable_p (Lstream *stream)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ return Lstream_seekable_p (str->other_end);
+}
+
+static int
+decoding_flusher (Lstream *stream)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ return Lstream_flush (str->other_end);
+}
+
+static int
+decoding_closer (Lstream *stream)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+ if (stream->flags & LSTREAM_FL_WRITE)
+ {
+ str->flags |= CODING_STATE_END;
+ decoding_writer (stream, 0, 0);
+ }
+ Dynarr_free (str->runoff);
+ if (str->iso2022.composite_chars)
+ Dynarr_free (str->iso2022.composite_chars);
+ return Lstream_close (str->other_end);
+}
+
+Lisp_Object
+decoding_stream_coding_system (Lstream *stream)
+{
+ Lisp_Object coding_system;
+ struct decoding_stream *str = DECODING_STREAM_DATA (stream);
+
+ XSETCODING_SYSTEM (coding_system, str->codesys);
+ return subsidiary_coding_system (coding_system, str->eol_type);
+}
+
+void
+set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
+{
+ struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
+ struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
+ str->codesys = cs;
+ if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
+ str->eol_type = CODING_SYSTEM_EOL_TYPE (cs);
+ reset_decoding_stream (str);
+}
+
+/* WARNING WARNING WARNING WARNING!!!!! If you open up a decoding
+ stream for writing, no automatic code detection will be performed.
+ The reason for this is that automatic code detection requires a
+ seekable input. Things will also fail if you open a decoding
+ stream for reading using a non-fully-specified coding system and
+ a non-seekable input stream. */
+
+static Lisp_Object
+make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys,
+ CONST char *mode)
+{
+ Lstream *lstr = Lstream_new (lstream_decoding, mode);
+ struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
+ Lisp_Object obj;
+
+ xzero (*str);
+ str->other_end = stream;
+ str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char);
+ str->eol_type = EOL_AUTODETECT;
+ if (!strcmp (mode, "r")
+ && Lstream_seekable_p (stream))
+ /* We can determine the coding system now. */
+ determine_real_coding_system (stream, &codesys, &str->eol_type);
+ set_decoding_stream_coding_system (lstr, codesys);
+ str->decst.eol_type = str->eol_type;
+ str->decst.mask = ~0;
+ XSETLSTREAM (obj, lstr);
+ return obj;
+}
+
+Lisp_Object
+make_decoding_input_stream (Lstream *stream, Lisp_Object codesys)
+{
+ return make_decoding_stream_1 (stream, codesys, "r");
+}
+
+Lisp_Object
+make_decoding_output_stream (Lstream *stream, Lisp_Object codesys)
+{
+ return make_decoding_stream_1 (stream, codesys, "w");
+}
+
+/* Note: the decode_coding_* functions all take the same
+ arguments as mule_decode(), which is to say some SRC data of
+ size N, which is to be stored into dynamic array DST.
+ DECODING is the stream within which the decoding is
+ taking place, but no data is actually read from or
+ written to that stream; that is handled in decoding_reader()
+ or decoding_writer(). This allows the same functions to
+ be used for both reading and writing. */
+
+static void
+mule_decode (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
+
+ /* If necessary, do encoding-detection now. We do this when
+ we're a writing stream or a non-seekable reading stream,
+ meaning that we can't just process the whole input,
+ rewind, and start over. */
+
+ if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT ||
+ str->eol_type == EOL_AUTODETECT)
+ {
+ Lisp_Object codesys;
+
+ XSETCODING_SYSTEM (codesys, str->codesys);
+ detect_coding_type (&str->decst, src, n,
+ CODING_SYSTEM_TYPE (str->codesys) !=
+ CODESYS_AUTODETECT);
+ if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT &&
+ str->decst.mask != ~0)
+ /* #### This is cheesy. What we really ought to do is
+ buffer up a certain amount of data so as to get a
+ less random result. */
+ codesys = coding_system_from_mask (str->decst.mask);
+ str->eol_type = str->decst.eol_type;
+ if (XCODING_SYSTEM (codesys) != str->codesys)
+ {
+ /* Preserve the CODING_STATE_END flag in case it was set.
+ If we erase it, bad things might happen. */
+ int was_end = str->flags & CODING_STATE_END;
+ set_decoding_stream_coding_system (decoding, codesys);
+ if (was_end)
+ str->flags |= CODING_STATE_END;
+ }
+ }
+
+ switch (CODING_SYSTEM_TYPE (str->codesys))
+ {
+#ifdef DEBUG_XEMACS
+ case CODESYS_INTERNAL:
+ Dynarr_add_many (dst, src, n);
+ break;
+#endif
+ case CODESYS_AUTODETECT:
+ /* If we got this far and still haven't decided on the coding
+ system, then do no conversion. */
+ case CODESYS_NO_CONVERSION:
+ decode_coding_no_conversion (decoding, src, dst, n);
+ break;
+ case CODESYS_SHIFT_JIS:
+ decode_coding_sjis (decoding, src, dst, n);
+ break;
+ case CODESYS_BIG5:
+ decode_coding_big5 (decoding, src, dst, n);
+ break;
+ case CODESYS_CCL:
+ ccl_driver (&str->ccl, src, dst, n, 0);
+ break;
+ case CODESYS_ISO2022:
+ decode_coding_iso2022 (decoding, src, dst, n);
+ break;
+ default:
+ abort ();
+ }
+}
+
+DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /*
+Decode the text between START and END which is encoded in CODING-SYSTEM.
+This is useful if you've read in encoded text from a file without decoding
+it (e.g. you read in a JIS-formatted file but used the `binary' or
+`no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B").
+Return length of decoded text.
+BUFFER defaults to the current buffer if unspecified.
+*/
+ (start, end, coding_system, buffer))
+{
+ Bufpos b, e;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Lisp_Object instream, lb_outstream, de_outstream, outstream;
+ Lstream *istr, *ostr;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ get_buffer_range_char (buf, start, end, &b, &e, 0);
+
+ barf_if_buffer_read_only (buf, b, e);
+
+ coding_system = Fget_coding_system (coding_system);
+ instream = make_lisp_buffer_input_stream (buf, b, e, 0);
+ lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
+ de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
+ coding_system);
+ outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
+ Fget_coding_system (Qbinary));
+ istr = XLSTREAM (instream);
+ ostr = XLSTREAM (outstream);
+ GCPRO4 (instream, lb_outstream, de_outstream, outstream);
+
+ /* The chain of streams looks like this:
+
+ [BUFFER] <----- send through
+ ------> [ENCODE AS BINARY]
+ ------> [DECODE AS SPECIFIED]
+ ------> [BUFFER]
+ */
+
+ while (1)
+ {
+ char tempbuf[1024]; /* some random amount */
+ Bufpos newpos, even_newer_pos;
+ Bufpos oldpos = lisp_buffer_stream_startpos (istr);
+ int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
+
+ if (!size_in_bytes)
+ break;
+ newpos = lisp_buffer_stream_startpos (istr);
+ Lstream_write (ostr, tempbuf, size_in_bytes);
+ even_newer_pos = lisp_buffer_stream_startpos (istr);
+ buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
+ even_newer_pos, 0);
+ }
+ Lstream_close (istr);
+ Lstream_close (ostr);
+ UNGCPRO;
+ Lstream_delete (istr);
+ Lstream_delete (ostr);
+ Lstream_delete (XLSTREAM (de_outstream));
+ Lstream_delete (XLSTREAM (lb_outstream));
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* Converting to an external encoding ("encoding") */
+/************************************************************************/
+
+/* An encoding stream is an output stream. When you create the
+ stream, you specify the coding system that governs the encoding
+ and another stream that the resulting encoded data is to be
+ sent to, and then start sending data to it. */
+
+#define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding)
+
+struct encoding_stream
+{
+ /* Coding system that governs the conversion. */
+ struct Lisp_Coding_System *codesys;
+
+ /* Stream that we read the encoded data from or
+ write the decoded data to. */
+ Lstream *other_end;
+
+ /* If we are reading, then we can return only a fixed amount of
+ data, so if the conversion resulted in too much data, we store it
+ here for retrieval the next time around. */
+ unsigned_char_dynarr *runoff;
+
+ /* FLAGS holds flags indicating the current state of the encoding.
+ Some of these flags are dependent on the coding system. */
+ unsigned int flags;
+
+ /* CH holds a partially built-up character. Since we only deal
+ with one- and two-byte characters at the moment, we only use
+ this to store the first byte of a two-byte character. */
+ unsigned int ch;
+
+ /* Additional information used by the ISO2022 encoder. */
+ struct
+ {
+ /* CHARSET holds the character sets currently assigned to the G0
+ through G3 registers. It is initialized from the array
+ INITIAL_CHARSET in CODESYS. */
+ Lisp_Object charset[4];
+
+ /* Which registers are currently invoked into the left (GL) and
+ right (GR) halves of the 8-bit encoding space? */
+ int register_left, register_right;
+
+ /* Whether we need to explicitly designate the charset in the
+ G? register before using it. It is initialized from the
+ array FORCE_CHARSET_ON_OUTPUT in CODESYS. */
+ unsigned char force_charset_on_output[4];
+
+ /* Other state variables that need to be preserved across
+ invocations. */
+ Lisp_Object current_charset;
+ int current_half;
+ int current_char_boundary;
+ } iso2022;
+
+ /* Additional information (the state of the running CCL program)
+ used by the CCL encoder. */
+ struct ccl_program ccl;
+};
+
+static int encoding_reader (Lstream *stream, unsigned char *data, size_t size);
+static int encoding_writer (Lstream *stream, CONST unsigned char *data,
+ size_t size);
+static int encoding_rewinder (Lstream *stream);
+static int encoding_seekable_p (Lstream *stream);
+static int encoding_flusher (Lstream *stream);
+static int encoding_closer (Lstream *stream);
+static Lisp_Object encoding_marker (Lisp_Object stream,
+ void (*markobj) (Lisp_Object));
+
+DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding,
+ sizeof (struct encoding_stream));
+
+static Lisp_Object
+encoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
+{
+ Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end;
+ Lisp_Object str_obj;
+
+ /* We do not need to mark the coding systems or charsets stored
+ within the stream because they are stored in a global list
+ and automatically marked. */
+
+ XSETLSTREAM (str_obj, str);
+ markobj (str_obj);
+ if (str->imp->marker)
+ return (str->imp->marker) (str_obj, markobj);
+ else
+ return Qnil;
+}
+
+/* Read SIZE bytes of data and store it into DATA. We are a encoding stream
+ so we read data from the other end, encode it, and store it into DATA. */
+
+static int
+encoding_reader (Lstream *stream, unsigned char *data, size_t size)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ unsigned char *orig_data = data;
+ int read_size;
+ int error_occurred = 0;
+
+ /* We need to interface to mule_encode(), which expects to take some
+ amount of data and store the result into a Dynarr. We have
+ mule_encode() store into str->runoff, and take data from there
+ as necessary. */
+
+ /* We loop until we have enough data, reading chunks from the other
+ end and encoding it. */
+ while (1)
+ {
+ /* Take data from the runoff if we can. Make sure to take at
+ most SIZE bytes, and delete the data from the runoff. */
+ if (Dynarr_length (str->runoff) > 0)
+ {
+ int chunk = min ((int) size, Dynarr_length (str->runoff));
+ memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
+ Dynarr_delete_many (str->runoff, 0, chunk);
+ data += chunk;
+ size -= chunk;
+ }
+
+ if (size == 0)
+ break; /* No more room for data */
+
+ if (str->flags & CODING_STATE_END)
+ /* This means that on the previous iteration, we hit the EOF on
+ the other end. We loop once more so that mule_encode() can
+ output any final stuff it may be holding, or any "go back
+ to a sane state" escape sequences. (This latter makes sense
+ during encoding.) */
+ break;
+
+ /* Exhausted the runoff, so get some more. DATA at least SIZE bytes
+ left of storage in it, so it's OK to read directly into it.
+ (We'll be overwriting above, after we've encoded it into the
+ runoff.) */
+ read_size = Lstream_read (str->other_end, data, size);
+ if (read_size < 0)
+ {
+ error_occurred = 1;
+ break;
+ }
+ if (read_size == 0)
+ /* There might be some more end data produced in the translation.
+ See the comment above. */
+ str->flags |= CODING_STATE_END;
+ mule_encode (stream, data, str->runoff, read_size);
+ }
+
+ if (data == orig_data)
+ return error_occurred ? -1 : 0;
+ else
+ return data - orig_data;
+}
+
+static int
+encoding_writer (Lstream *stream, CONST unsigned char *data, size_t size)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ int retval;
+
+ /* Encode all our data into the runoff, and then attempt to write
+ it all out to the other end. Remove whatever chunk we succeeded
+ in writing. */
+ mule_encode (stream, data, str->runoff, size);
+ retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
+ Dynarr_length (str->runoff));
+ if (retval > 0)
+ Dynarr_delete_many (str->runoff, 0, retval);
+ /* Do NOT return retval. The return value indicates how much
+ of the incoming data was written, not how many bytes were
+ written. */
+ return size;
+}
+
+static void
+reset_encoding_stream (struct encoding_stream *str)
+{
+ switch (CODING_SYSTEM_TYPE (str->codesys))
+ {
+ case CODESYS_ISO2022:
+ {
+ int i;
+
+ for (i = 0; i < 4; i++)
+ {
+ str->iso2022.charset[i] =
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i);
+ str->iso2022.force_charset_on_output[i] =
+ CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i);
+ }
+ str->iso2022.register_left = 0;
+ str->iso2022.register_right = 1;
+ str->iso2022.current_charset = Qnil;
+ str->iso2022.current_half = 0;
+ str->iso2022.current_char_boundary = 1;
+ break;
+ }
+ case CODESYS_CCL:
+ setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys));
+ break;
+ default:
+ break;
+ }
+
+ str->flags = str->ch = 0;
+}
+
+static int
+encoding_rewinder (Lstream *stream)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ reset_encoding_stream (str);
+ Dynarr_reset (str->runoff);
+ return Lstream_rewind (str->other_end);
+}
+
+static int
+encoding_seekable_p (Lstream *stream)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ return Lstream_seekable_p (str->other_end);
+}
+
+static int
+encoding_flusher (Lstream *stream)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ return Lstream_flush (str->other_end);
+}
+
+static int
+encoding_closer (Lstream *stream)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+ if (stream->flags & LSTREAM_FL_WRITE)
+ {
+ str->flags |= CODING_STATE_END;
+ encoding_writer (stream, 0, 0);
+ }
+ Dynarr_free (str->runoff);
+ return Lstream_close (str->other_end);
+}
+
+Lisp_Object
+encoding_stream_coding_system (Lstream *stream)
+{
+ Lisp_Object coding_system;
+ struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
+
+ XSETCODING_SYSTEM (coding_system, str->codesys);
+ return coding_system;
+}
+
+void
+set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
+{
+ struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
+ struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
+ str->codesys = cs;
+ reset_encoding_stream (str);
+}
+
+static Lisp_Object
+make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys,
+ CONST char *mode)
+{
+ Lstream *lstr = Lstream_new (lstream_encoding, mode);
+ struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
+ Lisp_Object obj;
+
+ xzero (*str);
+ str->runoff = Dynarr_new (unsigned_char);
+ str->other_end = stream;
+ set_encoding_stream_coding_system (lstr, codesys);
+ XSETLSTREAM (obj, lstr);
+ return obj;
+}
+
+Lisp_Object
+make_encoding_input_stream (Lstream *stream, Lisp_Object codesys)
+{
+ return make_encoding_stream_1 (stream, codesys, "r");
+}
+
+Lisp_Object
+make_encoding_output_stream (Lstream *stream, Lisp_Object codesys)
+{
+ return make_encoding_stream_1 (stream, codesys, "w");
+}
+
+/* Convert N bytes of internally-formatted data stored in SRC to an
+ external format, according to the encoding stream ENCODING.
+ Store the encoded data into DST. */
+
+static void
+mule_encode (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
+
+ switch (CODING_SYSTEM_TYPE (str->codesys))
+ {
+#ifdef DEBUG_XEMACS
+ case CODESYS_INTERNAL:
+ Dynarr_add_many (dst, src, n);
+ break;
+#endif
+ case CODESYS_AUTODETECT:
+ /* If we got this far and still haven't decided on the coding
+ system, then do no conversion. */
+ case CODESYS_NO_CONVERSION:
+ encode_coding_no_conversion (encoding, src, dst, n);
+ break;
+ case CODESYS_SHIFT_JIS:
+ encode_coding_sjis (encoding, src, dst, n);
+ break;
+ case CODESYS_BIG5:
+ encode_coding_big5 (encoding, src, dst, n);
+ break;
+ case CODESYS_CCL:
+ ccl_driver (&str->ccl, src, dst, n, 0);
+ break;
+ case CODESYS_ISO2022:
+ encode_coding_iso2022 (encoding, src, dst, n);
+ break;
+ default:
+ abort ();
+ }
+}
+
+DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /*
+Encode the text between START and END using CODING-SYSTEM.
+This will, for example, convert Japanese characters into stuff such as
+"^[$B!<!+^[(B" if you use the JIS encoding. Return length of encoded
+text. BUFFER defaults to the current buffer if unspecified.
+*/
+ (start, end, coding_system, buffer))
+{
+ Bufpos b, e;
+ struct buffer *buf = decode_buffer (buffer, 0);
+ Lisp_Object instream, lb_outstream, de_outstream, outstream;
+ Lstream *istr, *ostr;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ get_buffer_range_char (buf, start, end, &b, &e, 0);
+
+ barf_if_buffer_read_only (buf, b, e);
+
+ coding_system = Fget_coding_system (coding_system);
+ instream = make_lisp_buffer_input_stream (buf, b, e, 0);
+ lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
+ de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
+ Fget_coding_system (Qbinary));
+ outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
+ coding_system);
+ istr = XLSTREAM (instream);
+ ostr = XLSTREAM (outstream);
+ GCPRO4 (instream, outstream, de_outstream, lb_outstream);
+ /* The chain of streams looks like this:
+
+ [BUFFER] <----- send through
+ ------> [ENCODE AS SPECIFIED]
+ ------> [DECODE AS BINARY]
+ ------> [BUFFER]
+ */
+ while (1)
+ {
+ char tempbuf[1024]; /* some random amount */
+ Bufpos newpos, even_newer_pos;
+ Bufpos oldpos = lisp_buffer_stream_startpos (istr);
+ int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
+
+ if (!size_in_bytes)
+ break;
+ newpos = lisp_buffer_stream_startpos (istr);
+ Lstream_write (ostr, tempbuf, size_in_bytes);
+ even_newer_pos = lisp_buffer_stream_startpos (istr);
+ buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
+ even_newer_pos, 0);
+ }
+
+ {
+ Charcount retlen =
+ lisp_buffer_stream_startpos (XLSTREAM (instream)) - b;
+ Lstream_close (istr);
+ Lstream_close (ostr);
+ UNGCPRO;
+ Lstream_delete (istr);
+ Lstream_delete (ostr);
+ Lstream_delete (XLSTREAM (de_outstream));
+ Lstream_delete (XLSTREAM (lb_outstream));
+ return make_int (retlen);
+ }
+}
+
+\f
+/************************************************************************/
+/* Shift-JIS methods */
+/************************************************************************/
+
+/* Shift-JIS is a coding system encoding three character sets: ASCII, right
+ half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
+ as is. A character of JISX0201-Kana (TYPE94 character set) is
+ encoded by "position-code + 0x80". A character of JISX0208
+ (TYPE94x94 character set) is encoded in 2-byte but two
+ position-codes are divided and shifted so that it fit in the range
+ below.
+
+ --- CODE RANGE of Shift-JIS ---
+ (character set) (range)
+ ASCII 0x00 .. 0x7F
+ JISX0201-Kana 0xA0 .. 0xDF
+ JISX0208 (1st byte) 0x80 .. 0x9F and 0xE0 .. 0xEF
+ (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
+ -------------------------------
+
+*/
+
+/* Is this the first byte of a Shift-JIS two-byte char? */
+
+#define BYTE_SJIS_TWO_BYTE_1_P(c) \
+ (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF))
+
+/* Is this the second byte of a Shift-JIS two-byte char? */
+
+#define BYTE_SJIS_TWO_BYTE_2_P(c) \
+ (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC))
+
+#define BYTE_SJIS_KATAKANA_P(c) \
+ ((c) >= 0xA1 && (c) <= 0xDF)
+
+static int
+detect_coding_sjis (struct detection_state *st, CONST unsigned char *src,
+ unsigned int n)
+{
+ int c;
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ return 0;
+ if (st->shift_jis.in_second_byte)
+ {
+ st->shift_jis.in_second_byte = 0;
+ if (c < 0x40)
+ return 0;
+ }
+ else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
+ st->shift_jis.in_second_byte = 1;
+ }
+ return CODING_CATEGORY_SHIFT_JIS_MASK;
+}
+
+/* Convert Shift-JIS data to internal format. */
+
+static void
+decode_coding_sjis (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+ struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = str->eol_type;
+
+ while (n--)
+ {
+ c = *src++;
+
+ if (ch)
+ {
+ /* Previous character was first byte of Shift-JIS Kanji char. */
+ if (BYTE_SJIS_TWO_BYTE_2_P (c))
+ {
+ unsigned char e1, e2;
+
+ Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
+ DECODE_SJIS (ch, c, e1, e2);
+ Dynarr_add (dst, e1);
+ Dynarr_add (dst, e2);
+ }
+ else
+ {
+ DECODE_ADD_BINARY_CHAR (ch, dst);
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ ch = 0;
+ }
+ else
+ {
+ DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
+ if (BYTE_SJIS_TWO_BYTE_1_P (c))
+ ch = c;
+ else if (BYTE_SJIS_KATAKANA_P (c))
+ {
+ Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201);
+ Dynarr_add (dst, c);
+ }
+ else
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ label_continue_loop:;
+ }
+
+ DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+/* Convert internally-formatted data to Shift-JIS. */
+
+static void
+encode_coding_sjis (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == '\n')
+ {
+ if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
+ Dynarr_add (dst, '\r');
+ if (eol_type != EOL_CR)
+ Dynarr_add (dst, '\n');
+ ch = 0;
+ }
+ else if (BYTE_ASCII_P (c))
+ {
+ Dynarr_add (dst, c);
+ ch = 0;
+ }
+ else if (BUFBYTE_LEADING_BYTE_P (c))
+ ch = (c == LEADING_BYTE_KATAKANA_JISX0201 ||
+ c == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
+ c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0;
+ else if (ch)
+ {
+ if (ch == LEADING_BYTE_KATAKANA_JISX0201)
+ {
+ Dynarr_add (dst, c);
+ ch = 0;
+ }
+ else if (ch == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
+ ch == LEADING_BYTE_JAPANESE_JISX0208)
+ ch = c;
+ else
+ {
+ unsigned char j1, j2;
+ ENCODE_SJIS (ch, c, j1, j2);
+ Dynarr_add (dst, j1);
+ Dynarr_add (dst, j2);
+ ch = 0;
+ }
+ }
+ }
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /*
+Decode a JISX0208 character of Shift-JIS coding-system.
+CODE is the character code in Shift-JIS as a cons of type bytes.
+Return the corresponding character.
+*/
+ (code))
+{
+ unsigned char c1, c2, s1, s2;
+
+ CHECK_CONS (code);
+ CHECK_INT (XCAR (code));
+ CHECK_INT (XCDR (code));
+ s1 = XINT (XCAR (code));
+ s2 = XINT (XCDR (code));
+ if (BYTE_SJIS_TWO_BYTE_1_P (s1) &&
+ BYTE_SJIS_TWO_BYTE_2_P (s2))
+ {
+ DECODE_SJIS (s1, s2, c1, c2);
+ return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208,
+ c1 & 0x7F, c2 & 0x7F));
+ }
+ else
+ return Qnil;
+}
+
+DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /*
+Encode a JISX0208 character CHAR to SHIFT-JIS coding-system.
+Return the corresponding character code in SHIFT-JIS as a cons of two bytes.
+*/
+ (ch))
+{
+ Lisp_Object charset;
+ int c1, c2, s1, s2;
+
+ CHECK_CHAR_COERCE_INT (ch);
+ BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
+ if (EQ (charset, Vcharset_japanese_jisx0208))
+ {
+ ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
+ return Fcons (make_int (s1), make_int (s2));
+ }
+ else
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* Big5 methods */
+/************************************************************************/
+
+/* BIG5 is a coding system encoding two character sets: ASCII and
+ Big5. An ASCII character is encoded as is. Big5 is a two-byte
+ character set and is encoded in two-byte.
+
+ --- CODE RANGE of BIG5 ---
+ (character set) (range)
+ ASCII 0x00 .. 0x7F
+ Big5 (1st byte) 0xA1 .. 0xFE
+ (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
+ --------------------------
+
+ Since the number of characters in Big5 is larger than maximum
+ characters in Emacs' charset (96x96), it can't be handled as one
+ charset. So, in Emacs, Big5 is divided into two: `charset-big5-1'
+ and `charset-big5-2'. Both <type>s are TYPE94x94. The former
+ contains frequently used characters and the latter contains less
+ frequently used characters. */
+
+#define BYTE_BIG5_TWO_BYTE_1_P(c) \
+ ((c) >= 0xA1 && (c) <= 0xFE)
+
+/* Is this the second byte of a Shift-JIS two-byte char? */
+
+#define BYTE_BIG5_TWO_BYTE_2_P(c) \
+ (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE))
+
+/* Number of Big5 characters which have the same code in 1st byte. */
+
+#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
+
+/* Code conversion macros. These are macros because they are used in
+ inner loops during code conversion.
+
+ Note that temporary variables in macros introduce the classic
+ dynamic-scoping problems with variable names. We use capital-
+ lettered variables in the assumption that XEmacs does not use
+ capital letters in variables except in a very formalized way
+ (e.g. Qstring). */
+
+/* Convert Big5 code (b1, b2) into its internal string representation
+ (lb, c1, c2). */
+
+/* There is a much simpler way to split the Big5 charset into two.
+ For the moment I'm going to leave the algorithm as-is because it
+ claims to separate out the most-used characters into a single
+ charset, which perhaps will lead to optimizations in various
+ places.
+
+ The way the algorithm works is something like this:
+
+ Big5 can be viewed as a 94x157 charset, where the row is
+ encoded into the bytes 0xA1 .. 0xFE and the column is encoded
+ into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE. As for frequency,
+ the split between low and high column numbers is apparently
+ meaningless; ascending rows produce less and less frequent chars.
+ Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to
+ the first charset, and the upper half (0xC9 .. 0xFE) to the
+ second. To do the conversion, we convert the character into
+ a single number where 0 .. 156 is the first row, 157 .. 313
+ is the second, etc. That way, the characters are ordered by
+ decreasing frequency. Then we just chop the space in two
+ and coerce the result into a 94x94 space.
+ */
+
+#define DECODE_BIG5(b1, b2, lb, c1, c2) do \
+{ \
+ int B1 = b1, B2 = b2; \
+ unsigned int I \
+ = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62); \
+ \
+ if (B1 < 0xC9) \
+ { \
+ lb = LEADING_BYTE_CHINESE_BIG5_1; \
+ } \
+ else \
+ { \
+ lb = LEADING_BYTE_CHINESE_BIG5_2; \
+ I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1); \
+ } \
+ c1 = I / (0xFF - 0xA1) + 0xA1; \
+ c2 = I % (0xFF - 0xA1) + 0xA1; \
+} while (0)
+
+/* Convert the internal string representation of a Big5 character
+ (lb, c1, c2) into Big5 code (b1, b2). */
+
+#define ENCODE_BIG5(lb, c1, c2, b1, b2) do \
+{ \
+ unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1); \
+ \
+ if (lb == LEADING_BYTE_CHINESE_BIG5_2) \
+ { \
+ I += BIG5_SAME_ROW * (0xC9 - 0xA1); \
+ } \
+ b1 = I / BIG5_SAME_ROW + 0xA1; \
+ b2 = I % BIG5_SAME_ROW; \
+ b2 += b2 < 0x3F ? 0x40 : 0x62; \
+} while (0)
+
+static int
+detect_coding_big5 (struct detection_state *st, CONST unsigned char *src,
+ unsigned int n)
+{
+ int c;
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO ||
+ (c >= 0x80 && c <= 0xA0))
+ return 0;
+ if (st->big5.in_second_byte)
+ {
+ st->big5.in_second_byte = 0;
+ if (c < 0x40 || (c >= 0x80 && c <= 0xA0))
+ return 0;
+ }
+ else if (c >= 0xA1)
+ st->big5.in_second_byte = 1;
+ }
+ return CODING_CATEGORY_BIG5_MASK;
+}
+
+/* Convert Big5 data to internal format. */
+
+static void
+decode_coding_big5 (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+ struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = str->eol_type;
+
+ while (n--)
+ {
+ c = *src++;
+ if (ch)
+ {
+ /* Previous character was first byte of Big5 char. */
+ if (BYTE_BIG5_TWO_BYTE_2_P (c))
+ {
+ unsigned char b1, b2, b3;
+ DECODE_BIG5 (ch, c, b1, b2, b3);
+ Dynarr_add (dst, b1);
+ Dynarr_add (dst, b2);
+ Dynarr_add (dst, b3);
+ }
+ else
+ {
+ DECODE_ADD_BINARY_CHAR (ch, dst);
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ ch = 0;
+ }
+ else
+ {
+ DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
+ if (BYTE_BIG5_TWO_BYTE_1_P (c))
+ ch = c;
+ else
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ label_continue_loop:;
+ }
+
+ DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+/* Convert internally-formatted data to Big5. */
+
+static void
+encode_coding_big5 (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == '\n')
+ {
+ if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
+ Dynarr_add (dst, '\r');
+ if (eol_type != EOL_CR)
+ Dynarr_add (dst, '\n');
+ }
+ else if (BYTE_ASCII_P (c))
+ {
+ /* ASCII. */
+ Dynarr_add (dst, c);
+ }
+ else if (BUFBYTE_LEADING_BYTE_P (c))
+ {
+ if (c == LEADING_BYTE_CHINESE_BIG5_1 ||
+ c == LEADING_BYTE_CHINESE_BIG5_2)
+ {
+ /* A recognized leading byte. */
+ ch = c;
+ continue; /* not done with this character. */
+ }
+ /* otherwise just ignore this character. */
+ }
+ else if (ch == LEADING_BYTE_CHINESE_BIG5_1 ||
+ ch == LEADING_BYTE_CHINESE_BIG5_2)
+ {
+ /* Previous char was a recognized leading byte. */
+ ch = (ch << 8) | c;
+ continue; /* not done with this character. */
+ }
+ else if (ch)
+ {
+ /* Encountering second byte of a Big5 character. */
+ unsigned char b1, b2;
+
+ ENCODE_BIG5 (ch >> 8, ch & 0xFF, c, b1, b2);
+ Dynarr_add (dst, b1);
+ Dynarr_add (dst, b2);
+ }
+
+ ch = 0;
+ }
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+
+DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /*
+Decode a Big5 character CODE of BIG5 coding-system.
+CODE is the character code in BIG5, a cons of two integers.
+Return the corresponding character.
+*/
+ (code))
+{
+ unsigned char c1, c2, b1, b2;
+
+ CHECK_CONS (code);
+ CHECK_INT (XCAR (code));
+ CHECK_INT (XCDR (code));
+ b1 = XINT (XCAR (code));
+ b2 = XINT (XCDR (code));
+ if (BYTE_BIG5_TWO_BYTE_1_P (b1) &&
+ BYTE_BIG5_TWO_BYTE_2_P (b2))
+ {
+ int leading_byte;
+ Lisp_Object charset;
+ DECODE_BIG5 (b1, b2, leading_byte, c1, c2);
+ charset = CHARSET_BY_LEADING_BYTE (leading_byte);
+ return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F));
+ }
+ else
+ return Qnil;
+}
+
+DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /*
+Encode the Big5 character CH to BIG5 coding-system.
+Return the corresponding character code in Big5.
+*/
+ (ch))
+{
+ Lisp_Object charset;
+ int c1, c2, b1, b2;
+
+ CHECK_CHAR_COERCE_INT (ch);
+ BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
+ if (EQ (charset, Vcharset_chinese_big5_1) ||
+ EQ (charset, Vcharset_chinese_big5_2))
+ {
+ ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80,
+ b1, b2);
+ return Fcons (make_int (b1), make_int (b2));
+ }
+ else
+ return Qnil;
+}
+
+\f
+/************************************************************************/
+/* ISO2022 methods */
+/************************************************************************/
+
+/* The following note describes the coding system ISO2022 briefly.
+ Since the intention of this note is to help understanding of the
+ programs in this file, some parts are NOT ACCURATE or OVERLY
+ SIMPLIFIED. For thorough understanding, please refer to the
+ original document of ISO2022.
+
+ ISO2022 provides many mechanisms to encode several character sets
+ in 7-bit and 8-bit environments. If one chooses 7-bit environment,
+ all text is encoded by codes of less than 128. This may make the
+ encoded text a little bit longer, but the text get more stability
+ to pass through several gateways (some of them strip off MSB).
+
+ There are two kind of character sets: control character set and
+ graphic character set. The former contains control characters such
+ as `newline' and `escape' to provide control functions (control
+ functions are provided also by escape sequence). The latter
+ contains graphic characters such as 'A' and '-'. Emacs recognizes
+ two control character sets and many graphic character sets.
+
+ Graphic character sets are classified into one of four types,
+ according to the dimension and number of characters in the set:
+ TYPE94, TYPE96, TYPE94x94, and TYPE96x96. In addition, each
+ character set is assigned an identification byte, unique for each
+ type, called "final character" (denoted as <F> hereafter). The <F>
+ of each character set is decided by ECMA(*) when it is registered
+ in ISO. Code range of <F> is 0x30..0x7F (0x30..0x3F are for
+ private use only).
+
+ Note (*): ECMA = European Computer Manufacturers Association
+
+ Here are examples of graphic character set [NAME(<F>)]:
+ o TYPE94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
+ o TYPE96 -- right-half-of-ISO8859-1('A'), ...
+ o TYPE94x94 -- GB2312('A'), JISX0208('B'), ...
+ o TYPE96x96 -- none for the moment
+
+ A code area (1byte=8bits) is divided into 4 areas, C0, GL, C1, and GR.
+ C0 [0x00..0x1F] -- control character plane 0
+ GL [0x20..0x7F] -- graphic character plane 0
+ C1 [0x80..0x9F] -- control character plane 1
+ GR [0xA0..0xFF] -- graphic character plane 1
+
+ A control character set is directly designated and invoked to C0 or
+ C1 by an escape sequence. The most common case is that:
+ - ISO646's control character set is designated/invoked to C0, and
+ - ISO6429's control character set is designated/invoked to C1,
+ and usually these designations/invocations are omitted in encoded
+ text. In a 7-bit environment, only C0 can be used, and a control
+ character for C1 is encoded by an appropriate escape sequence to
+ fit into the environment. All control characters for C1 are
+ defined to have corresponding escape sequences.
+
+ A graphic character set is at first designated to one of four
+ graphic registers (G0 through G3), then these graphic registers are
+ invoked to GL or GR. These designations and invocations can be
+ done independently. The most common case is that G0 is invoked to
+ GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
+ these invocations and designations are omitted in encoded text.
+ In a 7-bit environment, only GL can be used.
+
+ When a graphic character set of TYPE94 or TYPE94x94 is invoked to
+ GL, codes 0x20 and 0x7F of the GL area work as control characters
+ SPACE and DEL respectively, and code 0xA0 and 0xFF of GR area
+ should not be used.
+
+ There are two ways of invocation: locking-shift and single-shift.
+ With locking-shift, the invocation lasts until the next different
+ invocation, whereas with single-shift, the invocation works only
+ for the following character and doesn't affect locking-shift.
+ Invocations are done by the following control characters or escape
+ sequences.
+
+ ----------------------------------------------------------------------
+ abbrev function cntrl escape seq description
+ ----------------------------------------------------------------------
+ SI/LS0 (shift-in) 0x0F none invoke G0 into GL
+ SO/LS1 (shift-out) 0x0E none invoke G1 into GL
+ LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR
+ LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
+ LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR
+ LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
+ LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR
+ SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
+ SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
+ ----------------------------------------------------------------------
+ The first four are for locking-shift. Control characters for these
+ functions are defined by macros ISO_CODE_XXX in `coding.h'.
+
+ Designations are done by the following escape sequences.
+ ----------------------------------------------------------------------
+ escape sequence description
+ ----------------------------------------------------------------------
+ ESC '(' <F> designate TYPE94<F> to G0
+ ESC ')' <F> designate TYPE94<F> to G1
+ ESC '*' <F> designate TYPE94<F> to G2
+ ESC '+' <F> designate TYPE94<F> to G3
+ ESC ',' <F> designate TYPE96<F> to G0 (*)
+ ESC '-' <F> designate TYPE96<F> to G1
+ ESC '.' <F> designate TYPE96<F> to G2
+ ESC '/' <F> designate TYPE96<F> to G3
+ ESC '$' '(' <F> designate TYPE94x94<F> to G0 (**)
+ ESC '$' ')' <F> designate TYPE94x94<F> to G1
+ ESC '$' '*' <F> designate TYPE94x94<F> to G2
+ ESC '$' '+' <F> designate TYPE94x94<F> to G3
+ ESC '$' ',' <F> designate TYPE96x96<F> to G0 (*)
+ ESC '$' '-' <F> designate TYPE96x96<F> to G1
+ ESC '$' '.' <F> designate TYPE96x96<F> to G2
+ ESC '$' '/' <F> designate TYPE96x96<F> to G3
+ ----------------------------------------------------------------------
+ In this list, "TYPE94<F>" means a graphic character set of type TYPE94
+ and final character <F>, and etc.
+
+ Note (*): Although these designations are not allowed in ISO2022,
+ Emacs accepts them on decoding, and produces them on encoding
+ TYPE96 or TYPE96x96 character set in a coding system which is
+ characterized as 7-bit environment, non-locking-shift, and
+ non-single-shift.
+
+ Note (**): If <F> is '@', 'A', or 'B', the intermediate character
+ '(' can be omitted. We call this as "short-form" here after.
+
+ Now you may notice that there are a lot of ways for encoding the
+ same multilingual text in ISO2022. Actually, there exist many
+ coding systems such as Compound Text (used in X's inter client
+ communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR
+ (used in Korean internet), EUC (Extended UNIX Code, used in Asian
+ localized platforms), and all of these are variants of ISO2022.
+
+ In addition to the above, Emacs handles two more kinds of escape
+ sequences: ISO6429's direction specification and Emacs' private
+ sequence for specifying character composition.
+
+ ISO6429's direction specification takes the following format:
+ o CSI ']' -- end of the current direction
+ o CSI '0' ']' -- end of the current direction
+ o CSI '1' ']' -- start of left-to-right text
+ o CSI '2' ']' -- start of right-to-left text
+ The control character CSI (0x9B: control sequence introducer) is
+ abbreviated to the escape sequence ESC '[' in 7-bit environment.
+
+ Character composition specification takes the following format:
+ o ESC '0' -- start character composition
+ o ESC '1' -- end character composition
+ Since these are not standard escape sequences of any ISO, the use
+ of them for these meanings is restricted to Emacs only. */
+
+static void
+reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso)
+{
+ int i;
+
+ for (i = 0; i < 4; i++)
+ {
+ if (!NILP (coding_system))
+ iso->charset[i] =
+ XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i);
+ else
+ iso->charset[i] = Qt;
+ iso->invalid_designated[i] = 0;
+ }
+ iso->esc = ISO_ESC_NOTHING;
+ iso->esc_bytes_index = 0;
+ iso->register_left = 0;
+ iso->register_right = 1;
+ iso->switched_dir_and_no_valid_charset_yet = 0;
+ iso->invalid_switch_dir = 0;
+ iso->output_direction_sequence = 0;
+ iso->output_literally = 0;
+ if (iso->composite_chars)
+ Dynarr_reset (iso->composite_chars);
+}
+
+static int
+fit_to_be_escape_quoted (unsigned char c)
+{
+ switch (c)
+ {
+ case ISO_CODE_ESC:
+ case ISO_CODE_CSI:
+ case ISO_CODE_SS2:
+ case ISO_CODE_SS3:
+ case ISO_CODE_SO:
+ case ISO_CODE_SI:
+ return 1;
+
+ default:
+ return 0;
+ }
+}
+
+/* Parse one byte of an ISO2022 escape sequence.
+ If the result is an invalid escape sequence, return 0 and
+ do not change anything in STR. Otherwise, if the result is
+ an incomplete escape sequence, update ISO2022.ESC and
+ ISO2022.ESC_BYTES and return -1. Otherwise, update
+ all the state variables (but not ISO2022.ESC_BYTES) and
+ return 1.
+
+ If CHECK_INVALID_CHARSETS is non-zero, check for designation
+ or invocation of an invalid character set and treat that as
+ an unrecognized escape sequence. */
+
+static int
+parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso,
+ unsigned char c, unsigned int *flags,
+ int check_invalid_charsets)
+{
+ /* (1) If we're at the end of a designation sequence, CS is the
+ charset being designated and REG is the register to designate
+ it to.
+
+ (2) If we're at the end of a locking-shift sequence, REG is
+ the register to invoke and HALF (0 == left, 1 == right) is
+ the half to invoke it into.
+
+ (3) If we're at the end of a single-shift sequence, REG is
+ the register to invoke. */
+ Lisp_Object cs = Qnil;
+ int reg, half;
+
+ /* NOTE: This code does goto's all over the fucking place.
+ The reason for this is that we're basically implementing
+ a state machine here, and hierarchical languages like C
+ don't really provide a clean way of doing this. */
+
+ if (! (*flags & CODING_STATE_ESCAPE))
+ /* At beginning of escape sequence; we need to reset our
+ escape-state variables. */
+ iso->esc = ISO_ESC_NOTHING;
+
+ iso->output_literally = 0;
+ iso->output_direction_sequence = 0;
+
+ switch (iso->esc)
+ {
+ case ISO_ESC_NOTHING:
+ iso->esc_bytes_index = 0;
+ switch (c)
+ {
+ case ISO_CODE_ESC: /* Start escape sequence */
+ *flags |= CODING_STATE_ESCAPE;
+ iso->esc = ISO_ESC;
+ goto not_done;
+
+ case ISO_CODE_CSI: /* ISO6429 (specifying directionality) */
+ *flags |= CODING_STATE_ESCAPE;
+ iso->esc = ISO_ESC_5_11;
+ goto not_done;
+
+ case ISO_CODE_SO: /* locking shift 1 */
+ reg = 1; half = 0;
+ goto locking_shift;
+ case ISO_CODE_SI: /* locking shift 0 */
+ reg = 0; half = 0;
+ goto locking_shift;
+
+ case ISO_CODE_SS2: /* single shift */
+ reg = 2;
+ goto single_shift;
+ case ISO_CODE_SS3: /* single shift */
+ reg = 3;
+ goto single_shift;
+
+ default: /* Other control characters */
+ return 0;
+ }
+
+ case ISO_ESC:
+ switch (c)
+ {
+ /**** single shift ****/
+
+ case 'N': /* single shift 2 */
+ reg = 2;
+ goto single_shift;
+ case 'O': /* single shift 3 */
+ reg = 3;
+ goto single_shift;
+
+ /**** locking shift ****/
+
+ case '~': /* locking shift 1 right */
+ reg = 1; half = 1;
+ goto locking_shift;
+ case 'n': /* locking shift 2 */
+ reg = 2; half = 0;
+ goto locking_shift;
+ case '}': /* locking shift 2 right */
+ reg = 2; half = 1;
+ goto locking_shift;
+ case 'o': /* locking shift 3 */
+ reg = 3; half = 0;
+ goto locking_shift;
+ case '|': /* locking shift 3 right */
+ reg = 3; half = 1;
+ goto locking_shift;
+
+ /**** composite ****/
+
+ case '0':
+ iso->esc = ISO_ESC_START_COMPOSITE;
+ *flags = (*flags & CODING_STATE_ISO2022_LOCK) |
+ CODING_STATE_COMPOSITE;
+ return 1;
+
+ case '1':
+ iso->esc = ISO_ESC_END_COMPOSITE;
+ *flags = (*flags & CODING_STATE_ISO2022_LOCK) &
+ ~CODING_STATE_COMPOSITE;
+ return 1;
+
+ /**** directionality ****/
+
+ case '[':
+ iso->esc = ISO_ESC_5_11;
+ goto not_done;
+
+ /**** designation ****/
+
+ case '$': /* multibyte charset prefix */
+ iso->esc = ISO_ESC_2_4;
+ goto not_done;
+
+ default:
+ if (0x28 <= c && c <= 0x2F)
+ {
+ iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8);
+ goto not_done;
+ }
+
+ /* This function is called with CODESYS equal to nil when
+ doing coding-system detection. */
+ if (!NILP (codesys)
+ && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
+ && fit_to_be_escape_quoted (c))
+ {
+ iso->esc = ISO_ESC_LITERAL;
+ *flags &= CODING_STATE_ISO2022_LOCK;
+ return 1;
+ }
+
+ /* bzzzt! */
+ return 0;
+ }
+
+
+
+ /**** directionality ****/
+
+ case ISO_ESC_5_11: /* ISO6429 direction control */
+ if (c == ']')
+ {
+ *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
+ goto directionality;
+ }
+ if (c == '0') iso->esc = ISO_ESC_5_11_0;
+ else if (c == '1') iso->esc = ISO_ESC_5_11_1;
+ else if (c == '2') iso->esc = ISO_ESC_5_11_2;
+ else return 0;
+ goto not_done;
+
+ case ISO_ESC_5_11_0:
+ if (c == ']')
+ {
+ *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
+ goto directionality;
+ }
+ return 0;
+
+ case ISO_ESC_5_11_1:
+ if (c == ']')
+ {
+ *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
+ goto directionality;
+ }
+ return 0;
+
+ case ISO_ESC_5_11_2:
+ if (c == ']')
+ {
+ *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L;
+ goto directionality;
+ }
+ return 0;
+
+ directionality:
+ iso->esc = ISO_ESC_DIRECTIONALITY;
+ /* Various junk here to attempt to preserve the direction sequences
+ literally in the text if they would otherwise be swallowed due
+ to invalid designations that don't show up as actual charset
+ changes in the text. */
+ if (iso->invalid_switch_dir)
+ {
+ /* We already inserted a direction switch literally into the
+ text. We assume (#### this may not be right) that the
+ next direction switch is the one going the other way,
+ and we need to output that literally as well. */
+ iso->output_literally = 1;
+ iso->invalid_switch_dir = 0;
+ }
+ else
+ {
+ int jj;
+
+ /* If we are in the thrall of an invalid designation,
+ then stick the directionality sequence literally into the
+ output stream so it ends up in the original text again. */
+ for (jj = 0; jj < 4; jj++)
+ if (iso->invalid_designated[jj])
+ break;
+ if (jj < 4)
+ {
+ iso->output_literally = 1;
+ iso->invalid_switch_dir = 1;
+ }
+ else
+ /* Indicate that we haven't yet seen a valid designation,
+ so that if a switch-dir is directly followed by an
+ invalid designation, both get inserted literally. */
+ iso->switched_dir_and_no_valid_charset_yet = 1;
+ }
+ return 1;
+
+
+ /**** designation ****/
+
+ case ISO_ESC_2_4:
+ if (0x28 <= c && c <= 0x2F)
+ {
+ iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8);
+ goto not_done;
+ }
+ if (0x40 <= c && c <= 0x42)
+ {
+ cs = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94, c,
+ *flags & CODING_STATE_R2L ?
+ CHARSET_RIGHT_TO_LEFT :
+ CHARSET_LEFT_TO_RIGHT);
+ reg = 0;
+ goto designated;
+ }
+ return 0;
+
+ default:
+ {
+ int type =-1;
+
+ if (c < '0' || c > '~')
+ return 0; /* bad final byte */
+
+ if (iso->esc >= ISO_ESC_2_8 &&
+ iso->esc <= ISO_ESC_2_15)
+ {
+ type = ((iso->esc >= ISO_ESC_2_12) ?
+ CHARSET_TYPE_96 : CHARSET_TYPE_94);
+ reg = (iso->esc - ISO_ESC_2_8) & 3;
+ }
+ else if (iso->esc >= ISO_ESC_2_4_8 &&
+ iso->esc <= ISO_ESC_2_4_15)
+ {
+ type = ((iso->esc >= ISO_ESC_2_4_12) ?
+ CHARSET_TYPE_96X96 : CHARSET_TYPE_94X94);
+ reg = (iso->esc - ISO_ESC_2_4_8) & 3;
+ }
+ else
+ {
+ /* Can this ever be reached? -slb */
+ abort();
+ }
+
+ cs = CHARSET_BY_ATTRIBUTES (type, c,
+ *flags & CODING_STATE_R2L ?
+ CHARSET_RIGHT_TO_LEFT :
+ CHARSET_LEFT_TO_RIGHT);
+ goto designated;
+ }
+ }
+
+ not_done:
+ iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c;
+ return -1;
+
+ single_shift:
+ if (check_invalid_charsets && !CHARSETP (iso->charset[reg]))
+ /* can't invoke something that ain't there. */
+ return 0;
+ iso->esc = ISO_ESC_SINGLE_SHIFT;
+ *flags &= CODING_STATE_ISO2022_LOCK;
+ if (reg == 2)
+ *flags |= CODING_STATE_SS2;
+ else
+ *flags |= CODING_STATE_SS3;
+ return 1;
+
+ locking_shift:
+ if (check_invalid_charsets &&
+ !CHARSETP (iso->charset[reg]))
+ /* can't invoke something that ain't there. */
+ return 0;
+ if (half)
+ iso->register_right = reg;
+ else
+ iso->register_left = reg;
+ *flags &= CODING_STATE_ISO2022_LOCK;
+ iso->esc = ISO_ESC_LOCKING_SHIFT;
+ return 1;
+
+ designated:
+ if (NILP (cs) && check_invalid_charsets)
+ {
+ iso->invalid_designated[reg] = 1;
+ iso->charset[reg] = Vcharset_ascii;
+ iso->esc = ISO_ESC_DESIGNATE;
+ *flags &= CODING_STATE_ISO2022_LOCK;
+ iso->output_literally = 1;
+ if (iso->switched_dir_and_no_valid_charset_yet)
+ {
+ /* We encountered a switch-direction followed by an
+ invalid designation. Ensure that the switch-direction
+ gets outputted; otherwise it will probably get eaten
+ when the text is written out again. */
+ iso->switched_dir_and_no_valid_charset_yet = 0;
+ iso->output_direction_sequence = 1;
+ /* And make sure that the switch-dir going the other
+ way gets outputted, as well. */
+ iso->invalid_switch_dir = 1;
+ }
+ return 1;
+ }
+ /* This function is called with CODESYS equal to nil when
+ doing coding-system detection. */
+ if (!NILP (codesys))
+ {
+ charset_conversion_spec_dynarr *dyn =
+ XCODING_SYSTEM (codesys)->iso2022.input_conv;
+
+ if (dyn)
+ {
+ int i;
+
+ for (i = 0; i < Dynarr_length (dyn); i++)
+ {
+ struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
+ if (EQ (cs, spec->from_charset))
+ cs = spec->to_charset;
+ }
+ }
+ }
+
+ iso->charset[reg] = cs;
+ iso->esc = ISO_ESC_DESIGNATE;
+ *flags &= CODING_STATE_ISO2022_LOCK;
+ if (iso->invalid_designated[reg])
+ {
+ iso->invalid_designated[reg] = 0;
+ iso->output_literally = 1;
+ }
+ if (iso->switched_dir_and_no_valid_charset_yet)
+ iso->switched_dir_and_no_valid_charset_yet = 0;
+ return 1;
+}
+
+static int
+detect_coding_iso2022 (struct detection_state *st, CONST unsigned char *src,
+ unsigned int n)
+{
+ int c;
+ int mask;
+
+ /* #### There are serious deficiencies in the recognition mechanism
+ here. This needs to be much smarter if it's going to cut it. */
+
+ if (!st->iso2022.initted)
+ {
+ reset_iso2022 (Qnil, &st->iso2022.iso);
+ st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK |
+ CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
+ CODING_CATEGORY_ISO_8_1_MASK |
+ CODING_CATEGORY_ISO_8_2_MASK |
+ CODING_CATEGORY_ISO_LOCK_SHIFT_MASK);
+ st->iso2022.flags = 0;
+ st->iso2022.high_byte_count = 0;
+ st->iso2022.saw_single_shift = 0;
+ st->iso2022.initted = 1;
+ }
+
+ mask = st->iso2022.mask;
+
+ while (n--)
+ {
+ c = *src++;
+ if (c >= 0xA0)
+ {
+ mask &= ~CODING_CATEGORY_ISO_7_MASK;
+ st->iso2022.high_byte_count++;
+ }
+ else
+ {
+ if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift)
+ {
+ if (st->iso2022.high_byte_count & 1)
+ /* odd number of high bytes; assume not iso-8-2 */
+ mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
+ }
+ st->iso2022.high_byte_count = 0;
+ st->iso2022.saw_single_shift = 0;
+ if (c > 0x80)
+ mask &= ~CODING_CATEGORY_ISO_7_MASK;
+ }
+ if (!(st->iso2022.flags & CODING_STATE_ESCAPE)
+ && (BYTE_C0_P (c) || BYTE_C1_P (c)))
+ { /* control chars */
+ switch (c)
+ {
+ /* Allow and ignore control characters that you might
+ reasonably see in a text file */
+ case '\r':
+ case '\n':
+ case '\t':
+ case 7: /* bell */
+ case 8: /* backspace */
+ case 11: /* vertical tab */
+ case 12: /* form feed */
+ case 26: /* MS-DOS C-z junk */
+ case 31: /* '^_' -- for info */
+ goto label_continue_loop;
+
+ default:
+ break;
+ }
+ }
+
+ if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c)
+ || BYTE_C1_P (c))
+ {
+ if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c,
+ &st->iso2022.flags, 0))
+ {
+ switch (st->iso2022.iso.esc)
+ {
+ case ISO_ESC_DESIGNATE:
+ mask &= ~CODING_CATEGORY_ISO_8_1_MASK;
+ mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
+ break;
+ case ISO_ESC_LOCKING_SHIFT:
+ mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK;
+ goto ran_out_of_chars;
+ case ISO_ESC_SINGLE_SHIFT:
+ mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK;
+ st->iso2022.saw_single_shift = 1;
+ break;
+ default:
+ break;
+ }
+ }
+ else
+ {
+ mask = 0;
+ goto ran_out_of_chars;
+ }
+ }
+ label_continue_loop:;
+ }
+
+ ran_out_of_chars:
+
+ return mask;
+}
+
+static int
+postprocess_iso2022_mask (int mask)
+{
+ /* #### kind of cheesy */
+ /* If seven-bit ISO is allowed, then assume that the encoding is
+ entirely seven-bit and turn off the eight-bit ones. */
+ if (mask & CODING_CATEGORY_ISO_7_MASK)
+ mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
+ CODING_CATEGORY_ISO_8_1_MASK |
+ CODING_CATEGORY_ISO_8_2_MASK);
+ return mask;
+}
+
+/* If FLAGS is a null pointer or specifies right-to-left motion,
+ output a switch-dir-to-left-to-right sequence to DST.
+ Also update FLAGS if it is not a null pointer.
+ If INTERNAL_P is set, we are outputting in internal format and
+ need to handle the CSI differently. */
+
+static void
+restore_left_to_right_direction (struct Lisp_Coding_System *codesys,
+ unsigned_char_dynarr *dst,
+ unsigned int *flags,
+ int internal_p)
+{
+ if (!flags || (*flags & CODING_STATE_R2L))
+ {
+ if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
+ {
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, '[');
+ }
+ else if (internal_p)
+ DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
+ else
+ Dynarr_add (dst, ISO_CODE_CSI);
+ Dynarr_add (dst, '0');
+ Dynarr_add (dst, ']');
+ if (flags)
+ *flags &= ~CODING_STATE_R2L;
+ }
+}
+
+/* If FLAGS is a null pointer or specifies a direction different from
+ DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or
+ CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape
+ sequence to DST. Also update FLAGS if it is not a null pointer.
+ If INTERNAL_P is set, we are outputting in internal format and
+ need to handle the CSI differently. */
+
+static void
+ensure_correct_direction (int direction, struct Lisp_Coding_System *codesys,
+ unsigned_char_dynarr *dst, unsigned int *flags,
+ int internal_p)
+{
+ if ((!flags || (*flags & CODING_STATE_R2L)) &&
+ direction == CHARSET_LEFT_TO_RIGHT)
+ restore_left_to_right_direction (codesys, dst, flags, internal_p);
+ else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys)
+ && (!flags || !(*flags & CODING_STATE_R2L)) &&
+ direction == CHARSET_RIGHT_TO_LEFT)
+ {
+ if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
+ {
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, '[');
+ }
+ else if (internal_p)
+ DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
+ else
+ Dynarr_add (dst, ISO_CODE_CSI);
+ Dynarr_add (dst, '2');
+ Dynarr_add (dst, ']');
+ if (flags)
+ *flags |= CODING_STATE_R2L;
+ }
+}
+
+/* Convert ISO2022-format data to internal format. */
+
+static void
+decode_coding_iso2022 (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+ struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
+ Lisp_Object coding_system;
+ unsigned_char_dynarr *real_dst = dst;
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = str->eol_type;
+ XSETCODING_SYSTEM (coding_system, str->codesys);
+
+ if (flags & CODING_STATE_COMPOSITE)
+ dst = str->iso2022.composite_chars;
+
+ while (n--)
+ {
+ c = *src++;
+ if (flags & CODING_STATE_ESCAPE)
+ { /* Within ESC sequence */
+ int retval = parse_iso2022_esc (coding_system, &str->iso2022,
+ c, &flags, 1);
+
+ if (retval)
+ {
+ switch (str->iso2022.esc)
+ {
+ case ISO_ESC_START_COMPOSITE:
+ if (str->iso2022.composite_chars)
+ Dynarr_reset (str->iso2022.composite_chars);
+ else
+ str->iso2022.composite_chars = Dynarr_new (unsigned_char);
+ dst = str->iso2022.composite_chars;
+ break;
+ case ISO_ESC_END_COMPOSITE:
+ {
+ Bufbyte comstr[MAX_EMCHAR_LEN];
+ Bytecount len;
+ Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0),
+ Dynarr_length (dst));
+ dst = real_dst;
+ len = set_charptr_emchar (comstr, emch);
+ Dynarr_add_many (dst, comstr, len);
+ break;
+ }
+
+ case ISO_ESC_LITERAL:
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ break;
+
+ default:
+ /* Everything else handled already */
+ break;
+ }
+ }
+
+ /* Attempted error recovery. */
+ if (str->iso2022.output_direction_sequence)
+ ensure_correct_direction (flags & CODING_STATE_R2L ?
+ CHARSET_RIGHT_TO_LEFT :
+ CHARSET_LEFT_TO_RIGHT,
+ str->codesys, dst, 0, 1);
+ /* More error recovery. */
+ if (!retval || str->iso2022.output_literally)
+ {
+ /* Output the (possibly invalid) sequence */
+ int i;
+ for (i = 0; i < str->iso2022.esc_bytes_index; i++)
+ DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst);
+ flags &= CODING_STATE_ISO2022_LOCK;
+ if (!retval)
+ n++, src--;/* Repeat the loop with the same character. */
+ else
+ {
+ /* No sense in reprocessing the final byte of the
+ escape sequence; it could mess things up anyway.
+ Just add it now. */
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ }
+ ch = 0;
+ }
+ else if (BYTE_C0_P (c) || BYTE_C1_P (c))
+ { /* Control characters */
+
+ /***** Error-handling *****/
+
+ /* If we were in the middle of a character, dump out the
+ partial character. */
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+
+ /* If we just saw a single-shift character, dump it out.
+ This may dump out the wrong sort of single-shift character,
+ but least it will give an indication that something went
+ wrong. */
+ if (flags & CODING_STATE_SS2)
+ {
+ DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst);
+ flags &= ~CODING_STATE_SS2;
+ }
+ if (flags & CODING_STATE_SS3)
+ {
+ DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst);
+ flags &= ~CODING_STATE_SS3;
+ }
+
+ /***** Now handle the control characters. *****/
+
+ /* Handle CR/LF */
+ DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
+
+ flags &= CODING_STATE_ISO2022_LOCK;
+
+ if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1))
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+ else
+ { /* Graphic characters */
+ Lisp_Object charset;
+ int lb;
+ int reg;
+
+ DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
+
+ /* Now determine the charset. */
+ reg = ((flags & CODING_STATE_SS2) ? 2
+ : (flags & CODING_STATE_SS3) ? 3
+ : !BYTE_ASCII_P (c) ? str->iso2022.register_right
+ : str->iso2022.register_left);
+ charset = str->iso2022.charset[reg];
+
+ /* Error checking: */
+ if (NILP (charset) || str->iso2022.invalid_designated[reg]
+ || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL)
+ && XCHARSET_CHARS (charset) == 94))
+ /* Mrmph. We are trying to invoke a register that has no
+ or an invalid charset in it, or trying to add a character
+ outside the range of the charset. Insert that char literally
+ to preserve it for the output. */
+ {
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ }
+
+ else
+ {
+ /* Things are probably hunky-dorey. */
+
+ /* Fetch reverse charset, maybe. */
+ if (((flags & CODING_STATE_R2L) &&
+ XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT)
+ ||
+ (!(flags & CODING_STATE_R2L) &&
+ XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT))
+ {
+ Lisp_Object new_charset =
+ XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
+ if (!NILP (new_charset))
+ charset = new_charset;
+ }
+
+ lb = XCHARSET_LEADING_BYTE (charset);
+ switch (XCHARSET_REP_BYTES (charset))
+ {
+ case 1: /* ASCII */
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+ Dynarr_add (dst, c & 0x7F);
+ break;
+
+ case 2: /* one-byte official */
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+ Dynarr_add (dst, lb);
+ Dynarr_add (dst, c | 0x80);
+ break;
+
+ case 3: /* one-byte private or two-byte official */
+ if (XCHARSET_PRIVATE_P (charset))
+ {
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+ Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1);
+ Dynarr_add (dst, lb);
+ Dynarr_add (dst, c | 0x80);
+ }
+ else
+ {
+ if (ch)
+ {
+ Dynarr_add (dst, lb);
+ Dynarr_add (dst, ch | 0x80);
+ Dynarr_add (dst, c | 0x80);
+ ch = 0;
+ }
+ else
+ ch = c;
+ }
+ break;
+
+ default: /* two-byte private */
+ if (ch)
+ {
+ Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2);
+ Dynarr_add (dst, lb);
+ Dynarr_add (dst, ch | 0x80);
+ Dynarr_add (dst, c | 0x80);
+ ch = 0;
+ }
+ else
+ ch = c;
+ }
+ }
+
+ if (!ch)
+ flags &= CODING_STATE_ISO2022_LOCK;
+ }
+
+ label_continue_loop:;
+ }
+
+ if (flags & CODING_STATE_END)
+ DECODE_OUTPUT_PARTIAL_CHAR (ch);
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+
+/***** ISO2022 encoder *****/
+
+/* Designate CHARSET into register REG. */
+
+static void
+iso2022_designate (Lisp_Object charset, unsigned char reg,
+ struct encoding_stream *str, unsigned_char_dynarr *dst)
+{
+ CONST char *inter94 = "()*+", *inter96= ",-./";
+ unsigned int type;
+ unsigned char final;
+ Lisp_Object old_charset = str->iso2022.charset[reg];
+
+ str->iso2022.charset[reg] = charset;
+ if (!CHARSETP (charset))
+ /* charset might be an initial nil or t. */
+ return;
+ type = XCHARSET_TYPE (charset);
+ final = XCHARSET_FINAL (charset);
+ if (!str->iso2022.force_charset_on_output[reg] &&
+ CHARSETP (old_charset) &&
+ XCHARSET_TYPE (old_charset) == type &&
+ XCHARSET_FINAL (old_charset) == final)
+ return;
+
+ str->iso2022.force_charset_on_output[reg] = 0;
+
+ {
+ charset_conversion_spec_dynarr *dyn =
+ str->codesys->iso2022.output_conv;
+
+ if (dyn)
+ {
+ int i;
+
+ for (i = 0; i < Dynarr_length (dyn); i++)
+ {
+ struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
+ if (EQ (charset, spec->from_charset))
+ charset = spec->to_charset;
+ }
+ }
+ }
+
+ Dynarr_add (dst, ISO_CODE_ESC);
+ switch (type)
+ {
+ case CHARSET_TYPE_94:
+ Dynarr_add (dst, inter94[reg]);
+ break;
+ case CHARSET_TYPE_96:
+ Dynarr_add (dst, inter96[reg]);
+ break;
+ case CHARSET_TYPE_94X94:
+ Dynarr_add (dst, '$');
+ if (reg != 0
+ || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys))
+ || final < '@'
+ || final > 'B')
+ Dynarr_add (dst, inter94[reg]);
+ break;
+ case CHARSET_TYPE_96X96:
+ Dynarr_add (dst, '$');
+ Dynarr_add (dst, inter96[reg]);
+ break;
+ }
+ Dynarr_add (dst, final);
+}
+
+static void
+ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst)
+{
+ if (str->iso2022.register_left != 0)
+ {
+ Dynarr_add (dst, ISO_CODE_SI);
+ str->iso2022.register_left = 0;
+ }
+}
+
+static void
+ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst)
+{
+ if (str->iso2022.register_left != 1)
+ {
+ Dynarr_add (dst, ISO_CODE_SO);
+ str->iso2022.register_left = 1;
+ }
+}
+
+/* Convert internally-formatted data to ISO2022 format. */
+
+static void
+encode_coding_iso2022 (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char charmask, c;
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+ unsigned char char_boundary;
+ struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
+ struct Lisp_Coding_System *codesys = str->codesys;
+ int i;
+ Lisp_Object charset;
+ int half;
+
+ /* flags for handling composite chars. We do a little switcharoo
+ on the source while we're outputting the composite char. */
+ unsigned int saved_n = 0;
+ CONST unsigned char *saved_src = NULL;
+ int in_composite = 0;
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
+ char_boundary = str->iso2022.current_char_boundary;
+ charset = str->iso2022.current_charset;
+ half = str->iso2022.current_half;
+
+ back_to_square_n:
+ while (n--)
+ {
+ c = *src++;
+
+ if (BYTE_ASCII_P (c))
+ { /* Processing ASCII character */
+ ch = 0;
+
+ restore_left_to_right_direction (codesys, dst, &flags, 0);
+
+ /* Make sure G0 contains ASCII */
+ if ((c > ' ' && c < ISO_CODE_DEL) ||
+ !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys))
+ {
+ ensure_normal_shift (str, dst);
+ iso2022_designate (Vcharset_ascii, 0, str, dst);
+ }
+
+ /* If necessary, restore everything to the default state
+ at end-of-line */
+ if (c == '\n' &&
+ !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys)))
+ {
+ restore_left_to_right_direction (codesys, dst, &flags, 0);
+
+ ensure_normal_shift (str, dst);
+
+ for (i = 0; i < 4; i++)
+ {
+ Lisp_Object initial_charset =
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
+ iso2022_designate (initial_charset, i, str, dst);
+ }
+ }
+ if (c == '\n')
+ {
+ if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
+ Dynarr_add (dst, '\r');
+ if (eol_type != EOL_CR)
+ Dynarr_add (dst, c);
+ }
+ else
+ {
+ if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
+ && fit_to_be_escape_quoted (c))
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, c);
+ }
+ char_boundary = 1;
+ }
+
+ else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch))
+ { /* Processing Leading Byte */
+ ch = 0;
+ charset = CHARSET_BY_LEADING_BYTE (c);
+ if (LEADING_BYTE_PREFIX_P(c))
+ ch = c;
+ else if (!EQ (charset, Vcharset_control_1)
+ && !EQ (charset, Vcharset_composite))
+ {
+ int reg;
+
+ ensure_correct_direction (XCHARSET_DIRECTION (charset),
+ codesys, dst, &flags, 0);
+
+ /* Now determine which register to use. */
+ reg = -1;
+ for (i = 0; i < 4; i++)
+ {
+ if (EQ (charset, str->iso2022.charset[i]) ||
+ EQ (charset,
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)))
+ {
+ reg = i;
+ break;
+ }
+ }
+
+ if (reg == -1)
+ {
+ if (XCHARSET_GRAPHIC (charset) != 0)
+ {
+ if (!NILP (str->iso2022.charset[1]) &&
+ (!CODING_SYSTEM_ISO2022_SEVEN (codesys) ||
+ CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys)))
+ reg = 1;
+ else if (!NILP (str->iso2022.charset[2]))
+ reg = 2;
+ else if (!NILP (str->iso2022.charset[3]))
+ reg = 3;
+ else
+ reg = 0;
+ }
+ else
+ reg = 0;
+ }
+
+ iso2022_designate (charset, reg, str, dst);
+
+ /* Now invoke that register. */
+ switch (reg)
+ {
+ case 0:
+ ensure_normal_shift (str, dst);
+ half = 0;
+ break;
+
+ case 1:
+ if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
+ {
+ ensure_shift_out (str, dst);
+ half = 0;
+ }
+ else
+ half = 1;
+ break;
+
+ case 2:
+ if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
+ {
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, 'N');
+ half = 0;
+ }
+ else
+ {
+ Dynarr_add (dst, ISO_CODE_SS2);
+ half = 1;
+ }
+ break;
+
+ case 3:
+ if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
+ {
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, 'O');
+ half = 0;
+ }
+ else
+ {
+ Dynarr_add (dst, ISO_CODE_SS3);
+ half = 1;
+ }
+ break;
+
+ default:
+ abort ();
+ }
+ }
+ char_boundary = 0;
+ }
+ else
+ { /* Processing Non-ASCII character */
+ charmask = (half == 0 ? 0x7F : 0xFF);
+ char_boundary = 1;
+ if (EQ (charset, Vcharset_control_1))
+ {
+ if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
+ && fit_to_be_escape_quoted (c))
+ Dynarr_add (dst, ISO_CODE_ESC);
+ /* you asked for it ... */
+ Dynarr_add (dst, c - 0x20);
+ }
+ else
+ {
+ switch (XCHARSET_REP_BYTES (charset))
+ {
+ case 2:
+ Dynarr_add (dst, c & charmask);
+ break;
+ case 3:
+ if (XCHARSET_PRIVATE_P (charset))
+ {
+ Dynarr_add (dst, c & charmask);
+ ch = 0;
+ }
+ else if (ch)
+ {
+ if (EQ (charset, Vcharset_composite))
+ {
+ if (in_composite)
+ {
+ /* #### Bother! We don't know how to
+ handle this yet. */
+ Dynarr_add (dst, '~');
+ }
+ else
+ {
+ Emchar emch = MAKE_CHAR (Vcharset_composite,
+ ch & 0x7F, c & 0x7F);
+ Lisp_Object lstr = composite_char_string (emch);
+ saved_n = n;
+ saved_src = src;
+ in_composite = 1;
+ src = XSTRING_DATA (lstr);
+ n = XSTRING_LENGTH (lstr);
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, '0'); /* start composing */
+ }
+ }
+ else
+ {
+ Dynarr_add (dst, ch & charmask);
+ Dynarr_add (dst, c & charmask);
+ }
+ ch = 0;
+ }
+ else
+ {
+ ch = c;
+ char_boundary = 0;
+ }
+ break;
+ case 4:
+ if (ch)
+ {
+ Dynarr_add (dst, ch & charmask);
+ Dynarr_add (dst, c & charmask);
+ ch = 0;
+ }
+ else
+ {
+ ch = c;
+ char_boundary = 0;
+ }
+ break;
+ default:
+ abort ();
+ }
+ }
+ }
+ }
+
+ if (in_composite)
+ {
+ n = saved_n;
+ src = saved_src;
+ in_composite = 0;
+ Dynarr_add (dst, ISO_CODE_ESC);
+ Dynarr_add (dst, '1'); /* end composing */
+ goto back_to_square_n; /* Wheeeeeeeee ..... */
+ }
+
+ if (char_boundary && flags & CODING_STATE_END)
+ {
+ restore_left_to_right_direction (codesys, dst, &flags, 0);
+ ensure_normal_shift (str, dst);
+ for (i = 0; i < 4; i++)
+ {
+ Lisp_Object initial_charset =
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
+ iso2022_designate (initial_charset, i, str, dst);
+ }
+ }
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+ str->iso2022.current_char_boundary = char_boundary;
+ str->iso2022.current_charset = charset;
+ str->iso2022.current_half = half;
+
+ /* Verbum caro factum est! */
+}
+
+\f
+/************************************************************************/
+/* No-conversion methods */
+/************************************************************************/
+
+/* This is used when reading in "binary" files -- i.e. files that may
+ contain all 256 possible byte values and that are not to be
+ interpreted as being in any particular decoding. */
+static void
+decode_coding_no_conversion (Lstream *decoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+ struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = str->eol_type;
+
+ while (n--)
+ {
+ c = *src++;
+
+ DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
+ DECODE_ADD_BINARY_CHAR (c, dst);
+ label_continue_loop:;
+ }
+
+ DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+static void
+encode_coding_no_conversion (Lstream *encoding, CONST unsigned char *src,
+ unsigned_char_dynarr *dst, unsigned int n)
+{
+ unsigned char c;
+ struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
+ unsigned int flags, ch;
+ enum eol_type eol_type;
+
+ CODING_STREAM_DECOMPOSE (str, flags, ch);
+ eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
+
+ while (n--)
+ {
+ c = *src++;
+ if (c == '\n')
+ {
+ if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
+ Dynarr_add (dst, '\r');
+ if (eol_type != EOL_CR)
+ Dynarr_add (dst, '\n');
+ ch = 0;
+ }
+ else if (BYTE_ASCII_P (c))
+ {
+ assert (ch == 0);
+ Dynarr_add (dst, c);
+ }
+ else if (BUFBYTE_LEADING_BYTE_P (c))
+ {
+ assert (ch == 0);
+ if (c == LEADING_BYTE_LATIN_ISO8859_1 ||
+ c == LEADING_BYTE_CONTROL_1)
+ ch = c;
+ else
+ Dynarr_add (dst, '~'); /* untranslatable character */
+ }
+ else
+ {
+ if (ch == LEADING_BYTE_LATIN_ISO8859_1)
+ Dynarr_add (dst, c);
+ else if (ch == LEADING_BYTE_CONTROL_1)
+ {
+ assert (c < 0xC0);
+ Dynarr_add (dst, c - 0x20);
+ }
+ /* else it should be the second or third byte of an
+ untranslatable character, so ignore it */
+ ch = 0;
+ }
+ }
+
+ CODING_STREAM_COMPOSE (str, flags, ch);
+}
+
+\f
+/************************************************************************/
+/* Simple internal/external functions */
+/************************************************************************/
+
+static Extbyte_dynarr *conversion_out_dynarr;
+static Bufbyte_dynarr *conversion_in_dynarr;
+
+/* Determine coding system from coding format */
+
+/* #### not correct for all values of `fmt'! */
+static Lisp_Object
+external_data_format_to_coding_system (enum external_data_format fmt)
+{
+ switch (fmt)
+ {
+ case FORMAT_FILENAME:
+ case FORMAT_TERMINAL:
+ if (EQ (Vfile_name_coding_system, Qnil) ||
+ EQ (Vfile_name_coding_system, Qbinary))
+ return Qnil;
+ else
+ return Fget_coding_system (Vfile_name_coding_system);
+ case FORMAT_CTEXT:
+ return Fget_coding_system (Qctext);
+ default:
+ return Qnil;
+ }
+}
+
+CONST Extbyte *
+convert_to_external_format (CONST Bufbyte *ptr,
+ Bytecount len,
+ Extcount *len_out,
+ enum external_data_format fmt)
+{
+ Lisp_Object coding_system = external_data_format_to_coding_system (fmt);
+
+ if (!conversion_out_dynarr)
+ conversion_out_dynarr = Dynarr_new (Extbyte);
+ else
+ Dynarr_reset (conversion_out_dynarr);
+
+ if (NILP (coding_system))
+ {
+ CONST Bufbyte *end = ptr + len;
+
+ for (; ptr < end;)
+ {
+ Bufbyte c =
+ (BYTE_ASCII_P (*ptr)) ? *ptr :
+ (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) :
+ (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) :
+ '~';
+
+ Dynarr_add (conversion_out_dynarr, (Extbyte) c);
+ INC_CHARPTR (ptr);
+ }
+
+#ifdef ERROR_CHECK_BUFPOS
+ assert (ptr == end);
+#endif
+ }
+ else
+ {
+ Lisp_Object instream, outstream, da_outstream;
+ Lstream *istr, *ostr;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ char tempbuf[1024]; /* some random amount */
+
+ instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len);
+ da_outstream = make_dynarr_output_stream
+ ((unsigned_char_dynarr *) conversion_out_dynarr);
+ outstream =
+ make_encoding_output_stream (XLSTREAM (da_outstream), coding_system);
+ istr = XLSTREAM (instream);
+ ostr = XLSTREAM (outstream);
+ GCPRO3 (instream, outstream, da_outstream);
+ while (1)
+ {
+ int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
+ if (!size_in_bytes)
+ break;
+ Lstream_write (ostr, tempbuf, size_in_bytes);
+ }
+ Lstream_close (istr);
+ Lstream_close (ostr);
+ UNGCPRO;
+ Lstream_delete (istr);
+ Lstream_delete (ostr);
+ Lstream_delete (XLSTREAM (da_outstream));
+ }
+
+ *len_out = Dynarr_length (conversion_out_dynarr);
+ Dynarr_add (conversion_out_dynarr, 0); /* remember to zero-terminate! */
+ return Dynarr_atp (conversion_out_dynarr, 0);
+}
+
+CONST Bufbyte *
+convert_from_external_format (CONST Extbyte *ptr,
+ Extcount len,
+ Bytecount *len_out,
+ enum external_data_format fmt)
+{
+ Lisp_Object coding_system = external_data_format_to_coding_system (fmt);
+
+ if (!conversion_in_dynarr)
+ conversion_in_dynarr = Dynarr_new (Bufbyte);
+ else
+ Dynarr_reset (conversion_in_dynarr);
+
+ if (NILP (coding_system))
+ {
+ CONST Extbyte *end = ptr + len;
+ for (; ptr < end; ptr++)
+ {
+ Extbyte c = *ptr;
+ DECODE_ADD_BINARY_CHAR (c, conversion_in_dynarr);
+ }
+ }
+ else
+ {
+ Lisp_Object instream, outstream, da_outstream;
+ Lstream *istr, *ostr;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ char tempbuf[1024]; /* some random amount */
+
+ instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len);
+ da_outstream = make_dynarr_output_stream
+ ((unsigned_char_dynarr *) conversion_in_dynarr);
+ outstream =
+ make_decoding_output_stream (XLSTREAM (da_outstream), coding_system);
+ istr = XLSTREAM (instream);
+ ostr = XLSTREAM (outstream);
+ GCPRO3 (instream, outstream, da_outstream);
+ while (1)
+ {
+ int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
+ if (!size_in_bytes)
+ break;
+ Lstream_write (ostr, tempbuf, size_in_bytes);
+ }
+ Lstream_close (istr);
+ Lstream_close (ostr);
+ UNGCPRO;
+ Lstream_delete (istr);
+ Lstream_delete (ostr);
+ Lstream_delete (XLSTREAM (da_outstream));
+ }
+
+ *len_out = Dynarr_length (conversion_in_dynarr);
+ Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */
+ return Dynarr_atp (conversion_in_dynarr, 0);
+}
+
+\f
+/************************************************************************/
+/* Initialization */
+/************************************************************************/
+
+void
+syms_of_mule_coding (void)
+{
+ defsymbol (&Qbuffer_file_coding_system, "buffer-file-coding-system");
+ deferror (&Qcoding_system_error, "coding-system-error",
+ "Coding-system error", Qio_error);
+
+ DEFSUBR (Fcoding_system_p);
+ DEFSUBR (Ffind_coding_system);
+ DEFSUBR (Fget_coding_system);
+ DEFSUBR (Fcoding_system_list);
+ DEFSUBR (Fcoding_system_name);
+ DEFSUBR (Fmake_coding_system);
+ DEFSUBR (Fcopy_coding_system);
+ DEFSUBR (Fsubsidiary_coding_system);
+
+ DEFSUBR (Fcoding_system_type);
+ DEFSUBR (Fcoding_system_doc_string);
+ DEFSUBR (Fcoding_system_charset);
+ DEFSUBR (Fcoding_system_property);
+
+ DEFSUBR (Fcoding_category_list);
+ DEFSUBR (Fset_coding_priority_list);
+ DEFSUBR (Fcoding_priority_list);
+ DEFSUBR (Fset_coding_category_system);
+ DEFSUBR (Fcoding_category_system);
+
+ DEFSUBR (Fdetect_coding_region);
+ DEFSUBR (Fdecode_coding_region);
+ DEFSUBR (Fencode_coding_region);
+ DEFSUBR (Fdecode_shift_jis_char);
+ DEFSUBR (Fencode_shift_jis_char);
+ DEFSUBR (Fdecode_big5_char);
+ DEFSUBR (Fencode_big5_char);
+
+ defsymbol (&Qcoding_system_p, "coding-system-p");
+
+ defsymbol (&Qbig5, "big5");
+ defsymbol (&Qshift_jis, "shift-jis");
+ defsymbol (&Qno_conversion, "no-conversion");
+ defsymbol (&Qccl, "ccl");
+ defsymbol (&Qiso2022, "iso2022");
+
+ defsymbol (&Qmnemonic, "mnemonic");
+ defsymbol (&Qeol_type, "eol-type");
+ defsymbol (&Qpost_read_conversion, "post-read-conversion");
+ defsymbol (&Qpre_write_conversion, "pre-write-conversion");
+
+ defsymbol (&Qcr, "cr");
+ defsymbol (&Qlf, "lf");
+ defsymbol (&Qcrlf, "crlf");
+ defsymbol (&Qeol_cr, "eol-cr");
+ defsymbol (&Qeol_lf, "eol-lf");
+ defsymbol (&Qeol_crlf, "eol-crlf");
+
+ defsymbol (&Qcharset_g0, "charset-g0");
+ defsymbol (&Qcharset_g1, "charset-g1");
+ defsymbol (&Qcharset_g2, "charset-g2");
+ defsymbol (&Qcharset_g3, "charset-g3");
+ defsymbol (&Qforce_g0_on_output, "force-g0-on-output");
+ defsymbol (&Qforce_g1_on_output, "force-g1-on-output");
+ defsymbol (&Qforce_g2_on_output, "force-g2-on-output");
+ defsymbol (&Qforce_g3_on_output, "force-g3-on-output");
+ defsymbol (&Qshort, "short");
+ defsymbol (&Qno_ascii_eol, "no-ascii-eol");
+ defsymbol (&Qno_ascii_cntl, "no-ascii-cntl");
+ defsymbol (&Qseven, "seven");
+ defsymbol (&Qlock_shift, "lock-shift");
+ defsymbol (&Qno_iso6429, "no-iso6429");
+ defsymbol (&Qescape_quoted, "escape-quoted");
+ defsymbol (&Qinput_charset_conversion, "input-charset-conversion");
+ defsymbol (&Qoutput_charset_conversion, "output-charset-conversion");
+
+ defsymbol (&Qencode, "encode");
+ defsymbol (&Qdecode, "decode");
+
+ defsymbol (&Qctext, "ctext");
+
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS],
+ "shift-jis");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7],
+ "iso-7");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE],
+ "iso-8-designate");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1],
+ "iso-8-1");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2],
+ "iso-8-2");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT],
+ "iso-lock-shift");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5],
+ "big5");
+ defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION],
+ "no-conversion");
+}
+
+void
+lstream_type_create_mule_coding (void)
+{
+ LSTREAM_HAS_METHOD (decoding, reader);
+ LSTREAM_HAS_METHOD (decoding, writer);
+ LSTREAM_HAS_METHOD (decoding, rewinder);
+ LSTREAM_HAS_METHOD (decoding, seekable_p);
+ LSTREAM_HAS_METHOD (decoding, flusher);
+ LSTREAM_HAS_METHOD (decoding, closer);
+ LSTREAM_HAS_METHOD (decoding, marker);
+
+ LSTREAM_HAS_METHOD (encoding, reader);
+ LSTREAM_HAS_METHOD (encoding, writer);
+ LSTREAM_HAS_METHOD (encoding, rewinder);
+ LSTREAM_HAS_METHOD (encoding, seekable_p);
+ LSTREAM_HAS_METHOD (encoding, flusher);
+ LSTREAM_HAS_METHOD (encoding, closer);
+ LSTREAM_HAS_METHOD (encoding, marker);
+}
+
+void
+vars_of_mule_coding (void)
+{
+ int i;
+
+ /* Initialize to something reasonable ... */
+ for (i = 0; i <= CODING_CATEGORY_LAST; i++)
+ {
+ coding_category_system[i] = Qnil;
+ coding_category_by_priority[i] = i;
+ }
+
+ DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /*
+Coding system used for TTY keyboard input.
+Not used under a windowing system.
+*/ );
+ Vkeyboard_coding_system = Qnil;
+
+ DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /*
+Coding system used for TTY display output.
+Not used under a windowing system.
+*/ );
+ Vterminal_coding_system = Qnil;
+
+ DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /*
+Overriding coding system used when writing a file or process.
+You should *bind* this, not set it. If this is non-nil, it specifies
+the coding system that will be used when a file or process is read
+in, and overrides `buffer-file-coding-system-for-read',
+`insert-file-contents-pre-hook', etc. Use those variables instead of
+this one for permanent changes to the environment.
+*/ );
+ Vcoding_system_for_read = Qnil;
+
+ DEFVAR_LISP ("coding-system-for-write",
+ &Vcoding_system_for_write /*
+Overriding coding system used when writing a file or process.
+You should *bind* this, not set it. If this is non-nil, it specifies
+the coding system that will be used when a file or process is wrote
+in, and overrides `buffer-file-coding-system',
+`write-region-pre-hook', etc. Use those variables instead of this one
+for permanent changes to the environment.
+*/ );
+ Vcoding_system_for_write = Qnil;
+
+ DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /*
+Coding system used to convert pathnames when accessing files.
+*/ );
+ Vfile_name_coding_system = Qnil;
+
+ DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /*
+Non-nil means the buffer contents are regarded as multi-byte form
+of characters, not a binary code. This affects the display, file I/O,
+and behaviors of various editing commands.
+
+Setting this to nil does not do anything.
+*/ );
+ enable_multibyte_characters = 1;
+}
+
+void
+complex_vars_of_mule_coding (void)
+{
+ staticpro (&Vcoding_system_hash_table);
+ Vcoding_system_hash_table =
+ make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+
+ the_codesys_prop_dynarr = Dynarr_new (codesys_prop);
+
+#define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \
+{ \
+ struct codesys_prop csp; \
+ csp.sym = (Sym); \
+ csp.prop_type = (Prop_Type); \
+ Dynarr_add (the_codesys_prop_dynarr, csp); \
+} while (0)
+
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qmnemonic);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_type);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_cr);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_crlf);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_lf);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpost_read_conversion);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpre_write_conversion);
+
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion);
+
+ DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qencode);
+ DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qdecode);
+
+ /* Need to create this here or we're really screwed. */
+ Fmake_coding_system (Qno_conversion, Qno_conversion, build_string ("No conversion"),
+ list2 (Qmnemonic, build_string ("Noconv")));
+
+ Fcopy_coding_system (Fcoding_system_property (Qno_conversion, Qeol_lf),
+ Qbinary);
+
+ /* Need this for bootstrapping */
+ coding_category_system[CODING_CATEGORY_NO_CONVERSION] =
+ Fget_coding_system (Qno_conversion);
+}
+
+#endif
--- /dev/null
+/* Header for code conversion stuff
+ Copyright (C) 1991, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Mule 2.3. Not in FSF. */
+
+/* 91.10.09 written by K.Handa <handa@etl.go.jp> */
+/* Rewritten by Ben Wing <ben@xemacs.org>. */
+
+#ifndef _XEMACS_MULE_CODING_H_
+#define _XEMACS_MULE_CODING_H_
+
+struct decoding_stream;
+struct encoding_stream;
+
+/* Coding system types. These go into the TYPE field of a
+ struct Lisp_Coding_System. */
+
+enum coding_system_type
+{
+ CODESYS_AUTODETECT, /* Automatic conversion. */
+ CODESYS_SHIFT_JIS, /* Shift-JIS; Hankaku (half-width) KANA
+ is also supported. */
+ CODESYS_ISO2022, /* Any ISO2022-compliant coding system.
+ Includes JIS, EUC, CTEXT */
+ CODESYS_BIG5, /* BIG5 (used for Taiwanese). */
+ CODESYS_CCL, /* Converter written in CCL. */
+ CODESYS_NO_CONVERSION /* "No conversion"; used for binary files.
+ We use quotes because there really
+ is some conversion being applied,
+ but it appears to the user as if
+ the text is read in without conversion. */
+#ifdef DEBUG_XEMACS
+ ,CODESYS_INTERNAL /* Raw (internally-formatted) data. */
+#endif
+};
+
+enum eol_type
+{
+ EOL_AUTODETECT,
+ EOL_LF,
+ EOL_CRLF,
+ EOL_CR
+};
+
+typedef struct charset_conversion_spec charset_conversion_spec;
+struct charset_conversion_spec
+{
+ Lisp_Object from_charset;
+ Lisp_Object to_charset;
+};
+
+typedef struct
+{
+ Dynarr_declare (charset_conversion_spec);
+} charset_conversion_spec_dynarr;
+
+struct Lisp_Coding_System
+{
+ struct lcrecord_header header;
+
+ /* Name and doc string of this coding system. */
+ Lisp_Object name, doc_string;
+
+ /* This is the major type of the coding system -- one of Big5, ISO2022,
+ Shift-JIS, etc. See the constants above. */
+ enum coding_system_type type;
+
+ /* Mnemonic string displayed in the modeline when this coding
+ system is active for a particular buffer. */
+ Lisp_Object mnemonic;
+
+ Lisp_Object post_read_conversion, pre_write_conversion;
+
+ enum eol_type eol_type;
+
+ /* Subsidiary coding systems that specify a particular type of EOL
+ marking, rather than autodetecting it. These will only be non-nil
+ if (eol_type == EOL_AUTODETECT). */
+ Lisp_Object eol_lf, eol_crlf, eol_cr;
+
+ struct
+ {
+ /* What are the charsets to be initially designated to G0, G1,
+ G2, G3? If t, no charset is initially designated. If nil,
+ no charset is initially designated and no charset is allowed
+ to be designated. */
+ Lisp_Object initial_charset[4];
+
+ /* If true, a designation escape sequence needs to be sent on output
+ for the charset in G[0-3] before that charset is used. */
+ unsigned char force_charset_on_output[4];
+
+ charset_conversion_spec_dynarr *input_conv;
+ charset_conversion_spec_dynarr *output_conv;
+
+ unsigned int shoort :1; /* C makes you speak Dutch */
+ unsigned int no_ascii_eol :1;
+ unsigned int no_ascii_cntl :1;
+ unsigned int seven :1;
+ unsigned int lock_shift :1;
+ unsigned int no_iso6429 :1;
+ unsigned int escape_quoted :1;
+ } iso2022;
+
+ struct
+ {
+ /* For a CCL coding system, these specify the CCL programs used for
+ decoding (input) and encoding (output). */
+ Lisp_Object decode, encode;
+ } ccl;
+};
+
+DECLARE_LRECORD (coding_system, struct Lisp_Coding_System);
+#define XCODING_SYSTEM(x) XRECORD (x, coding_system, struct Lisp_Coding_System)
+#define XSETCODING_SYSTEM(x, p) XSETRECORD (x, p, coding_system)
+#define CODING_SYSTEMP(x) RECORDP (x, coding_system)
+#define GC_CODING_SYSTEMP(x) GC_RECORDP (x, coding_system)
+#define CHECK_CODING_SYSTEM(x) CHECK_RECORD (x, coding_system)
+#define CONCHECK_CODING_SYSTEM(x) CONCHECK_RECORD (x, coding_system)
+
+#define CODING_SYSTEM_NAME(codesys) ((codesys)->name)
+#define CODING_SYSTEM_DOC_STRING(codesys) ((codesys)->doc_string)
+#define CODING_SYSTEM_TYPE(codesys) ((codesys)->type)
+#define CODING_SYSTEM_MNEMONIC(codesys) ((codesys)->mnemonic)
+#define CODING_SYSTEM_POST_READ_CONVERSION(codesys) \
+ ((codesys)->post_read_conversion)
+#define CODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \
+ ((codesys)->pre_write_conversion)
+#define CODING_SYSTEM_EOL_TYPE(codesys) ((codesys)->eol_type)
+#define CODING_SYSTEM_EOL_LF(codesys) ((codesys)->eol_lf)
+#define CODING_SYSTEM_EOL_CRLF(codesys) ((codesys)->eol_crlf)
+#define CODING_SYSTEM_EOL_CR(codesys) ((codesys)->eol_cr)
+#define CODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \
+ ((codesys)->iso2022.initial_charset[g])
+#define CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \
+ ((codesys)->iso2022.force_charset_on_output[g])
+#define CODING_SYSTEM_ISO2022_SHORT(codesys) ((codesys)->iso2022.shoort)
+#define CODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \
+ ((codesys)->iso2022.no_ascii_eol)
+#define CODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \
+ ((codesys)->iso2022.no_ascii_cntl)
+#define CODING_SYSTEM_ISO2022_SEVEN(codesys) ((codesys)->iso2022.seven)
+#define CODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \
+ ((codesys)->iso2022.lock_shift)
+#define CODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \
+ ((codesys)->iso2022.no_iso6429)
+#define CODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \
+ ((codesys)->iso2022.escape_quoted)
+#define CODING_SYSTEM_CCL_DECODE(codesys) ((codesys)->ccl.decode)
+#define CODING_SYSTEM_CCL_ENCODE(codesys) ((codesys)->ccl.encode)
+
+#define XCODING_SYSTEM_NAME(codesys) \
+ CODING_SYSTEM_NAME (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_DOC_STRING(codesys) \
+ CODING_SYSTEM_DOC_STRING (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_TYPE(codesys) \
+ CODING_SYSTEM_TYPE (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_MNEMONIC(codesys) \
+ CODING_SYSTEM_MNEMONIC (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_POST_READ_CONVERSION(codesys) \
+ CODING_SYSTEM_POST_READ_CONVERSION (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \
+ CODING_SYSTEM_PRE_WRITE_CONVERSION (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_EOL_TYPE(codesys) \
+ CODING_SYSTEM_EOL_TYPE (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_EOL_LF(codesys) \
+ CODING_SYSTEM_EOL_LF (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_EOL_CRLF(codesys) \
+ CODING_SYSTEM_EOL_CRLF (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_EOL_CR(codesys) \
+ CODING_SYSTEM_EOL_CR (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \
+ CODING_SYSTEM_ISO2022_INITIAL_CHARSET (XCODING_SYSTEM (codesys), g)
+#define XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \
+ CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (XCODING_SYSTEM (codesys), g)
+#define XCODING_SYSTEM_ISO2022_SHORT(codesys) \
+ CODING_SYSTEM_ISO2022_SHORT (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \
+ CODING_SYSTEM_ISO2022_NO_ASCII_EOL (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \
+ CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_SEVEN(codesys) \
+ CODING_SYSTEM_ISO2022_SEVEN (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \
+ CODING_SYSTEM_ISO2022_LOCK_SHIFT (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \
+ CODING_SYSTEM_ISO2022_NO_ISO6429 (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \
+ CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_CCL_DECODE(codesys) \
+ CODING_SYSTEM_CCL_DECODE (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_CCL_ENCODE(codesys) \
+ CODING_SYSTEM_CCL_ENCODE (XCODING_SYSTEM (codesys))
+
+extern Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error;
+
+extern Lisp_Object Vkeyboard_coding_system;
+extern Lisp_Object Vterminal_coding_system;
+extern Lisp_Object Vcoding_system_for_read;
+extern Lisp_Object Vcoding_system_for_write;
+extern Lisp_Object Vpathname_coding_system;
+
+extern Lisp_Object Qescape_quoted;
+
+/* Flags indicating current state while converting code. */
+
+/* Used by everyone. */
+
+#define CODING_STATE_END (1 << 0) /* If set, this is the last chunk of
+ data being processed. When this
+ is finished, output any necessary
+ terminating control characters,
+ escape sequences, etc. */
+#define CODING_STATE_CR (1 << 1) /* If set, we just saw a CR. */
+
+
+/* Used by Big 5 on output. */
+
+#define CODING_STATE_BIG5_1 (1 << 2) /* If set, we just encountered
+ LEADING_BYTE_BIG5_1. */
+#define CODING_STATE_BIG5_2 (1 << 3) /* If set, we just encountered
+ LEADING_BYTE_BIG5_2. */
+
+
+/* Used by ISO2022 on input and output. */
+
+#define CODING_STATE_R2L (1 << 4) /* If set, the current
+ directionality is right-to-left.
+ Otherwise, it's left-to-right. */
+
+
+/* Used by ISO2022 on input. */
+
+#define CODING_STATE_ESCAPE (1 << 5) /* If set, we're currently parsing
+ an escape sequence and the upper
+ 16 bits should be looked at to
+ indicate what partial escape
+ sequence we've seen so far.
+ Otherwise, we're running
+ through actual text. */
+#define CODING_STATE_SS2 (1 << 6) /* If set, G2 is invoked into GL, but
+ only for the next character. */
+#define CODING_STATE_SS3 (1 << 7) /* If set, G3 is invoked into GL,
+ but only for the next character.
+ If both CODING_STATE_SS2 and
+ CODING_STATE_SS3 are set,
+ CODING_STATE_SS2 overrides; but
+ this probably indicates an error
+ in the text encoding. */
+#define CODING_STATE_COMPOSITE (1 << 8) /* If set, we're currently processing
+ a composite character (i.e. a
+ character constructed by
+ overstriking two or more
+ characters). */
+
+
+/* CODING_STATE_ISO2022_LOCK is the mask of flags that remain on until
+ explicitly turned off when in the ISO2022 encoder/decoder. Other flags are
+ turned off at the end of processing each character or escape sequence. */
+# define CODING_STATE_ISO2022_LOCK \
+ (CODING_STATE_END | CODING_STATE_COMPOSITE | CODING_STATE_R2L)
+#define CODING_STATE_BIG5_LOCK \
+ CODING_STATE_END
+
+/* Flags indicating what we've seen so far when parsing an
+ ISO2022 escape sequence. */
+enum iso_esc_flag
+{
+ /* Partial sequences */
+ ISO_ESC_NOTHING, /* Nothing has been seen. */
+ ISO_ESC, /* We've seen ESC. */
+ ISO_ESC_2_4, /* We've seen ESC $. This indicates
+ that we're designating a multi-byte, rather
+ than a single-byte, character set. */
+ ISO_ESC_2_8, /* We've seen ESC 0x28, i.e. ESC (.
+ This means designate a 94-character
+ character set into G0. */
+ ISO_ESC_2_9, /* We've seen ESC 0x29 -- designate a
+ 94-character character set into G1. */
+ ISO_ESC_2_10, /* We've seen ESC 0x2A. */
+ ISO_ESC_2_11, /* We've seen ESC 0x2B. */
+ ISO_ESC_2_12, /* We've seen ESC 0x2C -- designate a
+ 96-character character set into G0.
+ (This is not ISO2022-standard.
+ The following 96-character
+ control sequences are standard,
+ though.) */
+ ISO_ESC_2_13, /* We've seen ESC 0x2D -- designate a
+ 96-character character set into G1.
+ */
+ ISO_ESC_2_14, /* We've seen ESC 0x2E. */
+ ISO_ESC_2_15, /* We've seen ESC 0x2F. */
+ ISO_ESC_2_4_8, /* We've seen ESC $ 0x28 -- designate
+ a 94^N character set into G0. */
+ ISO_ESC_2_4_9, /* We've seen ESC $ 0x29. */
+ ISO_ESC_2_4_10, /* We've seen ESC $ 0x2A. */
+ ISO_ESC_2_4_11, /* We've seen ESC $ 0x2B. */
+ ISO_ESC_2_4_12, /* We've seen ESC $ 0x2C. */
+ ISO_ESC_2_4_13, /* We've seen ESC $ 0x2D. */
+ ISO_ESC_2_4_14, /* We've seen ESC $ 0x2E. */
+ ISO_ESC_2_4_15, /* We've seen ESC $ 0x2F. */
+ ISO_ESC_5_11, /* We've seen ESC [ or 0x9B. This
+ starts a directionality-control
+ sequence. The next character
+ must be 0, 1, 2, or ]. */
+ ISO_ESC_5_11_0, /* We've seen 0x9B 0. The next
+ character must be ]. */
+ ISO_ESC_5_11_1, /* We've seen 0x9B 1. The next
+ character must be ]. */
+ ISO_ESC_5_11_2, /* We've seen 0x9B 2. The next
+ character must be ]. */
+
+ /* Full sequences. */
+ ISO_ESC_START_COMPOSITE, /* Private usage for START COMPOSING */
+ ISO_ESC_END_COMPOSITE, /* Private usage for END COMPOSING */
+ ISO_ESC_SINGLE_SHIFT, /* We've seen a complete single-shift sequence. */
+ ISO_ESC_LOCKING_SHIFT,/* We've seen a complete locking-shift sequence. */
+ ISO_ESC_DESIGNATE, /* We've seen a complete designation sequence. */
+ ISO_ESC_DIRECTIONALITY,/* We've seen a complete ISO6429 directionality
+ sequence. */
+ ISO_ESC_LITERAL /* We've seen a literal character ala
+ escape-quoting. */
+};
+
+/* Macros to define code of control characters for ISO2022's functions. */
+ /* code */ /* function */
+#define ISO_CODE_LF 0x0A /* line-feed */
+#define ISO_CODE_CR 0x0D /* carriage-return */
+#define ISO_CODE_SO 0x0E /* shift-out */
+#define ISO_CODE_SI 0x0F /* shift-in */
+#define ISO_CODE_ESC 0x1B /* escape */
+#define ISO_CODE_DEL 0x7F /* delete */
+#define ISO_CODE_SS2 0x8E /* single-shift-2 */
+#define ISO_CODE_SS3 0x8F /* single-shift-3 */
+#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */
+
+/* Macros to access an encoding stream or decoding stream */
+
+#define CODING_STREAM_DECOMPOSE(str, flags, ch) \
+do { \
+ flags = (str)->flags; \
+ ch = (str)->ch; \
+} while (0)
+
+#define CODING_STREAM_COMPOSE(str, flags, ch) \
+do { \
+ (str)->flags = flags; \
+ (str)->ch = ch; \
+} while (0)
+
+
+/* For detecting the encoding of text */
+enum coding_category_type
+{
+ CODING_CATEGORY_SHIFT_JIS,
+ CODING_CATEGORY_ISO_7, /* ISO2022 system using only seven-bit bytes,
+ no locking shift */
+ CODING_CATEGORY_ISO_8_DESIGNATE, /* ISO2022 system using eight-bit bytes,
+ no locking shift, no single shift,
+ using designation to switch charsets */
+ CODING_CATEGORY_ISO_8_1, /* ISO2022 system using eight-bit bytes,
+ no locking shift, no designation sequences,
+ one-dimension characters in the upper half. */
+ CODING_CATEGORY_ISO_8_2, /* ISO2022 system using eight-bit bytes,
+ no locking shift, no designation sequences,
+ two-dimension characters in the upper half. */
+ CODING_CATEGORY_ISO_LOCK_SHIFT, /* ISO2022 system using locking shift */
+ CODING_CATEGORY_BIG5,
+ CODING_CATEGORY_NO_CONVERSION
+};
+
+#define CODING_CATEGORY_LAST CODING_CATEGORY_NO_CONVERSION
+
+#define CODING_CATEGORY_SHIFT_JIS_MASK \
+ (1 << CODING_CATEGORY_SHIFT_JIS)
+#define CODING_CATEGORY_ISO_7_MASK \
+ (1 << CODING_CATEGORY_ISO_7)
+#define CODING_CATEGORY_ISO_8_DESIGNATE_MASK \
+ (1 << CODING_CATEGORY_ISO_8_DESIGNATE)
+#define CODING_CATEGORY_ISO_8_1_MASK \
+ (1 << CODING_CATEGORY_ISO_8_1)
+#define CODING_CATEGORY_ISO_8_2_MASK \
+ (1 << CODING_CATEGORY_ISO_8_2)
+#define CODING_CATEGORY_ISO_LOCK_SHIFT_MASK \
+ (1 << CODING_CATEGORY_ISO_LOCK_SHIFT)
+#define CODING_CATEGORY_BIG5_MASK \
+ (1 << CODING_CATEGORY_BIG5)
+#define CODING_CATEGORY_NO_CONVERSION_MASK \
+ (1 << CODING_CATEGORY_NO_CONVERSION)
+#define CODING_CATEGORY_NOT_FINISHED_MASK \
+ (1 << 30)
+
+/* Convert shift-JIS code (sj1, sj2) into internal string
+ representation (c1, c2). (The leading byte is assumed.) */
+
+#define DECODE_SJIS(sj1, sj2, c1, c2) \
+do { \
+ int I1 = sj1, I2 = sj2; \
+ if (I2 >= 0x9f) \
+ c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe0 : 0x60), \
+ c2 = I2 + 2; \
+ else \
+ c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe1 : 0x61), \
+ c2 = I2 + ((I2 >= 0x7f) ? 0x60 : 0x61); \
+} while (0)
+
+/* Convert the internal string representation of a Shift-JIS character
+ (c1, c2) into Shift-JIS code (sj1, sj2). The leading byte is
+ assumed. */
+
+#define ENCODE_SJIS(c1, c2, sj1, sj2) \
+do { \
+ int I1 = c1, I2 = c2; \
+ if (I1 & 1) \
+ sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x31 : 0x71), \
+ sj2 = I2 - ((I2 >= 0xe0) ? 0x60 : 0x61); \
+ else \
+ sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x30 : 0x70), \
+ sj2 = I2 - 2; \
+} while (0)
+
+Lisp_Object make_decoding_input_stream (Lstream *stream, Lisp_Object codesys);
+Lisp_Object make_encoding_input_stream (Lstream *stream, Lisp_Object codesys);
+Lisp_Object make_decoding_output_stream (Lstream *stream, Lisp_Object codesys);
+Lisp_Object make_encoding_output_stream (Lstream *stream, Lisp_Object codesys);
+Lisp_Object decoding_stream_coding_system (Lstream *stream);
+Lisp_Object encoding_stream_coding_system (Lstream *stream);
+void set_decoding_stream_coding_system (Lstream *stream, Lisp_Object codesys);
+void set_encoding_stream_coding_system (Lstream *stream, Lisp_Object codesys);
+void determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out,
+ enum eol_type *eol_type_in_out);
+#endif /* _XEMACS_MULE_CODING_H_ */
--- /dev/null
+/* Support for Non-ASCII Path Name
+ Copyright (C) 1985, 1986, 1992, 1993, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Mule 2.3. Not in FSF. */
+
+/* mcpath.h should be included in config.h */
+#include <config.h>
+#include "lisp.h"
+
+#include "sysfile.h"
+#include "buffer.h"
+#include "mule.h"
+
+Lisp_Object Qpathname_coding_system = 0;
+
+static void
+mcpath_encode_code (struct Lisp_Coding_System *cp)
+{
+ Lisp_Object coding_system;
+
+ coding_system = Fsymbol_value (Qpathname_coding_system);
+
+ mule_encode_code (coding_system, cp);
+ CODE_CNTL (cp) |= CC_END;
+}
+
+static int
+mule_encode_path_1 (unsigned char *src, unsigned int srcsize,
+ unsigned char *dst, unsigned int dstsize)
+{
+ struct Lisp_Coding_System code;
+
+ mcpath_encode_code (&code);
+ if (CODE_TYPE (&code) > MULE_AUTOCONV)
+ {
+ unsigned char *buf;
+
+ /* get_conversion_buffer () is not */
+ /* re-entrant. */
+ buf = (unsigned char *) alloca (MULE_ENCODE_BUF_SIZE (srcsize, &code));
+ if (buf)
+ {
+ int len;
+ Lisp_Object dummy = Qnil;
+
+ len = mule_encode (&code, src, buf, srcsize, &dummy);
+ if (!CODE_CHAR (&code) && len <= dstsize)
+ {
+ memcpy (dst, buf, len);
+ return len;
+ }
+ }
+ }
+ return -1; /* use original */
+}
+
+static unsigned char *
+mule_decode_path_1 (unsigned char *src, unsigned char *dst,
+ unsigned int dstsize)
+{
+ struct Lisp_Coding_System code;
+
+ mcpath_encode_code (&code);
+ if (CODE_TYPE (&code) > MULE_AUTOCONV)
+ {
+ int len;
+ unsigned char *buf;
+
+ len = strlen (src) + 1; /* + 1 for '\0' */
+
+ /* get_conversion_buffer () is not */
+ /* re-entrant. */
+ buf = (unsigned char *) alloca (MULE_DECODE_BUF_SIZE (len, &code));
+ if (buf)
+ {
+ CODE_CNTL (&code) |= CC_END;
+ len = mule_decode (&code, src, buf, len);
+ if (!CODE_CHAR (&code) && len <= dstsize)
+ {
+ memcpy (dst, buf, len); /* len should include '\0' */
+ return dst;
+ }
+ }
+ }
+ return src;
+}
+
+static unsigned char *
+mule_decode_path (unsigned char *path, unsigned char ext_path[MC_MAXPATHLEN])
+{
+ return
+ (Qpathname_coding_system
+ ? mule_decode_path_1 (path, ext_path, MC_MAXPATHLEN)
+ : path); /* in case of before initialization */
+}
+
+static unsigned char *
+mule_encode_path (unsigned char *path, unsigned char *encode_buffer,
+ unsigned int size)
+{
+ int len;
+
+ len = mule_encode_path_1 (path, strlen (path), encode_buffer, size);
+ if (len > 0)
+ path = encode_buffer;
+#ifdef MSDOS
+ /* convert the MSDOS style path delimiter to the UNIX style. Note
+ that now the code is *internal*, so we can simply compare each
+ character with '\\'. And this operation will alter the contents
+ of Lisp Object, PATH. */
+ {
+ unsigned char *p = path;
+
+ while (*p)
+ {
+ if (*p == '\\')
+ *p = '/';
+ p++;
+ }
+ }
+#endif /* MSDOS */
+ return path;
+}
+
+#if 0 /* example of how they do it (similar junk deleted) ... */
+
+int
+mc_creat (unsigned char *path, int mode)
+{
+ unsigned char buffer[MC_MAXPATHLEN];
+ return creat (mule_decode_path (path, buffer), mode);
+}
+
+int
+mc_readlink (unsigned char *path, unsigned char *buf, int size)
+{
+ unsigned char buffer[MC_MAXPATHLEN], buffer2[MAXPATHLEN];
+ int nread;
+
+ nread = readlink (mule_decode_path (path, buffer), buffer2, MAXPATHLEN);
+ if (nread > 0)
+ {
+ int len;
+ unsigned char *p;
+
+ len = mule_encode_path_1 (buffer2, nread, buffer, sizeof (buffer));
+ if (0 <= len && len <= size)
+ {
+ memcpy (buf, buffer, len);
+ return len;
+ }
+ }
+ return -1;
+}
+
+int
+mc_chdir (unsigned char *path)
+{
+ unsigned char buffer[MC_MAXPATHLEN];
+
+ path = mule_decode_path (path, buffer);
+
+#ifdef MSDOS
+ if ((path[0] != 0) && (path[1] == ':'))
+ {
+ int drive = (tolower (path[0]) - 'a');
+ if (getdisk () != drive)
+ setdisk (drive);
+ }
+
+ /* If path != "/" and path != "a:/" and path ends with slash, remove
+ it. */
+ {
+ int len = strlen (path);
+
+ if (strcmp (path + 1, ":/") && (len > 1) && (path[len - 1] == '/'))
+ {
+ if (path != buffer) /* It is not good to modify original path. */
+ {
+ memcpy (buffer, path, len - 1); /* no need to copy last /. */
+ path = buffer;
+ }
+ path[len - 1] = 0;
+ }
+ }
+#endif /* MSDOS */
+
+ return chdir (path);
+}
+
+#ifdef MSDOS
+#ifndef HAVE_GETWD
+unsigned char *
+mc_getcwd (unsigned char *null, size_t size)
+{
+ unsigned char buffer[MAXPATHLEN];
+ unsigned char *path;
+
+ path = (unsigned char *) getcwd ((char *)buffer, MAXPATHLEN);
+ if (path)
+ {
+ /* here, should be (path == buffer). */
+ path = (unsigned char *) xmalloc (MC_MAXPATHLEN); /* MSDOS */
+ if (path)
+ {
+ int len;
+ int buffer_length = strlen (buffer) + 1;
+
+ len = mule_encode_path_1 (buffer, buffer_length, path, MC_MAXPATHLEN);
+ if (len < 0)
+ {
+ /* conversion failed. use value that is returned from system. */
+ memcpy (path, buffer, buffer_length);
+ }
+ }
+ }
+ return path;
+}
+#else /* HAVE_GETWD */
+unsigned char *
+mc_getwd (unsigned char path[])
+{
+ unsigned char *p;
+
+ p = getwd (path);
+ if (p)
+ {
+ unsigned char buffer[MC_MAXPATHLEN];
+ int len;
+
+ len = mule_encode_path_1 (path, strlen (path) + 1, buffer, sizeof buffer);
+ if (len > 0)
+ {
+ memcpy (path, buffer, len);
+ }
+ }
+ return p;
+}
+#endif /* HAVE_GETWD */
+#endif /* MSDOS */
+
+/* In callproc.c, execvp() is called like this:
+ * execvp (new_argv[0], new_argv);
+ * following implement depends this.
+ */
+#ifndef NO_MC_EXECVP
+void
+mc_execvp (unsigned char *path, unsigned char *argv[])
+{
+ unsigned char buffer[MC_MAXPATHLEN];
+ argv[0] = path = mule_decode_path (path, buffer);
+ execvp (path, argv);
+}
+#endif /* !NO_MC_EXECVP */
+
+static DIRENTRY mcpath_directory_entry;
+DIRENTRY *
+mc_readdir (DIR *d)
+{
+ SYSTEM_DIRENTRY *sp;
+ DIRENTRY *dp = &mcpath_directory_entry;
+
+ sp = readdir (d);
+ if (!sp) return 0;
+
+#ifndef MSDOS
+ dp->d_ino = sp->d_ino;
+#endif /* MSDOS */
+ { /* copy d_name with conversion. */
+ int len;
+
+ len = mule_encode_path_1 (sp->d_name, NAMLEN (sp),
+ dp->d_name, sizeof (dp->d_name) - 1);
+ if (len < 0)
+ {
+ len = NAMLEN (sp);
+#ifdef MCPATH_ASSERT
+ assert (len < sizeof (dp->d_name));
+#endif
+ memcpy (dp->d_name, sp->d_name, len);
+ }
+ dp->d_name[len] = 0;
+ }
+ return dp;
+}
+
+#endif /* 0 */
+
--- /dev/null
+/* Support for Non-ASCII Path Name
+ Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Sun Microsystems, Inc.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Mule 2.3. Not in FSF. */
+
+/* This part cannot be surround with #ifdef emacs, because it is needed */
+/* during generate xmakefile. */
+#ifndef MCPATH
+# define MCPATH
+#endif /* !MCPATH */
+
+/* not to confuse while compiling etc/*.c */
+#ifdef emacs
+#ifdef MCPATH
+# ifndef _MCPATH_H /* enable to include twice */
+
+#if 1
+\f
+/* !!! This page is copied from dired.c except that DIRENTRY is
+ changed to SYSTEM_DIRENTRY. Don't modify this page. */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+/* The d_nameln member of a struct dirent includes the '\0' character
+ on some systems, but not on others. What's worse, you can't tell
+ at compile-time which one it will be, since it really depends on
+ the sort of system providing the filesystem you're reading from,
+ not the system you are running on. Paul Eggert
+ <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
+ SunOS 4.1.2 host, reading a directory that is remote-mounted from a
+ Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
+
+ Since applying strlen to the name always works, we'll just do that. */
+#define NAMLEN(p) strlen (p->d_name)
+
+#ifdef SYSV_SYSTEM_DIR
+
+#include <dirent.h>
+#define SYSTEM_DIRENTRY struct dirent
+
+#else /* not SYSV_SYSTEM_DIR */
+
+#ifdef NONSYSTEM_DIR_LIBRARY
+#include "ndir.h"
+#else /* not NONSYSTEM_DIR_LIBRARY */
+#ifdef MSDOS
+#include <dirent.h>
+#else
+#include <sys/dir.h>
+#endif
+#endif /* not NONSYSTEM_DIR_LIBRARY */
+
+#ifndef MSDOS
+#define SYSTEM_DIRENTRY struct direct
+
+extern DIR *opendir ();
+extern struct direct *readdir ();
+
+#endif /* not MSDOS */
+#endif /* not SYSV_SYSTEM_DIR */
+#endif
+\f
+ /* maximum buffer size to do conversion. */
+#define MCPATH_BUFSIZ(s) (((s) * 3) + 256)
+#define MC_MAXPATHLEN MCPATH_BUFSIZ (MAXPATHLEN)
+
+#define DIRENTRY struct mcpath_direntry
+struct mcpath_direntry
+{
+ /* emacs 19.28 uses d_ino and d_name. */
+#ifndef MSDOS
+ int d_ino;
+#endif /* not MSDOS */
+ unsigned char d_name [MCPATH_BUFSIZ (MAXNAMLEN) + 1];
+};
--- /dev/null
+/* This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: FSF 19.30. Split out of alloc.c. */
+
+#include <config.h>
+#include "lisp.h"
+#include "puresize.h"
+
+/* Moved from puresize.h to here so alloc.c does not get recompiled */
+
+# include <puresize-adjust.h>
+#define PURESIZE ((RAW_PURESIZE) + (PURESIZE_ADJUSTMENT))
+
+size_t
+get_PURESIZE (void)
+{
+ return PURESIZE;
+}
+
+/* Force linker to put it into data space! */
+EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = { (EMACS_INT) 0};
--- /dev/null
+/* Definition of PURESIZE.
+ Copyright (C) 1986, 1988, 1992, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996 Ben Wing.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in FSF. */
+
+#ifndef PURESIZE_H
+#define PURESIZE_H
+
+/* If RAW_PURESIZE is already defined then the user overrode it at
+ configure time. */
+#ifndef RAW_PURESIZE
+
+/* Basic amount of purespace to use, in the absence of extra
+ things configured in. */
+
+
+/* This computation is Barbra Streisand, BS
+#if (LONGBITS == 64)
+# define BASE_PURESIZE 938000
+#else
+# define BASE_PURESIZE 563000
+#endif
+*/
+
+#define BASE_PURESIZE 1400000
+
+/* If any particular systems need to change the base puresize, they
+ should define SYSTEM_PURESIZE_EXTRA. Note that this can be
+ negative as well as positive.
+
+ Do NOT define PURESIZE or any other values. This allows the
+ other values to shift while still keeping things in sync. */
+
+#ifndef SYSTEM_PURESIZE_EXTRA
+# define SYSTEM_PURESIZE_EXTRA 0
+#endif
+
+/* Extra amount of purespace needed for menubars. */
+
+#ifdef HAVE_DIALOGS
+# if (LONGBITS == 64)
+# define DIALOG_PURESIZE_EXTRA 43000
+# else
+# define DIALOG_PURESIZE_EXTRA 1800
+# endif
+#else
+# define DIALOG_PURESIZE_EXTRA 0
+#endif
+
+#ifdef HAVE_MENUBARS
+# if (LONGBITS == 64)
+# define MENUBAR_PURESIZE_EXTRA 43000
+# else
+# define MENUBAR_PURESIZE_EXTRA 36000
+# endif
+#else
+# define MENUBAR_PURESIZE_EXTRA 0
+#endif
+
+#ifdef HAVE_SCROLLBARS
+# if (LONGBITS == 64)
+# define SCROLLBAR_PURESIZE_EXTRA 4000
+# else
+# define SCROLLBAR_PURESIZE_EXTRA 1800
+# endif
+#else
+# define SCROLLBAR_PURESIZE_EXTRA 0
+#endif
+
+#ifdef HAVE_TOOLBARS
+# if (LONGBITS == 64)
+# define TOOLBAR_PURESIZE_EXTRA 4000
+# else
+# define TOOLBAR_PURESIZE_EXTRA 8400
+# endif
+#else
+# define TOOLBAR_PURESIZE_EXTRA 0
+#endif
+
+/* Extra amount of purespace needed for X11, separate from menubars
+ and scrollbars. */
+
+#ifdef HAVE_X_WINDOWS
+# if (LONGBITS == 64)
+# define X11_PURESIZE_EXTRA 95000
+# else
+# define X11_PURESIZE_EXTRA 68000
+# endif
+#else
+# define X11_PURESIZE_EXTRA 0
+#endif
+
+/* Extra amount of purespace needed for Mule. */
+
+#ifdef MULE
+#ifdef HAVE_CANNA
+# define MULE_PURESIZE_CANNA 5000
+#else
+# define MULE_PURESIZE_CANNA 0
+#endif
+#ifdef HAVE_WNN
+# define MULE_PURESIZE_WNN 5000
+#else
+# define MULE_PURESIZE_WNN 0
+#endif
+# if (LONGBITS == 64)
+# define MULE_PURESIZE_EXTRA 99000+MULE_PURESIZE_CANNA+MULE_PURESIZE_WNN
+# else
+# define MULE_PURESIZE_EXTRA 78000+MULE_PURESIZE_CANNA+MULE_PURESIZE_WNN
+# endif
+#else
+# define MULE_PURESIZE_EXTRA 0
+#endif
+
+/* Extra amount of purespace needed for Tooltalk. */
+
+#ifdef TOOLTALK
+# if (LONGBITS == 64)
+# define TOOLTALK_PURESIZE_EXTRA 100000
+# else
+# define TOOLTALK_PURESIZE_EXTRA 8300
+# endif
+#else
+# define TOOLTALK_PURESIZE_EXTRA 0
+#endif
+
+/* Extra amount of purespace needed for Sunpro builds. */
+
+#ifdef SUNPRO
+#define SUNPRO_PURESIZE_EXTRA 95000
+#else
+# define SUNPRO_PURESIZE_EXTRA 0
+#endif
+
+#define RAW_PURESIZE ((BASE_PURESIZE) + \
+ (DIALOG_PURESIZE_EXTRA) + \
+ (MENUBAR_PURESIZE_EXTRA) + \
+ (SCROLLBAR_PURESIZE_EXTRA) + \
+ (TOOLBAR_PURESIZE_EXTRA) + \
+ (X11_PURESIZE_EXTRA) + \
+ (SYSTEM_PURESIZE_EXTRA) + \
+ (MULE_PURESIZE_EXTRA) + \
+ (TOOLTALK_PURESIZE_EXTRA) + \
+ (SUNPRO_PURESIZE_EXTRA))
+
+#endif /* !RAW_PURESIZE */
+
+# include <puresize-adjust.h>
+#define PURESIZE ((RAW_PURESIZE) + (PURESIZE_ADJUSTMENT))
+#define get_PURESIZE() PURESIZE
+
+extern EMACS_INT pure[];
+
+#endif /* PURESIZE_H */
--- /dev/null
+/* System description file for MS-DOS
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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.
+
+GNU Emacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: FSF 19.31. */
+
+/* Note: lots of stuff here was taken from s-msdos.h in demacs. */
+
+
+/*
+ * Define symbols to identify the version of Unix this is.
+ * Define all the symbols that apply correctly.
+ */
+
+/* #define UNIPLUS */
+/* #define USG5 */
+/* #define USG */
+/* #define HPUX */
+/* #define UMAX */
+/* #define BSD4_1 */
+/* #define BSD4_2 */
+/* #define BSD4_3 */
+/* #define BSD */
+#ifndef MSDOS
+#define MSDOS
+#endif
+
+#ifdef __GO32__
+#ifndef __DJGPP__
+#define __DJGPP__ 1 /* V2 defines __DJGPP__ == 2 */
+#endif
+#else
+You lose; /* Emacs for DOS must be compiled with DJGPP */
+#endif
+
+#define DOS_NT /* MSDOS or WINDOWSNT */
+#undef BSD
+
+/* SYSTEM_TYPE should indicate the kind of system you are using.
+ It sets the Lisp variable system-type. */
+
+#define SYSTEM_TYPE "ms-dos"
+
+#define SYMS_SYSTEM syms_of_dosfns();syms_of_msdos()
+
+/* Letter to use in finding device name of first pty,
+ if system supports pty's. 'a' means it is /dev/ptya0 */
+
+/* #define FIRST_PTY_LETTER 'a' */
+
+/*
+ * Define HAVE_PTYS if the system supports pty devices.
+ */
+
+/* #define HAVE_PTYS */
+
+/* MSDOS has dirent.h but doesn't behave otherwise like the SYSV
+ directory functions. We have special tests for this in
+ sysdir.h. */
+
+#undef SYSV_SYSTEM_DIR
+
+/* Define this is the compiler understands `volatile'. */
+#define HAVE_VOLATILE
+
+#define NO_SUBPROCESSES
+
+/* If your system uses COFF (Common Object File Format) then define the
+ preprocessor symbol "COFF". */
+
+#define COFF
+
+/* define MAIL_USE_FLOCK if the mailer uses flock
+ to interlock access to /usr/spool/mail/$USER.
+ The alternative is that a lock file named
+ /usr/spool/mail/$USER.lock. */
+
+/* #define MAIL_USE_FLOCK */
+
+/* Here, on a separate page, add any special hacks needed
+ to make Emacs work on this system. For example,
+ you might define certain system call names that don't
+ exist on your system, or that do different things on
+ your system and must be used only through an encapsulation
+ (Which you should place, by convention, in sysdep.c). */
+\f
+/* Avoid incompatibilities between gmalloc.c and system header files
+ in how to declare valloc. */
+#define GMALLOC_INHIBIT_VALLOC
+
+/* setjmp and longjmp can safely replace _setjmp and _longjmp,
+ but they will run slower. */
+
+#define _setjmp setjmp
+#define _longjmp longjmp
+
+#if __DJGPP__ < 2
+
+#define NO_MODE_T
+
+/* New chdir () routine.
+ DJGPP v2.0 and later doesn't need it because its chdir() does
+ set the drive itself. */
+#ifdef chdir
+#undef chdir
+#endif
+#define chdir sys_chdir
+
+#define LIBS_SYSTEM "-lpc" /* isn't required in DJGPP v2.0, either */
+
+#endif /* __DJGPP__ < 2 */
+
+#if __DJGPP__ > 1
+
+#define DATA_START (&etext + 1)
+#define TEXT_START &start
+#define TEXT_END &etext
+
+#define _NAIVE_DOS_REGS
+
+#else /* not __DJGPP__ > 1 */
+
+/* This somehow needs to be defined even though we use COFF. */
+#define TEXT_START -1
+
+#endif /* not __DJGPP__ > 1 */
+
+#define ORDINARY_LINK
+
+/* command.com does not understand `...` so we define this. */
+#define LIB_GCC "-Lgcc"
+#define DONT_NEED_ENVIRON
+#define SEPCHAR ';'
+
+#define NULL_DEVICE "nul"
+#define EXEC_SUFFIXES ".exe:.com:.bat:"
+
+#if __DJGPP__ < 2
+#define O_RDONLY 0x0001
+#define O_WRONLY 0x0002
+#define O_RDWR 0x0004
+#define O_CREAT 0x0100
+#define O_TRUNC 0x0200
+#define O_EXCL 0x0400
+#define O_APPEND 0x0800
+#define O_TEXT 0x4000
+#define O_BINARY 0x8000
+#define NO_MATHERR
+#endif
+
+#define HAVE_INVERSE_HYPERBOLIC
+#define FLOAT_CHECK_DOMAIN
+
+/* When $TERM is "internal" then this is substituted: */
+#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display:\
+:co#80:li#25:km:ms:cm=<CM>:cl=<CL>:ce=<CE>:"
+
+/* Define this to a function (Fdowncase, Fupcase) if your file system
+ likes that */
+#define FILE_SYSTEM_CASE Fmsdos_downcase_filename
+
+/* Define this to be the separator between devices and paths */
+#define DEVICE_SEP ':'
+
+/* We'll support either convention on MSDOG. */
+#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
+#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
+
+/* Call init_gettimeofday when TZ changes. */
+#if __DJGPP__ < 2
+#define LOCALTIME_CACHE
+#define tzset init_gettimeofday
+#endif
+
+/* bcopy under djgpp is quite safe */
+#define GAP_USE_BCOPY
+#define BCOPY_UPWARD_SAFE 1
+#define BCOPY_DOWNWARD_SAFE 1
+
+/* Mode line description of a buffer's type. */
+#define MODE_LINE_BINARY_TEXT(buf) (NILP(buf->buffer_file_type) ? "T" : "B")
+
+/* Do we have POSIX signals? */
+#if __DJGPP__ > 1
+#define POSIX_SIGNALS
+#endif
+
+/* We have (the code to control) a mouse. */
+#define HAVE_MOUSE
+
+/* We canuse mouse menus. */
+#define HAVE_MENUS
+
+/* We have support for faces. */
+#define HAVE_FACES
+
+/* Define one of these for easier conditionals. */
+#ifdef HAVE_X_WINDOWS
+/* We need a little extra space, see ../../lisp/loadup.el */
+#define SYSTEM_PURESIZE_EXTRA 15000
+#define HAVE_X11R5
+#define LIBX11_SYSTEM "-lxext -lsys"
+#else
+/* We need a little extra space, see ../../lisp/loadup.el */
+#define SYSTEM_PURESIZE_EXTRA 85000
+#endif
--- /dev/null
+/* Synched up with: FSF 19.31. */
+
+/* System description file for Windows 95. */
+
+#include "windowsnt.h"
+
+#define WINDOWS95
--- /dev/null
+/* X Selection processing for XEmacs
+ Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of XEmacs.
+
+XEmacs 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.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not synched with FSF. */
+
+/* Rewritten by jwz */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "console-x.h"
+#include "objects-x.h"
+
+#include "frame.h"
+#include "opaque.h"
+#include "systime.h"
+
+int lisp_to_time (Lisp_Object, time_t *);
+Lisp_Object time_to_lisp (time_t);
+
+#ifdef LWLIB_USES_MOTIF
+# define MOTIF_CLIPBOARDS
+#endif
+
+#ifdef MOTIF_CLIPBOARDS
+# include <Xm/CutPaste.h>
+static void hack_motif_clipboard_selection (Atom selection_atom,
+ Lisp_Object selection_value,
+ Time thyme, Display *display,
+ Window selecting_window,
+ Bool owned_p);
+#endif
+
+#define CUT_BUFFER_SUPPORT
+
+Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
+ QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
+ QATOM_PAIR, QCOMPOUND_TEXT;
+
+#ifdef CUT_BUFFER_SUPPORT
+Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
+ QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
+#endif
+
+Lisp_Object Vx_lost_selection_hooks;
+Lisp_Object Vx_sent_selection_hooks;
+
+/* If this is a smaller number than the max-request-size of the display,
+ emacs will use INCR selection transfer when the selection is larger
+ than this. The max-request-size is usually around 64k, so if you want
+ emacs to use incremental selection transfers when the selection is
+ smaller than that, set this. I added this mostly for debugging the
+ incremental transfer stuff, but it might improve server performance.
+ */
+#define MAX_SELECTION_QUANTUM 0xFFFFFF
+
+#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
+
+/* This is an association list whose elements are of the form
+ ( selection-name selection-value selection-timestamp )
+ selection-name is a lisp symbol, whose name is the name of an X Atom.
+ selection-value is the value that emacs owns for that selection.
+ It may be any kind of Lisp object.
+ selection-timestamp is the time at which emacs began owning this selection,
+ as a cons of two 16-bit numbers (making a 32 bit time).
+ If there is an entry in this alist, then it can be assumed that emacs owns
+ that selection.
+ The only (eq) parts of this list that are visible from elisp are the
+ selection-values.
+ */
+Lisp_Object Vselection_alist;
+
+/* This is an alist whose CARs are selection-types (whose names are the same
+ as the names of X Atoms) and whose CDRs are the names of Lisp functions to
+ call to convert the given Emacs selection value to a string representing
+ the given selection type. This is for elisp-level extension of the emacs
+ selection handling.
+ */
+Lisp_Object Vselection_converter_alist;
+
+/* "Selection owner couldn't convert selection" */
+Lisp_Object Qselection_conversion_error;
+
+/* If the selection owner takes too long to reply to a selection request,
+ we give up on it. This is in seconds (0 = no timeout).
+ */
+int x_selection_timeout;
+
+\f
+/* Utility functions */
+
+static void lisp_data_to_selection_data (struct device *,
+ Lisp_Object obj,
+ unsigned char **data_ret,
+ Atom *type_ret,
+ unsigned int *size_ret,
+ int *format_ret);
+static Lisp_Object selection_data_to_lisp_data (struct device *,
+ unsigned char *data,
+ size_t size,
+ Atom type,
+ int format);
+static Lisp_Object x_get_window_property_as_lisp_data (Display *,
+ Window,
+ Atom property,
+ Lisp_Object target_type,
+ Atom selection_atom);
+
+static int expect_property_change (Display *, Window, Atom prop, int state);
+static void wait_for_property_change (long);
+static void unexpect_property_change (int);
+static int waiting_for_other_props_on_window (Display *, Window);
+
+/* This converts a Lisp symbol to a server Atom, avoiding a server
+ roundtrip whenever possible.
+ */
+static Atom
+symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists)
+{
+ Display *display = DEVICE_X_DISPLAY (d);
+
+ if (NILP (sym)) return XA_PRIMARY;
+ if (EQ (sym, Qt)) return XA_SECONDARY;
+ if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
+ if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
+ if (EQ (sym, QSTRING)) return XA_STRING;
+ if (EQ (sym, QINTEGER)) return XA_INTEGER;
+ if (EQ (sym, QATOM)) return XA_ATOM;
+ if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
+ if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
+ if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
+ if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
+ if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
+ if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
+ if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
+ if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
+ if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
+ if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
+ if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
+
+#ifdef CUT_BUFFER_SUPPORT
+ if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
+ if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
+ if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
+ if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
+ if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
+ if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
+ if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
+ if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
+#endif /* CUT_BUFFER_SUPPORT */
+
+ {
+ CONST char *nameext;
+ GET_C_STRING_CTEXT_DATA_ALLOCA (Fsymbol_name (sym), nameext);
+ return XInternAtom (display, nameext, only_if_exists ? True : False);
+ }
+}
+
+
+/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
+ and calls to intern whenever possible.
+ */
+static Lisp_Object
+x_atom_to_symbol (struct device *d, Atom atom)
+{
+ Display *display = DEVICE_X_DISPLAY (d);
+
+ if (! atom) return Qnil;
+ if (atom == XA_PRIMARY) return QPRIMARY;
+ if (atom == XA_SECONDARY) return QSECONDARY;
+ if (atom == XA_STRING) return QSTRING;
+ if (atom == XA_INTEGER) return QINTEGER;
+ if (atom == XA_ATOM) return QATOM;
+ if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
+ if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
+ if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
+ if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
+ if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
+ if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
+ if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
+ if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
+ if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
+ if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
+ if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
+
+#ifdef CUT_BUFFER_SUPPORT
+ if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
+ if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
+ if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
+ if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
+ if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
+ if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
+ if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
+ if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
+#endif
+
+ {
+ Lisp_Object newsym;
+ CONST Bufbyte *intstr;
+ char *str = XGetAtomName (display, atom);
+
+ if (! str) return Qnil;
+
+ GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA (str, intstr);
+ newsym = intern ((char *) intstr);
+ XFree (str);
+ return newsym;
+ }
+}
+
+\f
+/* Do protocol to assert ourself as a selection owner.
+ Update the Vselection_alist so that we can reply to later requests for
+ our selection.
+ */
+static void
+x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ struct frame *sel_frame = selected_frame ();
+ Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
+ /* Use the time of the last-read mouse or keyboard event.
+ For selection purposes, we use this as a sleazy way of knowing what the
+ current time is in server-time. This assumes that the most recently read
+ mouse or keyboard event has something to do with the assertion of the
+ selection, which is probably true.
+ */
+ Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
+ Atom selection_atom;
+
+ CHECK_SYMBOL (selection_name);
+ selection_atom = symbol_to_x_atom (d, selection_name, 0);
+
+ XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
+
+ /* Now update the local cache */
+ {
+ /* We do NOT use time_to_lisp() here any more, like we used to.
+ That assumed equivalence of time_t and Time, which is not
+ necessarily the case (e.g. under OSF on the Alphas, where
+ Time is a 64-bit quantity and time_t is a 32-bit quantity).
+
+ Opaque pointers are the clean way to go here.
+ */
+ Lisp_Object selection_time = make_opaque (sizeof (thyme), (void *) &thyme);
+ Lisp_Object selection_data = list3 (selection_name,
+ selection_value,
+ selection_time);
+ Lisp_Object prev_value = assq_no_quit (selection_name, Vselection_alist);
+ Vselection_alist = Fcons (selection_data, Vselection_alist);
+
+ /* If we already owned the selection, remove the old selection data.
+ Perhaps we should destructively modify it instead.
+ Don't use Fdelq() as that may QUIT;.
+ */
+ if (!NILP (prev_value))
+ {
+ Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
+ for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ if (EQ (prev_value, Fcar (XCDR (rest))))
+ {
+ XCDR (rest) = Fcdr (XCDR (rest));
+ break;
+ }
+ }
+#ifdef MOTIF_CLIPBOARDS
+ hack_motif_clipboard_selection (selection_atom, selection_value,
+ thyme, display, selecting_window,
+ !NILP (prev_value));
+#endif
+ }
+}
+
+
+#ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
+
+# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
+static void motif_clipboard_cb ();
+# endif
+
+static void
+hack_motif_clipboard_selection (Atom selection_atom,
+ Lisp_Object selection_value,
+ Time thyme,
+ Display *display,
+ Window selecting_window,
+ Bool owned_p)
+{
+ struct device *d = get_device_from_display (display);
+ /* Those Motif wankers can't be bothered to follow the ICCCM, and do
+ their own non-Xlib non-Xt clipboard processing. So we have to do
+ this so that linked-in Motif widgets don't get themselves wedged.
+ */
+ if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
+ && STRINGP (selection_value)
+
+ /* If we already own the clipboard, don't own it again in the Motif
+ way. This might lose in some subtle way, since the timestamp won't
+ be current, but owning the selection on the Motif way does a
+ SHITLOAD of X protocol, and it makes killing text be incredibly
+ slow when using an X terminal. ARRRRGGGHHH!!!!
+ */
+ /* No, this is no good, because then Motif text fields don't bother
+ to look up the new value, and you can't Copy from a buffer, Paste
+ into a text field, then Copy something else from the buffer and
+ paste it into the text field -- it pastes the first thing again. */
+/* && !owned_p */
+ )
+ {
+#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
+ Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
+#endif
+ long itemid;
+#if XmVersion >= 1002
+ long dataid;
+#else
+ int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
+#endif
+ XmString fmh;
+ String encoding = "STRING";
+ CONST Extbyte *data = XSTRING_DATA (selection_value);
+ Extcount bytes = XSTRING_LENGTH (selection_value);
+
+#ifdef MULE
+ {
+ enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
+ CONST Bufbyte *ptr = data, *end = ptr + bytes;
+ /* Optimize for the common ASCII case */
+ while (ptr <= end)
+ {
+ if (BYTE_ASCII_P (*ptr))
+ {
+ ptr++;
+ continue;
+ }
+
+ if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
+ (*ptr) == LEADING_BYTE_CONTROL_1)
+ {
+ chartypes = LATIN_1;
+ ptr += 2;
+ continue;
+ }
+
+ chartypes = WORLD;
+ break;
+ }
+
+ if (chartypes == LATIN_1)
+ GET_STRING_BINARY_DATA_ALLOCA (selection_value, data, bytes);
+ else if (chartypes == WORLD)
+ {
+ GET_STRING_CTEXT_DATA_ALLOCA (selection_value, data, bytes);
+ encoding = "COMPOUND_TEXT";
+ }
+ }
+#endif /* MULE */
+
+ fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
+ while (ClipboardSuccess !=
+ XmClipboardStartCopy (display, selecting_window, fmh, thyme,
+#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
+ widget, motif_clipboard_cb,
+#else
+ 0, NULL,
+#endif
+ &itemid))
+ ;
+ XmStringFree (fmh);
+ while (ClipboardSuccess !=
+ XmClipboardCopy (display, selecting_window, itemid, encoding,
+#ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
+ /* O'Reilly examples say size can be 0,
+ but this clearly is not the case. */
+ 0, bytes, (int) selecting_window, /* private id */
+#else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
+ (XtPointer) data, bytes, 0,
+#endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
+ &dataid))
+ ;
+ while (ClipboardSuccess !=
+ XmClipboardEndCopy (display, selecting_window, itemid))
+ ;
+ }
+}
+
+# ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
+/* I tried to treat the clipboard like a real selection, and not send
+ the data until it was requested, but it looks like that just doesn't
+ work at all unless the selection owner and requestor are in different
+ processes. From reading the Motif source, it looks like they never
+ even considered having two widgets in the same application transfer
+ data between each other using "by-name" clipboard values. What a
+ bunch of fuckups.
+ */
+static void
+motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
+{
+ switch (*reason)
+ {
+ case XmCR_CLIPBOARD_DATA_REQUEST:
+ {
+ Display *dpy = XtDisplay (widget);
+ Window window = (Window) *private_id;
+ Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist);
+ if (NILP (selection)) abort ();
+ selection = XCDR (selection);
+ if (!STRINGP (selection)) abort ();
+ XmClipboardCopyByName (dpy, window, *data_id,
+ (char *) XSTRING_DATA (selection),
+ XSTRING_LENGTH (selection) + 1,
+ 0);
+ }
+ break;
+ case XmCR_CLIPBOARD_DATA_DELETE:
+ default:
+ /* don't need to free anything */
+ break;
+ }
+}
+# endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
+#endif /* MOTIF_CLIPBOARDS */
+
+
+/* Given a selection-name and desired type, this looks up our local copy of
+ the selection value and converts it to the type. It returns nil or a
+ string. This calls random elisp code, and may signal or gc.
+ */
+static Lisp_Object
+x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
+{
+ /* This function can GC */
+ Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
+ Lisp_Object handler_fn, value, check;
+
+ if (NILP (local_value)) return Qnil;
+
+ /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
+ if (EQ (target_type, QTIMESTAMP))
+ {
+ handler_fn = Qnil;
+ value = XCAR (XCDR (XCDR (local_value)));
+ }
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+ else if (CONSP (target_type) &&
+ XCAR (target_type) == QMULTIPLE)
+ {
+ Lisp_Object pairs = XCDR (target_type);
+ int len = XVECTOR_LENGTH (pairs);
+ int i;
+ /* If the target is MULTIPLE, then target_type looks like
+ (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
+ We modify the second element of each pair in the vector and
+ return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
+ */
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object pair = XVECTOR_DATA (pairs) [i];
+ XVECTOR_DATA (pair) [1] =
+ x_get_local_selection (XVECTOR_DATA (pair) [0],
+ XVECTOR_DATA (pair) [1]);
+ }
+ return pairs;
+ }
+#endif
+ else
+ {
+ CHECK_SYMBOL (target_type);
+ handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
+ if (NILP (handler_fn)) return Qnil;
+ value = call3 (handler_fn,
+ selection_symbol, target_type,
+ XCAR (XCDR (local_value)));
+ }
+
+ /* This lets the selection function to return (TYPE . VALUE). For example,
+ when the selected type is LINE_NUMBER, the returned type is SPAN, not
+ INTEGER.
+ */
+ check = value;
+ if (CONSP (value) && SYMBOLP (XCAR (value)))
+ check = XCDR (value);
+
+ /* Strings, vectors, and symbols are converted to selection data format in
+ the obvious way. Integers are converted to 16 bit quantities if they're
+ small enough, otherwise 32 bits are used.
+ */
+ if (STRINGP (check) ||
+ VECTORP (check) ||
+ SYMBOLP (check) ||
+ INTP (check) ||
+ CHARP (check) ||
+ NILP (value))
+ return value;
+
+ /* (N . M) or (N M) get turned into a 32 bit quantity. So if you want to
+ always return a small quantity as 32 bits, your converter routine needs
+ to return a cons.
+ */
+ else if (CONSP (check) &&
+ INTP (XCAR (check)) &&
+ (INTP (XCDR (check)) ||
+ (CONSP (XCDR (check)) &&
+ INTP (XCAR (XCDR (check))) &&
+ NILP (XCDR (XCDR (check))))))
+ return value;
+ /* Otherwise the lisp converter function returned something unrecognized.
+ */
+ else
+ signal_error (Qerror,
+ list3 (build_string
+ ("unrecognized selection-conversion type"),
+ handler_fn,
+ value));
+
+ return Qnil; /* suppress compiler warning */
+}
+
+
+
+/* Send a SelectionNotify event to the requestor with property=None, meaning
+ we were unable to do what they wanted.
+ */
+static void
+x_decline_selection_request (XSelectionRequestEvent *event)
+{
+ XSelectionEvent reply;
+ reply.type = SelectionNotify;
+ reply.display = event->display;
+ reply.requestor = event->requestor;
+ reply.selection = event->selection;
+ reply.time = event->time;
+ reply.target = event->target;
+ reply.property = None;
+
+ XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
+ XFlush (reply.display);
+}
+
+
+/* Used as an unwind-protect clause so that, if a selection-converter signals
+ an error, we tell the requestor that we were unable to do what they wanted
+ before we throw to top-level or go into the debugger or whatever.
+ */
+static Lisp_Object
+x_selection_request_lisp_error (Lisp_Object closure)
+{
+ XSelectionRequestEvent *event = (XSelectionRequestEvent *)
+ get_opaque_ptr (closure);
+
+ free_opaque_ptr (closure);
+ if (event->type == 0) /* we set this to mean "completed normally" */
+ return Qnil;
+ x_decline_selection_request (event);
+ return Qnil;
+}
+
+
+/* Convert our selection to the requested type, and put that data where the
+ requestor wants it. Then tell them whether we've succeeded.
+ */
+static void
+x_reply_selection_request (XSelectionRequestEvent *event, int format,
+ unsigned char *data, int size, Atom type)
+{
+ /* This function can GC */
+ XSelectionEvent reply;
+ Display *display = event->display;
+ struct device *d = get_device_from_display (display);
+ Window window = event->requestor;
+ int bytes_remaining;
+ int format_bytes = format/8;
+ int max_bytes = SELECTION_QUANTUM (display);
+ if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
+
+ reply.type = SelectionNotify;
+ reply.display = display;
+ reply.requestor = window;
+ reply.selection = event->selection;
+ reply.time = event->time;
+ reply.target = event->target;
+ reply.property = (event->property == None ? event->target : event->property);
+
+ /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
+
+ /* Store the data on the requested property.
+ If the selection is large, only store the first N bytes of it.
+ */
+ bytes_remaining = size * format_bytes;
+ if (bytes_remaining <= max_bytes)
+ {
+ /* Send all the data at once, with minimal handshaking. */
+#if 0
+ stderr_out ("\nStoring all %d\n", bytes_remaining);
+#endif
+ XChangeProperty (display, window, reply.property, type, format,
+ PropModeReplace, data, size);
+ /* At this point, the selection was successfully stored; ack it. */
+ XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+ XFlush (display);
+ }
+ else
+ {
+ /* Send an INCR selection. */
+ int prop_id;
+
+ if (x_window_to_frame (d, window)) /* #### debug */
+ error ("attempt to transfer an INCR to ourself!");
+#if 0
+ stderr_out ("\nINCR %d\n", bytes_remaining);
+#endif
+ prop_id = expect_property_change (display, window, reply.property,
+ PropertyDelete);
+
+ XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
+ 32, PropModeReplace, (unsigned char *)
+ &bytes_remaining, 1);
+ XSelectInput (display, window, PropertyChangeMask);
+ /* Tell 'em the INCR data is there... */
+ XSendEvent (display, window, False, 0L, (XEvent *) &reply);
+ XFlush (display);
+
+ /* First, wait for the requestor to ack by deleting the property.
+ This can run random lisp code (process handlers) or signal.
+ */
+ wait_for_property_change (prop_id);
+
+ while (bytes_remaining)
+ {
+ int i = ((bytes_remaining < max_bytes)
+ ? bytes_remaining
+ : max_bytes);
+ prop_id = expect_property_change (display, window, reply.property,
+ PropertyDelete);
+#if 0
+ stderr_out (" INCR adding %d\n", i);
+#endif
+ /* Append the next chunk of data to the property. */
+ XChangeProperty (display, window, reply.property, type, format,
+ PropModeAppend, data, i / format_bytes);
+ bytes_remaining -= i;
+ data += i;
+
+ /* Now wait for the requestor to ack this chunk by deleting the
+ property. This can run random lisp code or signal.
+ */
+ wait_for_property_change (prop_id);
+ }
+ /* Now write a zero-length chunk to the property to tell the requestor
+ that we're done. */
+#if 0
+ stderr_out (" INCR done\n");
+#endif
+ if (! waiting_for_other_props_on_window (display, window))
+ XSelectInput (display, window, 0L);
+
+ XChangeProperty (display, window, reply.property, type, format,
+ PropModeReplace, data, 0);
+ }
+}
+
+
+
+/* Called from the event-loop in response to a SelectionRequest event.
+ */
+void
+x_handle_selection_request (XSelectionRequestEvent *event)
+{
+ /* This function can GC */
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object local_selection_data = Qnil;
+ Lisp_Object selection_symbol;
+ Lisp_Object target_symbol = Qnil;
+ Lisp_Object converted_selection = Qnil;
+ Time local_selection_time;
+ Lisp_Object successful_p = Qnil;
+ int count;
+ struct device *d = get_device_from_display (event->display);
+
+ GCPRO3 (local_selection_data, converted_selection, target_symbol);
+
+ selection_symbol = x_atom_to_symbol (d, event->selection);
+
+ local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
+
+#if 0
+ /* This list isn't user-visible, so it can't "go bad." */
+ assert (CONSP (local_selection_data));
+ assert (CONSP (XCDR (local_selection_data)));
+ assert (CONSP (XCDR (XCDR (local_selection_data))));
+ assert (NILP (XCDR (XCDR (XCDR (local_selection_data)))));
+ assert (CONSP (XCAR (XCDR (XCDR (local_selection_data)))));
+ assert (INTP (XCAR (XCAR (XCDR (XCDR (local_selection_data))))));
+ assert (INTP (XCDR (XCAR (XCDR (XCDR (local_selection_data))))));
+#endif
+
+ if (NILP (local_selection_data))
+ {
+ /* Someone asked for the selection, but we don't have it any more. */
+ x_decline_selection_request (event);
+ goto DONE_LABEL;
+ }
+
+ local_selection_time =
+ * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
+
+ if (event->time != CurrentTime &&
+ local_selection_time > event->time)
+ {
+ /* Someone asked for the selection, and we have one, but not the one
+ they're looking for. */
+ x_decline_selection_request (event);
+ goto DONE_LABEL;
+ }
+
+ count = specpdl_depth ();
+ record_unwind_protect (x_selection_request_lisp_error,
+ make_opaque_ptr (event));
+ target_symbol = x_atom_to_symbol (d, event->target);
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+ if (EQ (target_symbol, QMULTIPLE))
+ target_symbol = fetch_multiple_target (event);
+#endif
+
+ /* Convert lisp objects back into binary data */
+
+ converted_selection =
+ x_get_local_selection (selection_symbol, target_symbol);
+
+ if (! NILP (converted_selection))
+ {
+ unsigned char *data;
+ unsigned int size;
+ int format;
+ Atom type;
+ lisp_data_to_selection_data (d, converted_selection,
+ &data, &type, &size, &format);
+
+ x_reply_selection_request (event, format, data, size, type);
+ successful_p = Qt;
+ /* Tell x_selection_request_lisp_error() it's cool. */
+ event->type = 0;
+ xfree (data);
+ }
+ unbind_to (count, Qnil);
+
+ DONE_LABEL:
+
+ UNGCPRO;
+
+ /* Let random lisp code notice that the selection has been asked for. */
+ {
+ Lisp_Object rest;
+ Lisp_Object val = Vx_sent_selection_hooks;
+ if (!UNBOUNDP (val) && !NILP (val))
+ {
+ if (CONSP (val) && !EQ (XCAR (val), Qlambda))
+ for (rest = val; !NILP (rest); rest = Fcdr (rest))
+ call3 (Fcar(rest), selection_symbol, target_symbol,
+ successful_p);
+ else
+ call3 (val, selection_symbol, target_symbol,
+ successful_p);
+ }
+ }
+}
+
+
+/* Called from the event-loop in response to a SelectionClear event.
+ */
+void
+x_handle_selection_clear (XSelectionClearEvent *event)
+{
+ Display *display = event->display;
+ struct device *d = get_device_from_display (display);
+ Atom selection = event->selection;
+ Time changed_owner_time = event->time;
+
+ Lisp_Object selection_symbol, local_selection_data;
+ Time local_selection_time;
+
+ selection_symbol = x_atom_to_symbol (d, selection);
+
+ local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
+
+ /* Well, we already believe that we don't own it, so that's just fine. */
+ if (NILP (local_selection_data)) return;
+
+ local_selection_time =
+ * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
+
+ /* This SelectionClear is for a selection that we no longer own, so we can
+ disregard it. (That is, we have reasserted the selection since this
+ request was generated.)
+ */
+ if (changed_owner_time != CurrentTime &&
+ local_selection_time > changed_owner_time)
+ return;
+
+ /* Otherwise, we're really honest and truly being told to drop it.
+ Don't use Fdelq() as that may QUIT;.
+ */
+ if (EQ (local_selection_data, Fcar (Vselection_alist)))
+ Vselection_alist = Fcdr (Vselection_alist);
+ else
+ {
+ Lisp_Object rest;
+ for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ if (EQ (local_selection_data, Fcar (XCDR (rest))))
+ {
+ XCDR (rest) = Fcdr (XCDR (rest));
+ break;
+ }
+ }
+
+ /* Let random lisp code notice that the selection has been stolen.
+ */
+ {
+ Lisp_Object rest;
+ Lisp_Object val = Vx_lost_selection_hooks;
+ if (!UNBOUNDP (val) && !NILP (val))
+ {
+ if (CONSP (val) && !EQ (XCAR (val), Qlambda))
+ for (rest = val; !NILP (rest); rest = Fcdr (rest))
+ call1 (Fcar (rest), selection_symbol);
+ else
+ call1 (val, selection_symbol);
+ }
+ }
+}
+
+\f
+/* This stuff is so that INCR selections are reentrant (that is, so we can
+ be servicing multiple INCR selection requests simultaneously). I haven't
+ actually tested that yet.
+ */
+
+static int prop_location_tick;
+
+static struct prop_location {
+ int tick;
+ Display *display;
+ Window window;
+ Atom property;
+ int desired_state;
+ struct prop_location *next;
+} *for_whom_the_bell_tolls;
+
+
+static int
+property_deleted_p (void *tick)
+{
+ struct prop_location *rest = for_whom_the_bell_tolls;
+ while (rest)
+ if (rest->tick == (long) tick)
+ return 0;
+ else
+ rest = rest->next;
+ return 1;
+}
+
+static int
+waiting_for_other_props_on_window (Display *display, Window window)
+{
+ struct prop_location *rest = for_whom_the_bell_tolls;
+ while (rest)
+ if (rest->display == display && rest->window == window)
+ return 1;
+ else
+ rest = rest->next;
+ return 0;
+}
+
+
+static int
+expect_property_change (Display *display, Window window,
+ Atom property, int state)
+{
+ struct prop_location *pl = xnew (struct prop_location);
+ pl->tick = ++prop_location_tick;
+ pl->display = display;
+ pl->window = window;
+ pl->property = property;
+ pl->desired_state = state;
+ pl->next = for_whom_the_bell_tolls;
+ for_whom_the_bell_tolls = pl;
+ return pl->tick;
+}
+
+static void
+unexpect_property_change (int tick)
+{
+ struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
+ while (rest)
+ {
+ if (rest->tick == tick)
+ {
+ if (prev)
+ prev->next = rest->next;
+ else
+ for_whom_the_bell_tolls = rest->next;
+ xfree (rest);
+ return;
+ }
+ prev = rest;
+ rest = rest->next;
+ }
+}
+
+static void
+wait_for_property_change (long tick)
+{
+ /* This function can GC */
+ wait_delaying_user_input (property_deleted_p, (void *) tick);
+}
+
+
+/* Called from the event-loop in response to a PropertyNotify event.
+ */
+void
+x_handle_property_notify (XPropertyEvent *event)
+{
+ struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
+ while (rest)
+ {
+ if (rest->property == event->atom &&
+ rest->window == event->window &&
+ rest->display == event->display &&
+ rest->desired_state == event->state)
+ {
+#if 0
+ stderr_out ("Saw expected prop-%s on %s\n",
+ (event->state == PropertyDelete ? "delete" : "change"),
+ (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name);
+#endif
+ if (prev)
+ prev->next = rest->next;
+ else
+ for_whom_the_bell_tolls = rest->next;
+ xfree (rest);
+ return;
+ }
+ prev = rest;
+ rest = rest->next;
+ }
+#if 0
+ stderr_out ("Saw UNexpected prop-%s on %s\n",
+ (event->state == PropertyDelete ? "delete" : "change"),
+ (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
+#endif
+}
+
+
+\f
+#if 0 /* #### MULTIPLE doesn't work yet */
+
+static Lisp_Object
+fetch_multiple_target (XSelectionRequestEvent *event)
+{
+ /* This function can GC */
+ Display *display = event->display;
+ Window window = event->requestor;
+ Atom target = event->target;
+ Atom selection_atom = event->selection;
+ int result;
+
+ return
+ Fcons (QMULTIPLE,
+ x_get_window_property_as_lisp_data (display, window, target,
+ QMULTIPLE,
+ selection_atom));
+}
+
+static Lisp_Object
+copy_multiple_data (Lisp_Object obj)
+{
+ Lisp_Object vec;
+ int i;
+ int len;
+ if (CONSP (obj))
+ return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
+
+ CHECK_VECTOR (obj);
+ len = XVECTOR_LENGTH (obj);
+ vec = make_vector (len, Qnil);
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
+ CHECK_VECTOR (vec2);
+ if (XVECTOR_LENGTH (vec2) != 2)
+ signal_error (Qerror, list2 (build_string
+ ("vectors must be of length 2"),
+ vec2));
+ XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
+ XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
+ XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
+ }
+ return vec;
+}
+
+#endif /* 0 */
+
+\f
+static Window reading_selection_reply;
+static Atom reading_which_selection;
+static int selection_reply_timed_out;
+
+static int
+selection_reply_done (void *ignore)
+{
+ return !reading_selection_reply;
+}
+
+static Lisp_Object Qx_selection_reply_timeout_internal;
+
+DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
+ 1, 1, 0, /*
+*/
+ (arg))
+{
+ selection_reply_timed_out = 1;
+ reading_selection_reply = 0;
+ return Qnil;
+}
+
+
+/* Do protocol to read selection-data from the server.
+ Converts this to lisp data and returns it.
+ */
+static Lisp_Object
+x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
+{
+ /* This function can GC */
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ struct frame *sel_frame = selected_frame ();
+ Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
+ Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
+ Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
+ Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
+ int speccount;
+ Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
+ XCAR (target_type) : target_type), 0);
+
+ XConvertSelection (display, selection_atom, type_atom, target_property,
+ requestor_window, requestor_time);
+
+ /* Block until the reply has been read. */
+ reading_selection_reply = requestor_window;
+ reading_which_selection = selection_atom;
+ selection_reply_timed_out = 0;
+
+ speccount = specpdl_depth ();
+
+ /* add a timeout handler */
+ if (x_selection_timeout > 0)
+ {
+ Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
+ Qx_selection_reply_timeout_internal,
+ Qnil, Qnil);
+ record_unwind_protect (Fdisable_timeout, id);
+ }
+
+ /* This is ^Gable */
+ wait_delaying_user_input (selection_reply_done, 0);
+
+ if (selection_reply_timed_out)
+ error ("timed out waiting for reply from selection owner");
+
+ unbind_to (speccount, Qnil);
+
+ /* otherwise, the selection is waiting for us on the requested property. */
+ return
+ x_get_window_property_as_lisp_data (display, requestor_window,
+ target_property, target_type,
+ selection_atom);
+}
+
+
+static void
+x_get_window_property (Display *display, Window window, Atom property,
+ unsigned char **data_ret, int *bytes_ret,
+ Atom *actual_type_ret, int *actual_format_ret,
+ unsigned long *actual_size_ret, int delete_p)
+{
+ int total_size;
+ unsigned long bytes_remaining;
+ int offset = 0;
+ unsigned char *tmp_data = 0;
+ int result;
+ int buffer_size = SELECTION_QUANTUM (display);
+ if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
+
+ /* First probe the thing to find out how big it is. */
+ result = XGetWindowProperty (display, window, property,
+ 0, 0, False, AnyPropertyType,
+ actual_type_ret, actual_format_ret,
+ actual_size_ret,
+ &bytes_remaining, &tmp_data);
+ if (result != Success)
+ {
+ *data_ret = 0;
+ *bytes_ret = 0;
+ return;
+ }
+ XFree ((char *) tmp_data);
+
+ if (*actual_type_ret == None || *actual_format_ret == 0)
+ {
+ if (delete_p) XDeleteProperty (display, window, property);
+ *data_ret = 0;
+ *bytes_ret = 0;
+ return;
+ }
+
+ total_size = bytes_remaining + 1;
+ *data_ret = (unsigned char *) xmalloc (total_size);
+
+ /* Now read, until we've gotten it all. */
+ while (bytes_remaining)
+ {
+#if 0
+ int last = bytes_remaining;
+#endif
+ result =
+ XGetWindowProperty (display, window, property,
+ offset/4, buffer_size/4,
+ (delete_p ? True : False),
+ AnyPropertyType,
+ actual_type_ret, actual_format_ret,
+ actual_size_ret, &bytes_remaining, &tmp_data);
+#if 0
+ stderr_out ("<< read %d\n", last-bytes_remaining);
+#endif
+ /* If this doesn't return Success at this point, it means that
+ some clod deleted the selection while we were in the midst of
+ reading it. Deal with that, I guess....
+ */
+ if (result != Success) break;
+ *actual_size_ret *= *actual_format_ret / 8;
+ memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
+ offset += *actual_size_ret;
+ XFree ((char *) tmp_data);
+ }
+ *bytes_ret = offset;
+}
+
+
+static void
+receive_incremental_selection (Display *display, Window window, Atom property,
+ /* this one is for error messages only */
+ Lisp_Object target_type,
+ unsigned int min_size_bytes,
+ unsigned char **data_ret, int *size_bytes_ret,
+ Atom *type_ret, int *format_ret,
+ unsigned long *size_ret)
+{
+ /* This function can GC */
+ int offset = 0;
+ int prop_id;
+ *size_bytes_ret = min_size_bytes;
+ *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
+#if 0
+ stderr_out ("\nread INCR %d\n", min_size_bytes);
+#endif
+ /* At this point, we have read an INCR property, and deleted it (which
+ is how we ack its receipt: the sending window will be selecting
+ PropertyNotify events on our window to notice this).
+
+ Now, we must loop, waiting for the sending window to put a value on
+ that property, then reading the property, then deleting it to ack.
+ We are done when the sender places a property of length 0.
+ */
+ prop_id = expect_property_change (display, window, property,
+ PropertyNewValue);
+ while (1)
+ {
+ unsigned char *tmp_data;
+ int tmp_size_bytes;
+ wait_for_property_change (prop_id);
+ /* expect it again immediately, because x_get_window_property may
+ .. no it won't, I don't get it.
+ .. Ok, I get it now, the Xt code that implements INCR is broken.
+ */
+ prop_id = expect_property_change (display, window, property,
+ PropertyNewValue);
+ x_get_window_property (display, window, property,
+ &tmp_data, &tmp_size_bytes,
+ type_ret, format_ret, size_ret, 1);
+
+ if (tmp_size_bytes == 0) /* we're done */
+ {
+#if 0
+ stderr_out (" read INCR done\n");
+#endif
+ unexpect_property_change (prop_id);
+ if (tmp_data) xfree (tmp_data);
+ break;
+ }
+#if 0
+ stderr_out (" read INCR %d\n", tmp_size_bytes);
+#endif
+ if (*size_bytes_ret < offset + tmp_size_bytes)
+ {
+#if 0
+ stderr_out (" read INCR realloc %d -> %d\n",
+ *size_bytes_ret, offset + tmp_size_bytes);
+#endif
+ *size_bytes_ret = offset + tmp_size_bytes;
+ *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
+ }
+ memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
+ offset += tmp_size_bytes;
+ xfree (tmp_data);
+ }
+}
+
+
+static Lisp_Object
+x_get_window_property_as_lisp_data (Display *display,
+ Window window,
+ Atom property,
+ /* next two for error messages only */
+ Lisp_Object target_type,
+ Atom selection_atom)
+{
+ /* This function can GC */
+ Atom actual_type;
+ int actual_format;
+ unsigned long actual_size;
+ unsigned char *data = NULL;
+ int bytes = 0;
+ Lisp_Object val;
+ struct device *d = get_device_from_display (display);
+
+ x_get_window_property (display, window, property, &data, &bytes,
+ &actual_type, &actual_format, &actual_size, 1);
+ if (! data)
+ {
+ if (XGetSelectionOwner (display, selection_atom))
+ /* there is a selection owner */
+ signal_error
+ (Qselection_conversion_error,
+ Fcons (build_string ("selection owner couldn't convert"),
+ Fcons (x_atom_to_symbol (d, selection_atom),
+ actual_type ?
+ list2 (target_type, x_atom_to_symbol (d, actual_type)) :
+ list1 (target_type))));
+ else
+ signal_error (Qerror,
+ list2 (build_string ("no selection"),
+ x_atom_to_symbol (d, selection_atom)));
+ }
+
+ if (actual_type == DEVICE_XATOM_INCR (d))
+ {
+ /* Ok, that data wasn't *the* data, it was just the beginning. */
+
+ unsigned int min_size_bytes = * ((unsigned int *) data);
+ xfree (data);
+ receive_incremental_selection (display, window, property, target_type,
+ min_size_bytes, &data, &bytes,
+ &actual_type, &actual_format,
+ &actual_size);
+ }
+
+ /* It's been read. Now convert it to a lisp object in some semi-rational
+ manner. */
+ val = selection_data_to_lisp_data (d, data, bytes,
+ actual_type, actual_format);
+
+ xfree (data);
+ return val;
+}
+\f
+/* These functions convert from the selection data read from the server into
+ something that we can use from elisp, and vice versa.
+
+ Type: Format: Size: Elisp Type:
+ ----- ------- ----- -----------
+ * 8 * String
+ ATOM 32 1 Symbol
+ ATOM 32 > 1 Vector of Symbols
+ * 16 1 Integer
+ * 16 > 1 Vector of Integers
+ * 32 1 if <=16 bits: Integer
+ if > 16 bits: Cons of top16, bot16
+ * 32 > 1 Vector of the above
+
+ When converting a Lisp number to C, it is assumed to be of format 16 if
+ it is an integer, and of format 32 if it is a cons of two integers.
+
+ When converting a vector of numbers from Elisp to C, it is assumed to be
+ of format 16 if every element in the vector is an integer, and is assumed
+ to be of format 32 if any element is a cons of two integers.
+
+ When converting an object to C, it may be of the form (SYMBOL . <data>)
+ where SYMBOL is what we should claim that the type is. Format and
+ representation are as above.
+
+ NOTE: Under Mule, when someone shoves us a string without a type, we
+ set the type to 'COMPOUND_TEXT and automatically convert to Compound
+ Text. If the string has a type, we assume that the user wants the
+ data sent as-is so we just do "binary" conversion.
+ */
+
+
+static Lisp_Object
+selection_data_to_lisp_data (struct device *d,
+ unsigned char *data,
+ size_t size,
+ Atom type,
+ int format)
+{
+ if (type == DEVICE_XATOM_NULL (d))
+ return QNULL;
+
+ /* Convert any 8-bit data to a string, for compactness. */
+ else if (format == 8)
+ return make_ext_string (data, size,
+ type == DEVICE_XATOM_TEXT (d) ||
+ type == DEVICE_XATOM_COMPOUND_TEXT (d)
+ ? FORMAT_CTEXT : FORMAT_BINARY);
+
+ /* Convert a single atom to a Lisp Symbol.
+ Convert a set of atoms to a vector of symbols. */
+ else if (type == XA_ATOM)
+ {
+ if (size == sizeof (Atom))
+ return x_atom_to_symbol (d, *((Atom *) data));
+ else
+ {
+ int i;
+ int len = size / sizeof (Atom);
+ Lisp_Object v = Fmake_vector (make_int (len), Qzero);
+ for (i = 0; i < len; i++)
+ Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
+ return v;
+ }
+ }
+
+ /* Convert a single 16 or small 32 bit number to a Lisp Int.
+ If the number is > 16 bits, convert it to a cons of integers,
+ 16 bits in each half.
+ */
+ else if (format == 32 && size == sizeof (long))
+ return word_to_lisp (((unsigned long *) data) [0]);
+ else if (format == 16 && size == sizeof (short))
+ return make_int ((int) (((unsigned short *) data) [0]));
+
+ /* Convert any other kind of data to a vector of numbers, represented
+ as above (as an integer, or a cons of two 16 bit integers).
+
+ #### Perhaps we should return the actual type to lisp as well.
+
+ (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
+ ==> [4 4]
+
+ and perhaps it should be
+
+ (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
+ ==> (SPAN . [4 4])
+
+ Right now the fact that the return type was SPAN is discarded before
+ lisp code gets to see it.
+ */
+ else if (format == 16)
+ {
+ int i;
+ Lisp_Object v = make_vector (size / 4, Qzero);
+ for (i = 0; i < (int) size / 4; i++)
+ {
+ int j = (int) ((unsigned short *) data) [i];
+ Faset (v, make_int (i), make_int (j));
+ }
+ return v;
+ }
+ else
+ {
+ int i;
+ Lisp_Object v = make_vector (size / 4, Qzero);
+ for (i = 0; i < (int) size / 4; i++)
+ {
+ unsigned long j = ((unsigned long *) data) [i];
+ Faset (v, make_int (i), word_to_lisp (j));
+ }
+ return v;
+ }
+}
+
+
+static void
+lisp_data_to_selection_data (struct device *d,
+ Lisp_Object obj,
+ unsigned char **data_ret,
+ Atom *type_ret,
+ unsigned int *size_ret,
+ int *format_ret)
+{
+ Lisp_Object type = Qnil;
+
+ if (CONSP (obj) && SYMBOLP (XCAR (obj)))
+ {
+ type = XCAR (obj);
+ obj = XCDR (obj);
+ if (CONSP (obj) && NILP (XCDR (obj)))
+ obj = XCAR (obj);
+ }
+
+ if (EQ (obj, QNULL) || (EQ (type, QNULL)))
+ { /* This is not the same as declining */
+ *format_ret = 32;
+ *size_ret = 0;
+ *data_ret = 0;
+ type = QNULL;
+ }
+ else if (STRINGP (obj))
+ {
+ CONST Extbyte *extval;
+ Extcount extvallen;
+
+ if (NILP (type))
+ GET_STRING_CTEXT_DATA_ALLOCA (obj, extval, extvallen);
+ else
+ GET_STRING_BINARY_DATA_ALLOCA (obj, extval, extvallen);
+ *format_ret = 8;
+ *size_ret = extvallen;
+ *data_ret = (unsigned char *) xmalloc (*size_ret);
+ memcpy (*data_ret, extval, *size_ret);
+#ifdef MULE
+ if (NILP (type)) type = QCOMPOUND_TEXT;
+#else
+ if (NILP (type)) type = QSTRING;
+#endif
+ }
+ else if (CHARP (obj))
+ {
+ Bufbyte buf[MAX_EMCHAR_LEN];
+ Bytecount len;
+ CONST Extbyte *extval;
+ Extcount extvallen;
+
+ *format_ret = 8;
+ len = set_charptr_emchar (buf, XCHAR (obj));
+ GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA (buf, len, extval, extvallen);
+ *size_ret = extvallen;
+ *data_ret = (unsigned char *) xmalloc (*size_ret);
+ memcpy (*data_ret, extval, *size_ret);
+#ifdef MULE
+ if (NILP (type)) type = QCOMPOUND_TEXT;
+#else
+ if (NILP (type)) type = QSTRING;
+#endif
+ }
+ else if (SYMBOLP (obj))
+ {
+ *format_ret = 32;
+ *size_ret = 1;
+ *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
+ (*data_ret) [sizeof (Atom)] = 0;
+ (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
+ if (NILP (type)) type = QATOM;
+ }
+ else if (INTP (obj) &&
+ XINT (obj) <= 0x7FFF &&
+ XINT (obj) >= -0x8000)
+ {
+ *format_ret = 16;
+ *size_ret = 1;
+ *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
+ (*data_ret) [sizeof (short)] = 0;
+ (*(short **) data_ret) [0] = (short) XINT (obj);
+ if (NILP (type)) type = QINTEGER;
+ }
+ else if (INTP (obj) || CONSP (obj))
+ {
+ *format_ret = 32;
+ *size_ret = 1;
+ *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
+ (*data_ret) [sizeof (long)] = 0;
+ (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
+ if (NILP (type)) type = QINTEGER;
+ }
+ else if (VECTORP (obj))
+ {
+ /* Lisp Vectors may represent a set of ATOMs;
+ a set of 16 or 32 bit INTEGERs;
+ or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
+ */
+ int i;
+
+ if (SYMBOLP (XVECTOR_DATA (obj) [0]))
+ /* This vector is an ATOM set */
+ {
+ if (NILP (type)) type = QATOM;
+ *size_ret = XVECTOR_LENGTH (obj);
+ *format_ret = 32;
+ *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
+ for (i = 0; i < (int) (*size_ret); i++)
+ if (SYMBOLP (XVECTOR_DATA (obj) [i]))
+ (*(Atom **) data_ret) [i] =
+ symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
+ else
+ signal_error (Qerror, /* Qselection_error */
+ list2 (build_string
+ ("all elements of the vector must be of the same type"),
+ obj));
+ }
+#if 0 /* #### MULTIPLE doesn't work yet */
+ else if (VECTORP (XVECTOR_DATA (obj) [0]))
+ /* This vector is an ATOM_PAIR set */
+ {
+ if (NILP (type)) type = QATOM_PAIR;
+ *size_ret = XVECTOR_LENGTH (obj);
+ *format_ret = 32;
+ *data_ret = (unsigned char *)
+ xmalloc ((*size_ret) * sizeof (Atom) * 2);
+ for (i = 0; i < *size_ret; i++)
+ if (VECTORP (XVECTOR_DATA (obj) [i]))
+ {
+ Lisp_Object pair = XVECTOR_DATA (obj) [i];
+ if (XVECTOR_LENGTH (pair) != 2)
+ signal_error (Qerror,
+ list2 (build_string
+ ("elements of the vector must be vectors of exactly two elements"),
+ pair));
+
+ (*(Atom **) data_ret) [i * 2] =
+ symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
+ (*(Atom **) data_ret) [(i * 2) + 1] =
+ symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
+ }
+ else
+ signal_error (Qerror,
+ list2 (build_string
+ ("all elements of the vector must be of the same type"),
+ obj));
+ }
+#endif
+ else
+ /* This vector is an INTEGER set, or something like it */
+ {
+ *size_ret = XVECTOR_LENGTH (obj);
+ if (NILP (type)) type = QINTEGER;
+ *format_ret = 16;
+ for (i = 0; i < (int) (*size_ret); i++)
+ if (CONSP (XVECTOR_DATA (obj) [i]))
+ *format_ret = 32;
+ else if (!INTP (XVECTOR_DATA (obj) [i]))
+ signal_error (Qerror, /* Qselection_error */
+ list2 (build_string
+ ("all elements of the vector must be integers or conses of integers"),
+ obj));
+
+ *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
+ for (i = 0; i < (int) (*size_ret); i++)
+ if (*format_ret == 32)
+ (*((unsigned long **) data_ret)) [i] =
+ lisp_to_word (XVECTOR_DATA (obj) [i]);
+ else
+ (*((unsigned short **) data_ret)) [i] =
+ (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
+ }
+ }
+ else
+ signal_error (Qerror, /* Qselection_error */
+ list2 (build_string ("unrecognized selection data"),
+ obj));
+
+ *type_ret = symbol_to_x_atom (d, type, 0);
+}
+
+static Lisp_Object
+clean_local_selection_data (Lisp_Object obj)
+{
+ if (CONSP (obj) &&
+ INTP (XCAR (obj)) &&
+ CONSP (XCDR (obj)) &&
+ INTP (XCAR (XCDR (obj))) &&
+ NILP (XCDR (XCDR (obj))))
+ obj = Fcons (XCAR (obj), XCDR (obj));
+
+ if (CONSP (obj) &&
+ INTP (XCAR (obj)) &&
+ INTP (XCDR (obj)))
+ {
+ if (XINT (XCAR (obj)) == 0)
+ return XCDR (obj);
+ if (XINT (XCAR (obj)) == -1)
+ return make_int (- XINT (XCDR (obj)));
+ }
+ if (VECTORP (obj))
+ {
+ int i;
+ int len = XVECTOR_LENGTH (obj);
+ Lisp_Object copy;
+ if (len == 1)
+ return clean_local_selection_data (XVECTOR_DATA (obj) [0]);
+ copy = make_vector (len, Qnil);
+ for (i = 0; i < len; i++)
+ XVECTOR_DATA (copy) [i] =
+ clean_local_selection_data (XVECTOR_DATA (obj) [i]);
+ return copy;
+ }
+ return obj;
+}
+
+\f
+/* Called from the event loop to handle SelectionNotify events.
+ I don't think this needs to be reentrant.
+ */
+void
+x_handle_selection_notify (XSelectionEvent *event)
+{
+ if (! reading_selection_reply)
+ message ("received an unexpected SelectionNotify event");
+ else if (event->requestor != reading_selection_reply)
+ message ("received a SelectionNotify event for the wrong window");
+ else if (event->selection != reading_which_selection)
+ message ("received the wrong selection type in SelectionNotify!");
+ else
+ reading_selection_reply = 0; /* we're done now. */
+}
+
+\f
+DEFUN ("x-own-selection-internal", Fx_own_selection_internal, 2, 2, 0, /*
+Assert an X selection of the given TYPE with the given VALUE.
+TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
+VALUE is typically a string, or a cons of two markers, but may be
+anything that the functions on selection-converter-alist know about.
+*/
+ (selection_name, selection_value))
+{
+ CHECK_SYMBOL (selection_name);
+ if (NILP (selection_value)) error ("selection-value may not be nil.");
+ x_own_selection (selection_name, selection_value);
+ return selection_value;
+}
+
+
+/* Request the selection value from the owner. If we are the owner,
+ simply return our selection value. If we are not the owner, this
+ will block until all of the data has arrived.
+ */
+DEFUN ("x-get-selection-internal", Fx_get_selection_internal, 2, 2, 0, /*
+Return text selected from some X window.
+SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
+TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
+Under Mule, if the resultant data comes back as 8-bit data in type
+TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
+*/
+ (selection_symbol, target_type))
+{
+ /* This function can GC */
+ Lisp_Object val = Qnil;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (target_type, val); /* we store newly consed data into these */
+ CHECK_SYMBOL (selection_symbol);
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+ if (CONSP (target_type) &&
+ XCAR (target_type) == QMULTIPLE)
+ {
+ CHECK_VECTOR (XCDR (target_type));
+ /* So we don't destructively modify this... */
+ target_type = copy_multiple_data (target_type);
+ }
+ else
+#endif
+ CHECK_SYMBOL (target_type);
+
+ val = x_get_local_selection (selection_symbol, target_type);
+
+ if (NILP (val))
+ {
+ val = x_get_foreign_selection (selection_symbol, target_type);
+ }
+ else
+ {
+ if (CONSP (val) && SYMBOLP (XCAR (val)))
+ {
+ val = XCDR (val);
+ if (CONSP (val) && NILP (XCDR (val)))
+ val = XCAR (val);
+ }
+ val = clean_local_selection_data (val);
+ }
+ UNGCPRO;
+ return val;
+}
+
+DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, 1, 2, 0, /*
+If we own the named selection, then disown it (make there be no selection).
+*/
+ (selection, timeval))
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ Time timestamp;
+ Atom selection_atom;
+ XSelectionClearEvent event;
+
+ CHECK_SYMBOL (selection);
+ if (NILP (timeval))
+ timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
+ else
+ {
+ /* #### This is bogus. See the comment above about problems
+ on OSF/1 and DEC Alphas. Yet another reason why it sucks
+ to have the implementation (i.e. cons of two 16-bit
+ integers) exposed. */
+ time_t the_time;
+ lisp_to_time (timeval, &the_time);
+ timestamp = (Time) the_time;
+ }
+
+ if (NILP (assq_no_quit (selection, Vselection_alist)))
+ return Qnil; /* Don't disown the selection when we're not the owner. */
+
+ selection_atom = symbol_to_x_atom (d, selection, 0);
+
+ XSetSelectionOwner (display, selection_atom, None, timestamp);
+
+ /* It doesn't seem to be guaranteed that a SelectionClear event will be
+ generated for a window which owns the selection when that window sets
+ the selection owner to None. The NCD server does, the MIT Sun4 server
+ doesn't. So we synthesize one; this means we might get two, but
+ that's ok, because the second one won't have any effect.
+ */
+ event.display = display;
+ event.selection = selection_atom;
+ event.time = timestamp;
+ x_handle_selection_clear (&event);
+
+ return Qt;
+}
+
+
+DEFUN ("x-selection-owner-p", Fx_selection_owner_p, 0, 1, 0, /*
+Return t if current emacs process owns the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
+nil is the same as PRIMARY, and t is the same as SECONDARY.)
+*/
+ (selection))
+{
+ CHECK_SYMBOL (selection);
+ if (EQ (selection, Qnil)) selection = QPRIMARY;
+ else if (EQ (selection, Qt)) selection = QSECONDARY;
+
+ return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
+}
+
+DEFUN ("x-selection-exists-p", Fx_selection_exists_p, 0, 1, 0, /*
+Whether there is an owner for the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
+nil is the same as PRIMARY, and t is the same as SECONDARY.)
+*/
+ (selection))
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *dpy = DEVICE_X_DISPLAY (d);
+ CHECK_SYMBOL (selection);
+ if (!NILP (Fx_selection_owner_p (selection)))
+ return Qt;
+ return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
+ Qt : Qnil;
+}
+
+\f
+#ifdef CUT_BUFFER_SUPPORT
+
+static int cut_buffers_initialized; /* Whether we're sure they all exist */
+
+/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
+static void
+initialize_cut_buffers (Display *display, Window window)
+{
+ static unsigned CONST char * CONST data = (unsigned CONST char *) "";
+#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
+ PropModeAppend, data, 0)
+ FROB (XA_CUT_BUFFER0);
+ FROB (XA_CUT_BUFFER1);
+ FROB (XA_CUT_BUFFER2);
+ FROB (XA_CUT_BUFFER3);
+ FROB (XA_CUT_BUFFER4);
+ FROB (XA_CUT_BUFFER5);
+ FROB (XA_CUT_BUFFER6);
+ FROB (XA_CUT_BUFFER7);
+#undef FROB
+ cut_buffers_initialized = 1;
+}
+
+#define CHECK_CUTBUFFER(symbol) \
+ { CHECK_SYMBOL (symbol); \
+ if (!EQ((symbol),QCUT_BUFFER0) && !EQ((symbol),QCUT_BUFFER1) && \
+ !EQ((symbol),QCUT_BUFFER2) && !EQ((symbol),QCUT_BUFFER3) && \
+ !EQ((symbol),QCUT_BUFFER4) && !EQ((symbol),QCUT_BUFFER5) && \
+ !EQ((symbol),QCUT_BUFFER6) && !EQ((symbol),QCUT_BUFFER7)) \
+ signal_error (Qerror, list2 (build_string ("Doesn't name a cutbuffer"), \
+ (symbol))); \
+ }
+
+DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
+Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
+*/
+ (cutbuffer))
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
+ Atom cut_buffer_atom;
+ unsigned char *data;
+ int bytes;
+ Atom type;
+ int format;
+ unsigned long size;
+ Lisp_Object ret;
+
+ CHECK_CUTBUFFER (cutbuffer);
+ cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
+
+ x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
+ &type, &format, &size, 0);
+ if (!data) return Qnil;
+
+ if (format != 8 || type != XA_STRING)
+ signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data",
+ x_atom_to_symbol (d, type),
+ make_int (format));
+
+ /* We cheat - if the string contains an ESC character, that's
+ technically not allowed in a STRING, so we assume it's
+ COMPOUND_TEXT that we stored there ourselves earlier,
+ in x-store-cutbuffer-internal */
+ ret = (bytes ?
+ make_ext_string (data, bytes,
+ memchr (data, 0x1b, bytes) ?
+ FORMAT_CTEXT : FORMAT_BINARY)
+ : Qnil);
+ xfree (data);
+ return ret;
+}
+
+
+DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
+Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
+*/
+ (cutbuffer, string))
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
+ Atom cut_buffer_atom;
+ CONST Extbyte *data = XSTRING_DATA (string);
+ Extcount bytes = XSTRING_LENGTH (string);
+ Extcount bytes_remaining;
+ int max_bytes = SELECTION_QUANTUM (display);
+#ifdef MULE
+ CONST Bufbyte *ptr, *end;
+ enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
+#endif
+
+ if (max_bytes > MAX_SELECTION_QUANTUM)
+ max_bytes = MAX_SELECTION_QUANTUM;
+
+ CHECK_CUTBUFFER (cutbuffer);
+ CHECK_STRING (string);
+ cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
+
+ if (! cut_buffers_initialized)
+ initialize_cut_buffers (display, window);
+
+ /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
+ We cheat and use type = `STRING' even when using COMPOUND_TEXT.
+ The ICCCM requires that this be so, and other clients assume it,
+ as we do ourselves in initialize_cut_buffers. */
+
+#ifdef MULE
+ /* Optimize for the common ASCII case */
+ for (ptr = data, end = ptr + bytes; ptr <= end; )
+ {
+ if (BYTE_ASCII_P (*ptr))
+ {
+ ptr++;
+ continue;
+ }
+
+ if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
+ (*ptr) == LEADING_BYTE_CONTROL_1)
+ {
+ chartypes = LATIN_1;
+ ptr += 2;
+ continue;
+ }
+
+ chartypes = WORLD;
+ break;
+ }
+
+ if (chartypes == LATIN_1)
+ GET_STRING_BINARY_DATA_ALLOCA (string, data, bytes);
+ else if (chartypes == WORLD)
+ GET_STRING_CTEXT_DATA_ALLOCA (string, data, bytes);
+#endif /* MULE */
+
+ bytes_remaining = bytes;
+
+ while (bytes_remaining)
+ {
+ int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
+ XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
+ (bytes_remaining == bytes
+ ? PropModeReplace : PropModeAppend),
+ data, chunk);
+ data += chunk;
+ bytes_remaining -= chunk;
+ }
+ return string;
+}
+
+
+DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
+Rotate the values of the cutbuffers by the given number of steps;
+positive means move values forward, negative means backward.
+*/
+ (n))
+{
+ struct device *d = decode_x_device (Qnil);
+ Display *display = DEVICE_X_DISPLAY (d);
+ Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
+ Atom props [8];
+
+ CHECK_INT (n);
+ if (XINT (n) == 0)
+ return n;
+ if (! cut_buffers_initialized)
+ initialize_cut_buffers (display, window);
+ props[0] = XA_CUT_BUFFER0;
+ props[1] = XA_CUT_BUFFER1;
+ props[2] = XA_CUT_BUFFER2;
+ props[3] = XA_CUT_BUFFER3;
+ props[4] = XA_CUT_BUFFER4;
+ props[5] = XA_CUT_BUFFER5;
+ props[6] = XA_CUT_BUFFER6;
+ props[7] = XA_CUT_BUFFER7;
+ XRotateWindowProperties (display, window, props, 8, XINT (n));
+ return n;
+}
+
+#endif /* CUT_BUFFER_SUPPORT */
+
+
+\f
+/************************************************************************/
+/* initialization */
+/************************************************************************/
+
+void
+syms_of_xselect (void)
+{
+ DEFSUBR (Fx_get_selection_internal);
+ DEFSUBR (Fx_own_selection_internal);
+ DEFSUBR (Fx_disown_selection_internal);
+ DEFSUBR (Fx_selection_owner_p);
+ DEFSUBR (Fx_selection_exists_p);
+
+#ifdef CUT_BUFFER_SUPPORT
+ DEFSUBR (Fx_get_cutbuffer_internal);
+ DEFSUBR (Fx_store_cutbuffer_internal);
+ DEFSUBR (Fx_rotate_cutbuffers_internal);
+#endif /* CUT_BUFFER_SUPPORT */
+
+ /* Unfortunately, timeout handlers must be lisp functions. */
+ defsymbol (&Qx_selection_reply_timeout_internal,
+ "x-selection-reply-timeout-internal");
+ DEFSUBR (Fx_selection_reply_timeout_internal);
+
+ defsymbol (&QPRIMARY, "PRIMARY");
+ defsymbol (&QSECONDARY, "SECONDARY");
+ defsymbol (&QSTRING, "STRING");
+ defsymbol (&QINTEGER, "INTEGER");
+ defsymbol (&QCLIPBOARD, "CLIPBOARD");
+ defsymbol (&QTIMESTAMP, "TIMESTAMP");
+ defsymbol (&QTEXT, "TEXT");
+ defsymbol (&QDELETE, "DELETE");
+ defsymbol (&QMULTIPLE, "MULTIPLE");
+ defsymbol (&QINCR, "INCR");
+ defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
+ defsymbol (&QTARGETS, "TARGETS");
+ defsymbol (&QATOM, "ATOM");
+ defsymbol (&QATOM_PAIR, "ATOM_PAIR");
+ defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
+ defsymbol (&QNULL, "NULL");
+
+#ifdef CUT_BUFFER_SUPPORT
+ defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
+ defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
+ defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
+ defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
+ defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
+ defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
+ defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
+ defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
+#endif /* CUT_BUFFER_SUPPORT */
+
+ deferror (&Qselection_conversion_error,
+ "selection-conversion-error",
+ "selection-conversion error", Qio_error);
+}
+
+void
+vars_of_xselect (void)
+{
+#ifdef CUT_BUFFER_SUPPORT
+ cut_buffers_initialized = 0;
+ Fprovide (intern ("cut-buffer"));
+#endif
+
+ reading_selection_reply = 0;
+ reading_which_selection = 0;
+ selection_reply_timed_out = 0;
+ for_whom_the_bell_tolls = 0;
+ prop_location_tick = 0;
+
+ Vselection_alist = Qnil;
+ staticpro (&Vselection_alist);
+
+ DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
+An alist associating selection-types (such as STRING and TIMESTAMP) with
+functions. These functions will be called with three args: the name of the
+selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a desired type to
+which the selection should be converted; and the local selection value
+ (whatever had been passed to `x-own-selection'). These functions should
+return the value to send to the X server, which should be one of:
+
+-- nil (the conversion could not be done)
+-- a cons of a symbol and any of the following values; the symbol
+ explicitly specifies the type that will be sent.
+-- a string (If the type is not specified, then if Mule support exists,
+ the string will be converted to Compound Text and sent in
+ the 'COMPOUND_TEXT format; otherwise (no Mule support),
+ the string will be left as-is and sent in the 'STRING
+ format. If the type is specified, the string will be
+ left as-is (or converted to binary format under Mule).
+ In all cases, 8-bit data it sent.)
+-- a character (With Mule support, will be converted to Compound Text
+ whether or not a type is specified. If a type is not
+ specified, a type of 'STRING or 'COMPOUND_TEXT will be
+ sent, as for strings.)
+-- the symbol 'NULL (Indicates that there is no meaningful return value.
+ Empty 32-bit data with a type of 'NULL will be sent.)
+-- a symbol (Will be converted into an atom. If the type is not specified,
+ a type of 'ATOM will be sent.)
+-- an integer (Will be converted into a 16-bit or 32-bit integer depending
+ on the value. If the type is not specified, a type of
+ 'INTEGER will be sent.)
+-- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
+ If the type is not specified, a type of
+ 'INTEGER will be sent.)
+-- a vector of symbols (Will be converted into a list of atoms. If the type
+ is not specified, a type of 'ATOM will be sent.)
+-- a vector of integers (Will be converted into a list of 16-bit integers.
+ If the type is not specified, a type of 'INTEGER
+ will be sent.)
+-- a vector of integers and/or conses (HIGH . LOW) of integers
+ (Will be converted into a list of 16-bit integers.
+ If the type is not specified, a type of 'INTEGER
+ will be sent.)
+*/ );
+ Vselection_converter_alist = Qnil;
+
+ DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks /*
+A function or functions to be called after the X server has notified us
+that we have lost the selection. The function(s) will be called with one
+argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
+CLIPBOARD).
+*/ );
+ Vx_lost_selection_hooks = Qunbound;
+
+ DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
+A function or functions to be called after we have responded to some
+other client's request for the value of a selection that we own. The
+function(s) will be called with four arguments:
+ - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
+ - the name of the selection-type which we were requested to convert the
+ selection into before sending (for example, STRING or LENGTH);
+ - and whether we successfully transmitted the selection.
+We might have failed (and declined the request) for any number of reasons,
+including being asked for a selection that we no longer own, or being asked
+to convert into a type that we don't know about or that is inappropriate.
+This hook doesn't let you change the behavior of emacs's selection replies,
+it merely informs you that they have happened.
+*/ );
+ Vx_sent_selection_hooks = Qunbound;
+
+ DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
+If the selection owner doesn't reply in this many seconds, we give up.
+A value of 0 means wait as long as necessary. This is initialized from the
+\"*selectionTimeout\" resource (which is expressed in milliseconds).
+*/ );
+ x_selection_timeout = 0;
+}
+
+void
+Xatoms_of_xselect (struct device *d)
+{
+ Display *D = DEVICE_X_DISPLAY (d);
+
+ /* Non-predefined atoms that we might end up using a lot */
+ DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
+ DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
+ DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
+ DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
+ DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
+ DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
+ DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
+ DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
+ DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
+ DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
+ DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);
+}
projects / chise / xemacs-chise.git / commitdiff
