When you add a new item, please add it without either +++ or ---
so we will look at it and add it to the manual.
+Fixme: The notes about Emacs 23 are quite incomplete.
+
+\f
+* Changes in Emacs 23.1
+
+** The Emacs character set is now a superset of Unicode.
+(It has about four times the code space, which should be plenty).
+
+The internal encoding used for buffers and strings is now
+Unicode-based and called `utf-8-emacs'. utf-8-emacs is backwards
+compatible with the UTF-8 encoding of Unicode. The `emacs-mule'
+coding system can still read and write data in the old internal
+encoding.
+
+There are still charsets which contain disjoint sets of characters
+where this is necessary or useful, especially for various Far Eastern
+sets which are problematic with Unicode.
+
+Since the internal encoding is also used by default for byte-compiled
+files -- i.e. the normal coding system for byte-compiled Lisp files is
+now utf-8-Emacs -- Lisp containing non-ASCII characters which is
+compiled by Emacs 23 can't be read by earlier versions of Emacs. Files
+compiled by Emacs 20, 21, or 22 are loaded correctly as emacs-mule
+(whether or not they contain multibyte characters), which makes loading
+them somewhat slower than Emacs 23-compiled files. Thus it may be worth
+recompiling existing .elc files which don't need to be shared with older
+Emacsen.
+
+** There are assorted new coding systems/aliases -- see
+M-x list-coding-systems.
+
+** New charset implementation with many new charsets.
+See M-x list-character-sets. New charsets can be defined conveniently
+as tables of unicodes.
+
+The dimension of a charset is now 0, 1, 2, or 3, and the size of each
+dimension is no longer limited to 94 or 96.
+
+Generic characters no longer exist.
+
+A dynamic charset priority list is used to infer the charset of
+unicodes for display &c.
+
+** The following facilities are obsolete:
+
+Minor modes: unify-8859-on-encoding-mode, unify-8859-on-decoding-mode
+
+\f
+* Lisp changes in Emacs 23.1
+
+map-char-table's behaviour has changed.
+
+New functions: characterp, max-char, map-charset-chars,
+define-charset-alias, primary-charset, set-primary-charset,
+unify-charset, clear-charset-maps, charset-priority-list,
+set-charset-priority, define-coding-system,
+define-coding-system-alias, coding-system-aliases, langinfo,
+string-to-multibyte.
+
+Changed functions: copy-sequence, decode-char, encode-char,
+set-fontset-font, new-fontset, modify-syntax-entry, define-charset,
+modify-category-entry
+
+Obsoleted: char-bytes, chars-in-region, set-coding-priority,
+char-valid-p
+
+\f
+* Incompatible Lisp changes
+
+Deleted functions: make-coding-system, register-char-codings,
+coding-system-spec
+
+** The character codes for characters from the
+eight-bit-control/eight-bit-graphic charsets aren't now in the range
+128-255.
\f
* Installation Changes in Emacs 22.1
** The command line option --no-windows has been changed to
--no-window-system. The old one still works, but is deprecated.
+ ---
+ ** If the environment variable DISPLAY specifies an unreachable X display,
+ Emacs will now startup as if invoked with the --no-window-system option.
+
+++
** The -f option, used from the command line to call a function,
now reads arguments for the function interactively if it is
fontification in Info, remove `turn-on-font-lock' from
`Info-mode-hook'.
- +++
- *** font-lock-lines-before specifies a number of lines before the
- current line that should be refontified when you change the buffer.
- The default value is 1.
-
+++
*** font-lock: in modes like C and Lisp where the fontification assumes that
an open-paren in column 0 is always outside of any string or comment,
-2006-03-19 Bill Wohler <wohler@newt.com>
-
- * image.el (image-load-path-for-library): Shorten first line in
- docstring.
-
+ 2006-03-18 Ben North <ben@redfrontdoor.org> (tiny change)
+
+ * isearch.el (isearch-other-meta-char): Handle user bindings for
+ shifted control characters.
+
+ 2006-03-18 Agustin Martin <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-skip-region-alist): Add "_+" to the
+ part that matches email addresses, file names, etc.
+
+ 2006-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (mouse-set-font): Mention
+ w32-list-proportional-fonts in the doc string.
+
+ 2006-03-18 Kim F. Storm <storm@cua.dk>
+
+ * ido.el (ido-cache-ftp-work-directory-time): Doc fix.
+ (ido-unc-hosts): New user option to explicitly define list of know
+ UNC-style hosts for completion.
+ (ido-cache-unc-host-shares-time): New user option.
+ (ido-is-unc-root, ido-is-unc-host, ido-cache-unc-valid): New
+ helper functions for UNC file-name support.
+ (ido-may-cache-directory): Check for UNC host. Simplify.
+ (ido-wash-history): Clean out old UNC hosts.
+ (ido-nonreadable-directory-p): UNC hosts are always readable.
+ (ido-directory-too-big-p): UNC hosts are never too big.
+ (ido-set-current-directory): Handle UNC root path.
+ (ido-file-name-all-completions): Complete UNC host names from
+ ido-unc-hosts list. Cache UNC host shares.
+ (ido-make-file-list-1): Don't filter UNC root.
+ (ido-exhibit): Check for // in root directory, and switch to UNC
+ mode by setting ido-current-directory to //.
+
+ 2006-03-17 Luc Teirlinck <teirllm@auburn.edu>
+
+ * cus-edit.el (customize-changed-options): Mention explicit
+ version number as default in prompt.
+
+ 2006-03-17 Bill Wohler <wohler@newt.com>
+
+ * image.el (image-load-path-for-library): Minor docstring fix.
+
+ 2006-03-17 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-read-date): Include subgroup 5 into
+ replacement text.
+ (org-popup-calendar-for-date-prompt): Fix customization type.
+
+ 2006-03-17 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gdb-ui.el (gud-watch): Provide completion.
+ (gdb-continuation): New variable.
+ (gdb-send): Deal with continuation lines.
+
+ * progmodes/gud.el (gud-gdb-complete-command)
+ (gud-gdb-run-command-fetch-lines): Adapt for use with watch
+ expressions.
+ (gud-tooltip-mode): Use buffer-local value.
+
+ 2006-03-16 Kim F. Storm <storm@cua.dk>
+
+ * ido.el (ido-edit-input): Use selected match, if any.
+
+ 2006-03-16 Bill Wohler <wohler@newt.com>
+
+ * image.el (image-load-path-for-library): Prefer user's images in
+ image-load-path.
+
+ 2006-03-16 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (mouse-drag-vertical-line): Use window-inside-edges
+ when checking for attempt to drag leftmost or rightmost scrollbar.
+
+ 2006-03-16 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gdb-ui.el (gdb-inferior-status): New variable.
+ (gdb-force-mode-line-update): New function.
+ (gdb-resync, gdb-starting, gdb-signal, gdb-exited, gdb-stopped)
+ (gdb-exited): Use them.
+ (gdb-signal): New fuction.
+ (gdb-annotation-rules): Provide a rule for it.
+
+ 2006-03-16 Kenichi Handa <handa@m17n.org>
+
+ * international/mule.el (auto-coding-regexp-alist): Add entries
+ for Unicode BOM.
+
+ * sort.el (sort-build-lists): Temporarily bind
+ inhibit-field-text-motion to t.
+
+ 2006-03-15 Luc Teirlinck <teirllm@auburn.edu>
+
+ * locate.el (locate-command, locate-make-command-line)
+ (locate-fcodes-file, locate-update-command)
+ (locate-prompt-for-command, locate, locate-with-filter)
+ (locate-get-file-positions): Doc fixes.
+ (locate-buffer-name, locate-header-face): Remove leading `*' in
+ defcustom.
+ (locate-filter-output): Use `keep-lines' instead of its alias
+ `delete-non-matching-lines'.
+ (locate-get-filename, locate-get-dirname): Add introductory comment.
+ (locate-find-directory-other-window): Give appropriate error
+ message if used outside main listing.
+
+ 2006-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * font-lock.el (font-lock-lines-before): Delete variable, subsumed by
+ the new extend-region feature.
+ (font-lock-after-change-function): Update correspondingly.
+ * jit-lock.el (jit-lock-after-change): Update correspondingly.
+ * progmodes/grep.el (font-lock-lines-before): Don't disable.
+
+ 2006-03-15 Bill Wohler <wohler@newt.com>
+
+ * image.el (image-load-path-for-library): Fix example by not
+ recommending that one binds image-load-path. Just defvar it to
+ placate compiler and only use it if previously defined.
+
+ 2006-03-15 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-insert-centered): Use `string-width' to
+ make underlining work for wide characters.
+ (org-goto-map, org-agenda-mode-map, org-mode-map): Explicitly bind
+ TAB to `org-cycle', to make sure that no binding in
+ `outline-mode-map' can supercede it.
+
+ 2006-03-14 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el: Increment version to 2.2.1 in file commentary.
+
+ (allout-version): Increment to 2.2.1.
+
+ (allout-default-layout): New customization variable, used when the
+ file lacks a specific allout-layout. Uses allout-layout-type for
+ recursively nested definition.
+
+ (allout-layout-type): Widget defining allout layouts, necessary for
+ self-recursive definition.
+
+ (allout-mode): Incorporate allout-default-layout as fallback for
+ allout-layout.
+
+ (allout-layout): Mark as 'safe-local-variable', and refer mention
+ fallback to `allout-default-layout' in absence of a specified value.
+ (allout-passphrase-verifier-string)
+ (allout-passphrase-hint-string): Mark as 'safe-local-variable'.
+
+ (allout-file-passphrase-verifier-string): Obsolete variable, removed.
+
+ (allout-get-encryption-passphrase-verifier): Use correct name of
+ passphrase verifier in docstring.
+
+ 2006-03-15 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gdb-ui.el (gdb-var-list): Change order of first two
+ elements.
+ (gdb-find-watch-expression): Make it work for arrays too. Follow
+ change to gdb-var-list.
+ (gud-watch): Allow the user to enter variable name with a prexix
+ arg. Create keybindings.
+ (gdb-var-create-handler, gdb-var-evaluate-expression-handler)
+ (gdb-var-list-children-handler, gdb-var-update-handler)
+ (gdb-var-delete, gdb-edit-value, gdb-speedbar-expand-node)
+ (gdb-var-list-children-handler-1, gdb-var-update-handler-1):
+ Follow change to gdb-var-list.
+ (gdb-starting): Don't show the overlay arrows when program is
+ running.
+
+ * progmodes/gud.el (gud-speedbar-buttons): Follow change to
+ gdb-var-list.
+
+ 2006-03-14 Bill Wohler <wohler@newt.com>
+
+ * image.el (image-load-path-for-library): Pass value of path
+ rather than symbol. Always return list of directories. Guarantee
+ that image directory comes first.
+
+ 2006-03-14 Alan Mackenzie <acm@muc.de>
+
+ * font-core.el: New function/variable
+ font-lock-extend-region\(-function\)?.
+
+ * font-lock.el (font-lock-after-change-function): Call
+ font-lock-extend-region. Obey font-lock-lines-before.
+ (font-lock-default-fontify-region): Remove reference to
+ font-lock-lines-before.
+
+ * jit-lock.el (jit-lock-after-change): Call
+ font-lock-extend-region. Obey font-lock-lines-before.
+
+ 2006-03-14 David Ponce <david@dponce.com>
+
+ * tree-widget.el (tree-widget-themes-load-path)
+ (tree-widget-themes-directory, tree-widget-theme): Doc fix.
+
2006-03-13 Ryan Yeske <rcyeske@gmail.com>
* net/rcirc.el (rcirc) <defgroup>: Add link to manual.
2006-03-13 Miles Bader <miles@gnu.org>
- * net/rcirc.el (rcirc-nick-abbrevs): Variable removed.
- (rcirc-abbrev-nick): Function removed.
+ * net/rcirc.el (rcirc-nick-abbrevs): Remove variable.
+ (rcirc-abbrev-nick): Remove function.
(rcirc-format-response-string): Don't call `rcirc-abbrev-nick'.
2006-03-13 David Ponce <david@dponce.com>
2006-03-13 Carsten Dominik <dominik@science.uva.nl>
- * textmodes/org.el: (org-link-search): Avoid self-matching of
+ * textmodes/org.el (org-link-search): Avoid self-matching of
links, allow target text to be distributed over several lines.
(org-search-not-link): New function.
- (org-set-regexps-and-options, org-get-current-options): New
- startup options.
+ (org-set-regexps-and-options, org-get-current-options):
+ New startup options.
(org-export-as-html): Take odd-level setting from local variable.
(org-fontify-emphasized-text): New option.
(org-set-font-lock-defaults): Include emphasized text.
2006-03-11 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
- * progmodes/octave-mod.el (octave-indent-for-comment): Behave
- according to do string.
+ * progmodes/octave-mod.el (octave-indent-for-comment):
+ Behave according to do string.
2006-03-11 Agustin Martin <agustin.martin@hispalinux.es>
* progmodes/gdb-ui.el (gdb-remove-text-properties): Rename from
gdb-remove-mouse-face and remove help-echo too.
(gdb-enqueue-input): Correct conditional clause.
-
+
2006-03-10 Glenn Morris <rgm@gnu.org>
* calendar/calendar.el (calendar-holidays): Doc fix.
* elide-head.el (elide-head-headers-to-hide): Recognize the FSF's
new address as well.
-2005-07-07 Kenichi Handa <handa@m17n.org>
-
- * international/mule.el (make-coding-system):
- Describe `ascii-incompatible' property in the docstring.
- (set-file-name-coding-system): Signal an error if coding-system is
- ascii-incompatible.
- (set-keyboard-coding-system): Likewise.
-
- * international/mule-cmds.el (set-default-coding-systems):
- Don't set default-file-name-coding-system and
- default-keyboard-coding-system if coding-system is ASCII-incompatible.
-
- * international/utf-16.el: Declare that all UTF-16-based coding
- systems are ASCII-incompatible.
-
2005-07-07 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gud.el: Require font-lock for displaying errors.
(other :tag "always" t)
(integer :tag "size"))
:group 'font-lock)
-
- (defcustom font-lock-lines-before 0
- "*Number of lines before the changed text to include in refontification."
- :type 'integer
- :group 'font-lock
- :version "22.1")
\f
;; Originally these variable values were face names such as `bold' etc.
(when font-lock-syntax-table
(set-syntax-table font-lock-syntax-table))
(goto-char beg)
- (setq beg (line-beginning-position (- 1 font-lock-lines-before)))
+ (setq beg (line-beginning-position))
;; check to see if we should expand the beg/end area for
;; proper multiline matches
(when (and (> beg (point-min))
;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end old-len)
(let ((inhibit-point-motion-hooks t)
- (inhibit-quit t))
+ (inhibit-quit t)
+ (region (font-lock-extend-region beg end old-len)))
(save-excursion
(save-match-data
- ;; Rescan between start of lines enclosing the region.
- (font-lock-fontify-region
- (progn (goto-char beg) (forward-line 0) (point))
- (progn (goto-char end) (forward-line 1) (point)))))))
+ (if region
+ ;; Fontify the region the major mode has specified.
+ (setq beg (car region) end (cdr region))
+ ;; Fontify the whole lines which enclose the region.
+ (setq beg (progn (goto-char beg) (line-beginning-position))
+ end (progn (goto-char end) (line-beginning-position 2))))
+ (font-lock-fontify-region beg end)))))
(defun font-lock-fontify-block (&optional arg)
"Fontify some lines the way `font-lock-fontify-buffer' would.
;; Move over any item value, etc., to the next item.
(while (not (looking-at "[ \t\n]*\\(\\(,\\)\\|;\\|\\'\\)"))
(goto-char (or (scan-sexps (point) 1) (point-max))))
- (goto-char (match-end 2)))
+ (if (match-end 2)
+ (goto-char (match-end 2))))
(error t)))))
;; C preprocessor(cpp) is used outside of C, C++ and Objective-C source file.
(list (file-name-as-directory (expand-file-name "images" data-directory))
'data-directory 'load-path)))
+
(defun image-load-path-for-library (library image &optional path no-error)
- "Return a suitable search path for images relative to LIBRARY.
- "Return a suitable search path for images used by LIBRARY.
++ "Return a suitable search path for images used by the Lisp package LIBRARY.
- Images for LIBRARY are searched for in \"../../etc/images\" and
- \"../etc/images\" relative to the files in \"lisp/LIBRARY\" as
- well as in `image-load-path' and `load-path'.
+ It searches for IMAGE in `image-load-path' (excluding
+ \"`data-directory'/images\") and `load-path', followed by a path
+ suitable for LIBRARY, which includes \"../../etc/images\" and
+ \"../etc/images\" relative to the library file itself, and then
+ in \"`data-directory'/images\".
- This function returns the value of `load-path' augmented with the
- directory containing IMAGE. If PATH is given, it is used instead
- of `load-path'. If PATH is t, just return the directory that
- contains IMAGE.
+ Then this function returns a list of directories which contains
+ first the directory in which IMAGE was found, followed by the
+ value of `load-path'. If PATH is given, it is used instead of
+ `load-path'.
- If NO-ERROR is non-nil, return nil if a suitable path can't be
- found rather than signaling an error.
+ If NO-ERROR is non-nil and a suitable path can't be found, don't
+ signal an error. Instead, return a list of directories as before,
+ except that nil appears in place of the image directory.
Here is an example that uses a common idiom to provide
compatibility with versions of Emacs that lack the variable
`image-load-path':
- (let ((load-path
- (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
- (image-load-path
- (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path)))
- (mh-tool-bar-folder-buttons-init))"
+ ;; Shush compiler.
+ (defvar image-load-path)
+
+ (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path))))
+ (mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
(unless image (error "No image specified"))
- (let ((image-directory))
+ (let (image-directory image-directory-load-path)
+ ;; Check for images in image-load-path or load-path.
+ (let ((img image)
+ (dir (or
+ ;; Images in image-load-path.
+ (image-search-load-path image)
+ ;; Images in load-path.
+ (locate-library image)))
+ parent)
+ ;; Since the image might be in a nested directory (for
+ ;; example, mail/attach.pbm), adjust `image-directory'
+ ;; accordingly.
+ (when dir
+ (setq dir (file-name-directory dir))
+ (while (setq parent (file-name-directory img))
+ (setq img (directory-file-name parent)
+ dir (expand-file-name "../" dir))))
+ (setq image-directory-load-path dir))
+
+ ;; If `image-directory-load-path' isn't Emacs' image directory,
+ ;; it's probably a user preference, so use it. Then use a
+ ;; relative setting if possible; otherwise, use
+ ;; `image-directory-load-path'.
(cond
+ ;; User-modified image-load-path?
+ ((and image-directory-load-path
+ (not (equal image-directory-load-path
+ (file-name-as-directory
+ (expand-file-name "images" data-directory)))))
+ (setq image-directory image-directory-load-path))
;; Try relative setting.
((let (library-name d1ei d2ei)
;; First, find library in the load-path.
;; And then set image-directory relative to that.
(setq
;; Go down 2 levels.
- d2ei (expand-file-name
- (concat (file-name-directory library-name) "../../etc/images"))
+ d2ei (file-name-as-directory
+ (expand-file-name
+ (concat (file-name-directory library-name) "../../etc/images")))
;; Go down 1 level.
- d1ei (expand-file-name
- (concat (file-name-directory library-name) "../etc/images")))
+ d1ei (file-name-as-directory
+ (expand-file-name
+ (concat (file-name-directory library-name) "../etc/images"))))
(setq image-directory
;; Set it to nil if image is not found.
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Check for images in image-load-path or load-path.
- ((let ((img image)
- (dir (or
- ;; Images in image-load-path.
- (image-search-load-path image)
- ;; Images in load-path.
- (locate-library image)))
- parent)
- ;; Since the image might be in a nested directory (for
- ;; example, mail/attach.pbm), adjust `image-directory'
- ;; accordingly.
- (and dir
- (setq dir (file-name-directory dir))
- (progn
- (while (setq parent (file-name-directory img))
- (setq img (directory-file-name parent)
- dir (expand-file-name "../" dir)))
- (setq image-directory dir)))))
+ ;; Use Emacs' image directory.
+ (image-directory-load-path
+ (setq image-directory image-directory-load-path))
(no-error
- ;; In this case we will return nil.
(message "Could not find image %s for library %s" image library))
(t
(error "Could not find image %s for library %s" image library)))
- ;; Return the directory, nil if no-error was non-nil and a
- ;; suitable path could not be found, or an augmented
- ;; `image-load-path' or `load-path'.
- (cond ((or (null image-directory)
- (eq path t))
- image-directory)
- ((and path (symbolp path))
- (nconc (list image-directory)
- (delete image-directory
- (if (boundp path)
- (copy-sequence (symbol-value path))
- nil))))
- (t
- (nconc (list image-directory)
- (delete image-directory (copy-sequence load-path)))))))
+ ;; Return an augmented `path' or `load-path'.
+ (nconc (list image-directory)
+ (delete image-directory (copy-sequence (or path load-path))))))
+
(defun image-jpeg-p (data)
"Value is non-nil if DATA, a string, consists of JFIF image data.
-;;; mule.el --- basic commands for mulitilingual environment
+;;; mule.el --- basic commands for multilingual environment
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual, character set, coding system
;;; Code:
-(defconst mule-version "5.0 (SAKAKI)" "\
+(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
-(defconst mule-version-date "1999.12.7" "\
+(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
+\f
+;;; CHARSET
+
+;; Backward compatibility code for handling emacs-mule charsets.
+(defvar private-char-area-1-min #xF0000)
+(defvar private-char-area-1-max #xFFFFE)
+(defvar private-char-area-2-min #x100000)
+(defvar private-char-area-2-max #x10FFFE)
+
+;; Table of emacs-mule charsets indexed by their emacs-mule ID.
+(defvar emacs-mule-charset-table (make-vector 256 nil))
+(aset emacs-mule-charset-table 0 'ascii)
+
+;; Convert the argument of old-style calll of define-charset to a
+;; property list used by the new-style.
+;; INFO-VECTOR is a vector of the format:
+;; [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
+;; SHORT-NAME LONG-NAME DESCRIPTION]
+
+(defun convert-define-charset-argument (emacs-mule-id info-vector)
+ (let* ((dim (aref info-vector 0))
+ (chars (aref info-vector 1))
+ (total (if (= dim 1) chars (* chars chars)))
+ (code-space (if (= dim 1) (if (= chars 96) [32 127] [33 126])
+ (if (= chars 96) [32 127 32 127] [33 126 33 126])))
+ code-offset)
+ (if (integerp emacs-mule-id)
+ (or (= emacs-mule-id 0)
+ (and (>= emacs-mule-id 129) (< emacs-mule-id 256))
+ (error "Invalid CHARSET-ID: %d" emacs-mule-id))
+ (let (from-id to-id)
+ (if (= dim 1) (setq from-id 160 to-id 224)
+ (setq from-id 224 to-id 255))
+ (while (and (< from-id to-id)
+ (not (aref emacs-mule-charset-table from-id)))
+ (setq from-id (1+ from-id)))
+ (if (= from-id to-id)
+ (error "No more room for the new Emacs-mule charset"))
+ (setq emacs-mule-id from-id)))
+ (if (> (- private-char-area-1-max private-char-area-1-min) total)
+ (setq code-offset private-char-area-1-min
+ private-char-area-1-min (+ private-char-area-1-min total))
+ (if (> (- private-char-area-2-max private-char-area-2-min) total)
+ (setq code-offset private-char-area-2-min
+ private-char-area-2-min (+ private-char-area-2-min total))
+ (error "No more space for a new charset.")))
+ (list :dimension dim
+ :code-space code-space
+ :iso-final-char (aref info-vector 4)
+ :code-offset code-offset
+ :emacs-mule-id emacs-mule-id)))
+
+(defun define-charset (name docstring &rest props)
+ "Define NAME (symbol) as a charset with DOCSTRING.
+The remaining arguments must come in pairs ATTRIBUTE VALUE. ATTRIBUTE
+may be any symbol. The following have special meanings, and one of
+`:code-offset', `:map', `:subset', `:superset' must be specified.
+
+`:short-name'
+
+VALUE must be a short string to identify the charset. If omitted,
+NAME is used.
+
+`:long-name'
+
+VALUE must be a string longer than `:short-name' to identify the
+charset. If omitted, the value of the `:short-name' attribute is used.
+
+`:dimension'
+
+VALUE must be an integer 0, 1, 2, or 3, specifying the dimension of
+code-points of the charsets. If omitted, it is calculated from the
+value of the `:code-space' attribute.
+
+`:code-space'
+
+VALUE must be a vector of length at most 8 specifying the byte code
+range of each dimension in this format:
+ [ MIN-1 MAX-1 MIN-2 MAX-2 ... ]
+where MIN-N is the minimum byte value of Nth dimension of code-point,
+MAX-N is the maximum byte value of that.
+
+`:min-code'
+
+VALUE must be an integer specifying the mininum code point of the
+charset. If omitted, it is calculated from `:code-space'. VALUE may
+be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
+the code point and LOW is the least significant 16 bits.
+
+`:max-code'
+
+VALUE must be an integer specifying the maxinum code point of the
+charset. If omitted, it is calculated from `:code-space'. VALUE may
+be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
+the code point and LOW is the least significant 16 bits.
+
+`:iso-final-char'
+
+VALUE must be a character in the range 32 to 127 (inclusive)
+specifying the final char of the charset for ISO-2022 encoding. If
+omitted, the charset can't be encoded by ISO-2022 based
+coding-systems.
+
+`:iso-revision-number'
+
+VALUE must be an integer in the range 0..63, specifying the revision
+number of the charset for ISO-2022 encoding.
+
+`:emacs-mule-id'
+
+VALUE must be an integer of 0, 129..255. If omitted, the charset
+can't be encoded by coding-systems of type `emacs-mule'.
+
+`:ascii-compatible-p'
+
+VALUE must be nil or t (default nil). If VALUE is t, the charset is
+compatible with ASCII, i.e. the first 128 code points map to ASCII.
+
+`:supplementary-p'
+
+VALUE must be nil or t. If the VALUE is t, the charset is
+supplementary, which means it is used only as a parent of some other
+charset.
+
+`:invalid-code'
+
+VALUE must be a nonnegative integer that can be used as an invalid
+code point of the charset. If the minimum code is 0 and the maximum
+code is greater than Emacs' maximum integer value, `:invalid-code'
+should not be omitted.
+
+`:code-offset'
+
+VALUE must be an integer added to the index number of a character to
+get the corresponding character code.
+
+`:map'
+
+VALUE must be vector or string.
+
+If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
+where CODE-n is a code-point of the charset, and CHAR-n is the
+corresponding character code.
+
+If it is a string, it is a name of file that contains the above
+information. Each line of the file must be this format:
+ 0xXXX 0xYYY
+where XXX is a hexadecimal representation of CODE-n and YYY is a
+hexadecimal representation of CHAR-n. A line starting with `#' is a
+comment line.
+
+`:subset'
+
+VALUE must be a list:
+ ( PARENT MIN-CODE MAX-CODE OFFSET )
+PARENT is a parent charset. MIN-CODE and MAX-CODE specify the range
+of characters inherited from the parent. OFFSET is an integer value
+to add to a code point of the parent charset to get the corresponding
+code point of this charset.
+
+`:superset'
+
+VALUE must be a list of parent charsets. The charset inherits
+characters from them. Each element of the list may be a cons (PARENT
+. OFFSET), where PARENT is a parent charset, and OFFSET is an offset
+value to add to a code point of PARENT to get the corresponding code
+point of this charset.
+
+`:unify-map'
+
+VALUE must be vector or string.
+
+If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
+where CODE-n is a code-point of the charset, and CHAR-n is the
+corresponding Unicode character code.
+
+If it is a string, it is a name of file that contains the above
+information. The file format is the same as what described for `:map'
+attribute."
+ (when (vectorp (car props))
+ ;; Old style code:
+ ;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR)
+ ;; Convert the argument to make it fit with the current style.
+ (let ((vec (car props)))
+ (setq props (convert-define-charset-argument name vec)
+ name docstring
+ docstring (aref vec 8))))
+ (let ((attrs (mapcar 'list '(:dimension
+ :code-space
+ :min-code
+ :max-code
+ :iso-final-char
+ :iso-revision-number
+ :emacs-mule-id
+ :ascii-compatible-p
+ :supplementary-p
+ :invalid-code
+ :code-offset
+ :map
+ :subset
+ :superset
+ :unify-map
+ :plist))))
+
+ ;; If :dimension is omitted, get the dimension from :code-space.
+ (let ((dimension (plist-get props :dimension)))
+ (or dimension
+ (let ((code-space (plist-get props :code-space)))
+ (setq dimension (if code-space (/ (length code-space) 2) 4))
+ (setq props (plist-put props :dimension dimension)))))
+
+ (let ((code-space (plist-get props :code-space)))
+ (or code-space
+ (let ((dimension (plist-get props :dimension)))
+ (setq code-space (make-vector 8 0))
+ (dotimes (i dimension)
+ (aset code-space (1+ (* i 2)) #xFF))
+ (setq props (plist-put props :code-space code-space)))))
+
+ ;; If :emacs-mule-id is specified, update emacs-mule-charset-table.
+ (let ((emacs-mule-id (plist-get props :emacs-mule-id)))
+ (if (integerp emacs-mule-id)
+ (aset emacs-mule-charset-table emacs-mule-id name)))
+
+ (dolist (slot attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ ;; Make sure that the value of :code-space is a vector of 8
+ ;; elements.
+ (let* ((slot (assq :code-space attrs))
+ (val (cdr slot))
+ (len (length val)))
+ (if (< len 8)
+ (setcdr slot
+ (vconcat val (make-vector (- 8 len) 0)))))
+
+ ;; Add :name and :docstring properties to PROPS.
+ (setq props
+ (cons :name (cons name (cons :docstring (cons docstring props)))))
+ (or (plist-get props :short-name)
+ (plist-put props :short-name (symbol-name name)))
+ (or (plist-get props :long-name)
+ (plist-put props :long-name (plist-get props :short-name)))
+ ;; We can probably get a worthwhile amount in purespace.
+ (setq props
+ (mapcar (lambda (elt)
+ (if (stringp elt)
+ (purecopy elt)
+ elt))
+ props))
+ (setcdr (assq :plist attrs) props)
+
+ (apply 'define-charset-internal name (mapcar 'cdr attrs))))
+
+
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
The file contents are decoded before evaluation if necessary.
;; Otherwise, eval-buffer might try to interpret random
;; binary junk as multibyte characters.
(if (and enable-multibyte-characters
- (or (eq (coding-system-type last-coding-system-used) 5)
- (eq last-coding-system-used 'no-conversion)))
+ (or (eq (coding-system-type last-coding-system-used)
+ 'raw-text)))
(set-buffer-multibyte nil))
;; Make `kill-buffer' quiet.
(set-buffer-modified-p nil))
(message "Loading %s...done" file)))
t)))
-;; API (Application Program Interface) for charsets.
-
-(defsubst charset-quoted-standard-p (obj)
- "Return t if OBJ is a quoted symbol, and is the name of a standard charset."
- (and (listp obj) (eq (car obj) 'quote)
- (symbolp (car-safe (cdr obj)))
- (let ((vector (get (car-safe (cdr obj)) 'charset)))
- (and (vectorp vector)
- (< (aref vector 0) 160)))))
-
-(defsubst charsetp (object)
- "T if OBJECT is a charset."
- (and (symbolp object) (vectorp (get object 'charset))))
-
-(defsubst charset-info (charset)
+(defun charset-info (charset)
"Return a vector of information of CHARSET.
+This function is provided for backward compatibility.
+
The elements of the vector are:
CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
LEADING-CODE-BASE, LEADING-CODE-EXT,
ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
- PLIST,
+ PLIST.
where
-CHARSET-ID (integer) is the identification number of the charset.
-BYTES (integer) is the length of multi-byte form of a character in
- the charset: one of 1, 2, 3, and 4.
-DIMENSION (integer) is the number of bytes to represent a character of
-the charset: 1 or 2.
-CHARS (integer) is the number of characters in a dimension: 94 or 96.
-WIDTH (integer) is the number of columns a character in the charset
- occupies on the screen: one of 0, 1, and 2.
-DIRECTION (integer) is the rendering direction of characters in the
- charset when rendering. If 0, render from left to right, else
- render from right to left.
-LEADING-CODE-BASE (integer) is the base leading-code for the
- charset.
-LEADING-CODE-EXT (integer) is the extended leading-code for the
- charset. All charsets of less than 0xA0 has the value 0.
+CHARSET-ID is always 0.
+BYTES is always 0.
+DIMENSION is the number of bytes of a code-point of the charset:
+ 1, 2, 3, or 4.
+CHARS is the number of characters in a dimension:
+ 94, 96, 128, or 256.
+WIDTH is always 0.
+DIRECTION is always 0.
+LEADING-CODE-BASE is always 0.
+LEADING-CODE-EXT is always 0.
ISO-FINAL-CHAR (character) is the final character of the
corresponding ISO 2022 charset. If the charset is not assigned
any final character, the value is -1.
-ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
- while encoding to variants of ISO 2022 coding system, one of the
- following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
- If the charset is not assigned any final character, the value is -1.
-REVERSE-CHARSET (integer) is the charset which differs only in
- LEFT-TO-RIGHT value from the charset. If there's no such a
- charset, the value is -1.
+ISO-GRAPHIC-PLANE is always 0.
+REVERSE-CHARSET is always -1.
SHORT-NAME (string) is the short name to refer to the charset.
LONG-NAME (string) is the long name to refer to the charset
DESCRIPTION (string) is the description string of the charset.
PLIST (property list) may contain any type of information a user
want to put and get by functions `put-charset-property' and
`get-charset-property' respectively."
- (get charset 'charset))
+ (vector 0
+ 0
+ (charset-dimension charset)
+ (charset-chars charset)
+ 0
+ 0
+ 0
+ 0
+ (charset-iso-final-char charset)
+ 0
+ -1
+ (get-charset-property charset :short-name)
+ (get-charset-property charset :short-name)
+ (charset-description charset)
+ (charset-plist charset)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
-(defmacro charset-id (charset)
- "Return charset identification number of CHARSET."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 0)
- (list 'aref (list 'charset-info charset) 0)))
+(defun charset-id (charset)
+ "Always return 0. This is provided for backward compatibility."
+ 0)
(defmacro charset-bytes (charset)
- "Return bytes of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 1)
- (list 'aref (list 'charset-info charset) 1)))
-
-(defmacro charset-dimension (charset)
- "Return dimension of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 2)
- (list 'aref (list 'charset-info charset) 2)))
-
-(defmacro charset-chars (charset)
- "Return character numbers contained in a dimension of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 3)
- (list 'aref (list 'charset-info charset) 3)))
-
-(defmacro charset-width (charset)
- "Return width (how many column occupied on a screen) of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 4)
- (list 'aref (list 'charset-info charset) 4)))
-
-(defmacro charset-direction (charset)
- "Return direction of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 5)
- (list 'aref (list 'charset-info charset) 5)))
-
-(defmacro charset-iso-final-char (charset)
- "Return final char of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 8)
- (list 'aref (list 'charset-info charset) 8)))
-
-(defmacro charset-iso-graphic-plane (charset)
- "Return graphic plane of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 9)
- (list 'aref (list 'charset-info charset) 9)))
-
-(defmacro charset-reverse-charset (charset)
- "Return reverse charset of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 10)
- (list 'aref (list 'charset-info charset) 10)))
+ "Always return 0. This is provided for backward compatibility."
+ 0)
+
+(defun get-charset-property (charset propname)
+ "Return the value of CHARSET's PROPNAME property.
+This is the last value stored with
+ (put-charset-property CHARSET PROPNAME VALUE)."
+ (plist-get (charset-plist charset) propname))
+
+(defun put-charset-property (charset propname value)
+ "Set CHARSETS's PROPNAME property to value VALUE.
+It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
+ (set-charset-plist charset
+ (plist-put (charset-plist charset) propname value)))
+
+(defun charset-description (charset)
+ "Return description string of CHARSET."
+ (plist-get (charset-plist charset) :docstring))
+
+(defun charset-dimension (charset)
+ "Return dimension of CHARSET."
+ (plist-get (charset-plist charset) :dimension))
+
+(defun charset-chars (charset &optional dimension)
+ "Return number of characters contained in DIMENSION of CHARSET.
+DIMENSION defaults to the first dimension."
+ (unless dimension (setq dimension 1))
+ (let ((code-space (plist-get (charset-plist charset) :code-space)))
+ (1+ (- (aref code-space (1- (* 2 dimension)))
+ (aref code-space (- (* 2 dimension) 2))))))
+
+(defun charset-iso-final-char (charset)
+ "Return ISO-2022 final character of CHARSET.
+Return -1 if charset isn't an ISO 2022 one."
+ (or (plist-get (charset-plist charset) :iso-final-char)
+ -1))
(defmacro charset-short-name (charset)
- "Return short name of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 11)
- (list 'aref (list 'charset-info charset) 11)))
+ "Return short name of CHARSET."
+ (plist-get (charset-plist charset) :short-name))
(defmacro charset-long-name (charset)
- "Return long name of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 12)
- (list 'aref (list 'charset-info charset) 12)))
-
-(defmacro charset-description (charset)
- "Return description of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 13)
- (list 'aref (list 'charset-info charset) 13)))
-
-(defmacro charset-plist (charset)
- "Return list charset property of CHARSET.
-See the function `charset-info' for more detail."
- (list 'aref
- (if (charset-quoted-standard-p charset)
- (charset-info (nth 1 charset))
- (list 'charset-info charset))
- 14))
-
-(defun set-charset-plist (charset plist)
- "Set CHARSET's property list to PLIST, and return PLIST."
- (aset (charset-info charset) 14 plist))
-
-(defun make-char (charset &optional code1 code2)
- "Return a character of CHARSET whose position codes are CODE1 and CODE2.
-CODE1 and CODE2 are optional, but if you don't supply
-sufficient position codes, return a generic character which stands for
-all characters or group of characters in the character set.
-A generic character can be used to index a char table (e.g. syntax-table).
-
-Such character sets as ascii, eight-bit-control, and eight-bit-graphic
-don't have corresponding generic characters. If CHARSET is one of
-them and you don't supply CODE1, return the character of the smallest
-code in CHARSET.
-
-If CODE1 or CODE2 are invalid (out of range), this function signals an
-error. However, the eighth bit of both CODE1 and CODE2 is zeroed
-before they are used to index CHARSET. Thus you may use, say, the
-actual ISO 8859 character code rather than subtracting 128, as you
-would need to index the corresponding Emacs charset."
- (make-char-internal (charset-id charset) code1 code2))
-
-(put 'make-char 'byte-compile
- (function
- (lambda (form)
- (let ((charset (nth 1 form)))
- (if (charset-quoted-standard-p charset)
- (byte-compile-normal-call
- (cons 'make-char-internal
- (cons (charset-id (nth 1 charset)) (nthcdr 2 form))))
- (byte-compile-normal-call
- (cons 'make-char-internal
- (cons (list 'charset-id charset) (nthcdr 2 form)))))))))
+ "Return long name of CHARSET."
+ (plist-get (charset-plist charset) :long-name))
(defun charset-list ()
- "Return list of charsets ever defined.
+ "Return list of all charsets ever defined.
This function is provided for backward compatibility.
Now we have the variable `charset-list'."
charset-list)
+(make-obsolete 'charset-list "Use variable `charset-list'" "23.1")
-(defsubst generic-char-p (char)
- "Return t if and only if CHAR is a generic character.
-See also the documentation of `make-char'."
- (and (>= char 0400)
- (let ((l (split-char char)))
- (and (or (= (nth 1 l) 0) (eq (nth 2 l) 0))
- (not (eq (car l) 'composition))))))
-
-(defun decode-char (ccs code-point &optional restriction)
- "Return character specified by coded character set CCS and CODE-POINT in it.
-Return nil if such a character is not supported.
-Currently the only supported coded character set is `ucs' (ISO/IEC
-10646: Universal Multi-Octet Coded Character Set), and the result is
-translated through the translation-table named
-`utf-translation-table-for-decode', or through the
-translation-hash-table named `utf-subst-table-for-decode'
-\(if `utf-translate-cjk-mode' is non-nil).
-
-Optional argument RESTRICTION specifies a way to map the pair of CCS
-and CODE-POINT to a character. Currently not supported and just ignored."
- (cond
- ((eq ccs 'ucs)
- (or (and utf-translate-cjk-mode
- (utf-lookup-subst-table-for-decode code-point))
- (let ((c (cond
- ((< code-point 160)
- code-point)
- ((< code-point 256)
- (make-char 'latin-iso8859-1 code-point))
- ((< code-point #x2500)
- (setq code-point (- code-point #x0100))
- (make-char 'mule-unicode-0100-24ff
- (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
- ((< code-point #x3400)
- (setq code-point (- code-point #x2500))
- (make-char 'mule-unicode-2500-33ff
- (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
- ((and (>= code-point #xe000) (< code-point #x10000))
- (setq code-point (- code-point #xe000))
- (make-char 'mule-unicode-e000-ffff
- (+ (/ code-point 96) 32)
- (+ (% code-point 96) 32))))))
- (when c
- (or (aref (get 'utf-translation-table-for-decode
- 'translation-table) c)
- c)))))))
-
-(defun encode-char (char ccs &optional restriction)
- "Return code-point in coded character set CCS that corresponds to CHAR.
-Return nil if CHAR is not included in CCS.
-Currently the only supported coded character set is `ucs' (ISO/IEC
-10646: Universal Multi-Octet Coded Character Set), and CHAR is first
-translated through the translation-table named
-`utf-translation-table-for-encode', or through the
-translation-hash-table named `utf-subst-table-for-encode' \(if
-`utf-translate-cjk-mode' is non-nil).
-
-CHAR should be in one of these charsets:
- ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
- mule-unicode-e000-ffff, eight-bit-control
-Otherwise, return nil.
-
-Optional argument RESTRICTION specifies a way to map CHAR to a
-code-point in CCS. Currently not supported and just ignored."
- (let* ((split (split-char char))
- (charset (car split))
- trans)
- (cond ((eq ccs 'ucs)
- (or (and utf-translate-cjk-mode
- (utf-lookup-subst-table-for-encode char))
- (let ((table (get 'utf-translation-table-for-encode
- 'translation-table)))
- (setq trans (aref table char))
- (if trans
- (setq split (split-char trans)
- charset (car split)))
- (cond ((eq charset 'ascii)
- (or trans char))
- ((eq charset 'latin-iso8859-1)
- (+ (nth 1 split) 128))
- ((eq charset 'mule-unicode-0100-24ff)
- (+ #x0100 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'mule-unicode-2500-33ff)
- (+ #x2500 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'mule-unicode-e000-ffff)
- (+ #xe000 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'eight-bit-control)
- char))))))))
+\f
+;;; CHARACTER
+(defalias 'char-valid-p 'characterp)
+(make-obsolete 'char-valid-p 'characterp "23.1")
+(defun generic-char-p (char)
+ "Always return nil. This is provided for backward compatibility."
+ nil)
+(make-obsolete 'generic-char-p "Generic characters no longer exist" "23.1")
+
+(defun make-char-internal (charset-id &optional code1 code2)
+ (let ((charset (aref emacs-mule-charset-table charset-id)))
+ (or charset
+ (error "Invalid Emacs-mule charset ID: %d" charset-id))
+ (make-char charset code1 code2)))
\f
;; Coding system stuff
-;; Coding system is a symbol that has the property `coding-system'.
-;;
-;; The value of the property `coding-system' is a vector of the
-;; following format:
-;; [TYPE MNEMONIC DOC-STRING PLIST FLAGS]
-;; We call this vector as coding-spec. See comments in src/coding.c
-;; for more detail.
-
-(defconst coding-spec-type-idx 0)
-(defconst coding-spec-mnemonic-idx 1)
-(defconst coding-spec-doc-string-idx 2)
-(defconst coding-spec-plist-idx 3)
-(defconst coding-spec-flags-idx 4)
-
-;; PLIST is a property list of a coding system. To share PLIST among
-;; alias coding systems, a coding system has PLIST in coding-spec
-;; instead of having it in normal property list of Lisp symbol.
-;; Here's a list of coding system properties currently being used.
-;;
-;; o coding-category
-;;
-;; The value is a coding category the coding system belongs to. The
-;; function `make-coding-system' sets this value automatically
-;; unless its argument PROPERTIES specifies this property.
-;;
-;; o alias-coding-systems
-;;
-;; The value is a list of coding systems of the same alias group. The
-;; first element is the coding system made at first, which we call as
-;; `base coding system'. The function `make-coding-system' sets this
-;; value automatically and `define-coding-system-alias' updates it.
-;;
-;; See the documentation of make-coding-system for the meanings of the
-;; following properties.
-;;
-;; o post-read-conversion
-;; o pre-write-conversion
-;; o translation-table-for-decode
-;; o translation-table-for-encode
-;; o safe-chars
-;; o safe-charsets
-;; o mime-charset
-;; o valid-codes (meaningful only for a coding system based on CCL)
-
-
-(defsubst coding-system-spec (coding-system)
- "Return coding-spec of CODING-SYSTEM."
- (get (check-coding-system coding-system) 'coding-system))
+;; Coding system is a symbol that has been defined by the function
+;; `define-coding-system'.
-(defun coding-system-type (coding-system)
- "Return the coding type of CODING-SYSTEM.
-A coding type is an integer value indicating the encoding method
-of CODING-SYSTEM. See the function `make-coding-system' for more detail."
- (aref (coding-system-spec coding-system) coding-spec-type-idx))
+(defconst coding-system-iso-2022-flags
+ '(long-form
+ ascii-at-eol
+ ascii-at-cntl
+ 7-bit
+ locking-shift
+ single-shift
+ designation
+ revision
+ direction
+ init-at-bol
+ designate-at-bol
+ safe
+ latin-extra
+ composition
+ euc-tw-shift
+ use-roman
+ use-oldjis)
+ "List of symbols that control ISO-2022 encoder/decoder.
-(defun coding-system-mnemonic (coding-system)
- "Return the mnemonic character of CODING-SYSTEM.
-The mnemonic character of a coding system is used in mode line
-to indicate the coding system. If the arg is nil, return ?-."
- (let ((spec (coding-system-spec coding-system)))
- (if spec (aref spec coding-spec-mnemonic-idx) ?-)))
+The value of the `:flags' attribute in the argument of the function
+`define-coding-system' must be one of them.
+
+If `long-form' is specified, use a long designation sequence on
+encoding for the charsets `japanese-jisx0208-1978', `chinese-gb2312',
+and `japanese-jisx0208'. The long designation sequence doesn't
+conform to ISO 2022, but is used by such coding systems as
+`compound-text'.
+
+If `ascii-at-eol' is specified, designate ASCII to g0 at end of line
+on encoding.
+
+If `ascii-at-cntl' is specified, designate ASCII to g0 before control
+codes and SPC on encoding.
+
+If `7-bit' is specified, use 7-bit code only on encoding.
+
+If `locking-shift' is specified, decode locking-shift code correctly
+on decoding, and use locking-shift to invoke a graphic element on
+encoding.
+
+If `single-shift' is specified, decode single-shift code correctly on
+decoding, and use single-shift to invoke a graphic element on encoding.
+
+If `designation' is specified, decode designation code correctly on
+decoding, and use designation to designate a charset to a graphic
+element on encoding.
+
+If `revision' is specified, produce an escape sequence to specify
+revision number of a charset on encoding. Such an escape sequence is
+always correctly decoded on decoding.
+
+If `direction' is specified, decode ISO6429's code for specifying
+direction correctly, and produce the code on encoding.
+
+If `init-at-bol' is specified, on encoding, it is assumed that
+invocation and designation statuses are reset at each beginning of
+line even if `ascii-at-eol' is not specified; thus no codes for
+resetting them are produced.
+
+If `safe' is specified, on encoding, characters not supported by a
+coding are replaced with `?'.
+
+If `latin-extra' is specified, the code-detection routine assumes that a
+code specified in `latin-extra-code-table' (which see) is valid.
+
+If `composition' is specified, an escape sequence to specify
+composition sequence is correctly decoded on decoding, and is produced
+on encoding.
+
+If `euc-tw-shift' is specified, the EUC-TW specific shifting code is
+correctly decoded on decoding, and is produced on encoding.
+
+If `use-roman' is specified, JIS0201-1976-Roman is designated instead
+of ASCII.
+
+If `use-oldjis' is specified, JIS0208-1976 is designated instead of
+JIS0208-1983.")
+
+(defun define-coding-system (name docstring &rest props)
+ "Define NAME (a symbol) as a coding system with DOCSTRING and attributes.
+The remaining arguments must come in pairs ATTRIBUTE VALUE. ATTRIBUTE
+may be any symbol.
+
+The following attributes have special meanings. Those labeled as
+\"(required)\", should not be omitted.
+
+`:mnemonic' (required)
+
+VALUE is a character to display on mode line for the coding system.
+
+`:coding-type' (required)
+
+VALUE must be one of `charset', `utf-8', `utf-16', `iso-2022',
+`emacs-mule', `shift-jis', `ccl', `raw-text', `undecided'.
+
+`:eol-type'
+
+VALUE is the EOL (end-of-line) format of the coding system. It must be
+one of `unix', `dos', `mac'. The symbol `unix' means Unix-like EOL
+\(i.e. single LF), `dos' means DOS-like EOL \(i.e. sequence of CR LF),
+and `mac' means MAC-like EOL \(i.e. single CR). If omitted, on
+decoding by the coding system, Emacs automatically detects the EOL
+format of the source text.
+
+`:charset-list'
+
+VALUE must be a list of charsets supported by the coding system. On
+encoding by the coding system, if a character belongs to multiple
+charsets in the list, a charset that comes earlier in the list is
+selected. If `:coding-type' is `iso-2022', VALUE may be `iso-2022',
+which indicates that the coding system supports all ISO-2022 based
+charsets. If `:coding-type' is `emacs-mule', VALUE may be
+`emacs-mule', which indicates that the coding system supports all
+charsets that have the `:emacs-mule-id' property.
+
+`:ascii-compatible-p'
+
+If VALUE is non-nil, the coding system decodes all 7-bit bytes into
+the corresponding ASCII characters, and encodes all ASCII characters
+back to the corresponding 7-bit bytes. VALUE defaults to nil.
+
+`:decode-translation-table'
+
+VALUE must be a translation table to use on decoding.
+
+`:encode-translation-table'
+
+VALUE must be a translation table to use on encoding.
+
+`:post-read-conversion'
+
+VALUE must be a function to call after some text is inserted and
+decoded by the coding system itself and before any functions in
+`after-insert-functions' are called. The arguments to this function
+are the same as those of a function in `after-insert-file-functions',
+i.e. LENGTH of the text to be decoded with point at the head of it,
+and the function should leave point unchanged.
+
+`:pre-write-conversion'
+
+VALUE must be a function to call after all functions in
+`write-region-annotate-functions' and `buffer-file-format' are called,
+and before the text is encoded by the coding system itself. The
+arguments to this function are the same as those of a function in
+`write-region-annotate-functions'.
+
+`:default-char'
+
+VALUE must be a character. On encoding, a character not supported by
+the coding system is replaced with VALUE.
+
+`:for-unibyte'
+
+VALUE non-nil means that visiting a file with the coding system
+results in a unibyte buffer.
+
+`:eol-type'
+
+VALUE must be `unix', `dos', `mac'. The symbol `unix' means Unix-like
+EOL (LF), `dos' means DOS-like EOL (CRLF), and `mac' means MAC-like
+EOL (CR). If omitted, on decoding, the coding system detects EOL
+format automatically, and on encoding, uses Unix-like EOL.
+
+`:mime-charset'
+
+VALUE must be a symbol whose name is that of a MIME charset converted
+to lower case.
+
+`:mime-text-unsuitable'
+
+VALUE non-nil means the `:mime-charset' property names a charset which
+is unsuitable for the top-level media type \"text\".
+
+`:flags'
+
+VALUE must be a list of symbols that control the ISO-2022 converter.
+Each must be a member of the list `coding-system-iso-2022-flags'
+\(which see). This attribute has a meaning only when `:coding-type'
+is `iso-2022'.
+
+`:designation'
+
+VALUE must be a vector [G0-USAGE G1-USAGE G2-USAGE G3-USAGE].
+GN-USAGE specifies the usage of graphic register GN as follows.
+
+If it is nil, no charset can be designated to GN.
+
+If it is a charset, the charset is initially designated to GN, and
+never used by the other charsets.
+
+If it is a list, the elements must be charsets, nil, 94, or 96. GN
+can be used by all the listed charsets. If the list contains 94, any
+iso-2022 charset whose code-space ranges are 94 long can be designated
+to GN. If the list contains 96, any charsets whose whose ranges are
+96 long can be designated to GN. If the first element is a charset,
+that charset is initially designated to GN.
+
+This attribute has a meaning only when `:coding-type' is `iso-2022'.
+
+`:bom'
+
+This attributes specifies whether the coding system uses a `byte order
+mark'. VALUE must nil, t, or cons of coding systems whose
+`:coding-type' is `utf-16'.
+
+If the value is nil, on decoding, don't treat the first two-byte as
+BOM, and on encoding, don't produce BOM bytes.
+
+If the value is t, on decoding, skip the first two-byte as BOM, and on
+encoding, produce BOM bytes accoding to the value of `:endian'.
+
+If the value is cons, on decoding, check the first two-byte. If theyq
+are 0xFE 0xFF, use the car part coding system of the value. If they
+are 0xFF 0xFE, use the car part coding system of the value.
+Otherwise, treat them as bytes for a normal character. On encoding,
+produce BOM bytes accoding to the value of `:endian'.
+
+This attribute has a meaning only when `:coding-type' is `utf-16'.
+
+`:endian'
+
+VALUE must be `big' or `little' specifying big-endian and
+little-endian respectively. The default value is `big'.
+
+This attribute has a meaning only when `:coding-type' is `utf-16'.
+
+`:ccl-decoder'
+
+VALUE is a symbol representing the registered CCL program used for
+decoding. This attribute has a meaning only when `:coding-type' is
+`ccl'.
+
+`:ccl-encoder'
+
+VALUE is a symbol representing the registered CCL program used for
+encoding. This attribute has a meaning only when `:coding-type' is
+`ccl'."
+ (let* ((common-attrs (mapcar 'list
+ '(:mnemonic
+ :coding-type
+ :charset-list
+ :ascii-compatible-p
+ :decode-translation-table
+ :encode-translation-table
+ :post-read-conversion
+ :pre-write-conversion
+ :default-char
+ :for-unibyte
+ :plist
+ :eol-type)))
+ (coding-type (plist-get props :coding-type))
+ (spec-attrs (mapcar 'list
+ (cond ((eq coding-type 'iso-2022)
+ '(:initial
+ :reg-usage
+ :request
+ :flags))
+ ((eq coding-type 'utf-16)
+ '(:bom
+ :endian))
+ ((eq coding-type 'ccl)
+ '(:ccl-decoder
+ :ccl-encoder
+ :valids))))))
+
+ (dolist (slot common-attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ (dolist (slot spec-attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ (if (eq coding-type 'iso-2022)
+ (let ((designation (plist-get props :designation))
+ (flags (plist-get props :flags))
+ (initial (make-vector 4 nil))
+ (reg-usage (cons 4 4))
+ request elt)
+ (dotimes (i 4)
+ (setq elt (aref designation i))
+ (cond ((charsetp elt)
+ (aset initial i elt)
+ (setq request (cons (cons elt i) request)))
+ ((consp elt)
+ (aset initial i (car elt))
+ (if (charsetp (car elt))
+ (setq request (cons (cons (car elt) i) request)))
+ (dolist (e (cdr elt))
+ (cond ((charsetp e)
+ (setq request (cons (cons e i) request)))
+ ((eq e 94)
+ (setcar reg-usage i))
+ ((eq e 96)
+ (setcdr reg-usage i))
+ ((eq e t)
+ (setcar reg-usage i)
+ (setcdr reg-usage i)))))))
+ (setcdr (assq :initial spec-attrs) initial)
+ (setcdr (assq :reg-usage spec-attrs) reg-usage)
+ (setcdr (assq :request spec-attrs) request)
+
+ ;; Change :flags value from a list to a bit-mask.
+ (let ((bits 0)
+ (i 0))
+ (dolist (elt coding-system-iso-2022-flags)
+ (if (memq elt flags)
+ (setq bits (logior bits (lsh 1 i))))
+ (setq i (1+ i)))
+ (setcdr (assq :flags spec-attrs) bits))))
+
+ ;; Add :name and :docstring properties to PROPS.
+ (setq props
+ (cons :name (cons name (cons :docstring (cons (purecopy docstring)
+ props)))))
+ (setcdr (assq :plist common-attrs) props)
+ (apply 'define-coding-system-internal
+ name (mapcar 'cdr (append common-attrs spec-attrs)))))
(defun coding-system-doc-string (coding-system)
"Return the documentation string for CODING-SYSTEM."
- (aref (coding-system-spec coding-system) coding-spec-doc-string-idx))
+ (plist-get (coding-system-plist coding-system) :docstring))
-(defun coding-system-plist (coding-system)
- "Return the property list of CODING-SYSTEM."
- (aref (coding-system-spec coding-system) coding-spec-plist-idx))
-
-(defun coding-system-flags (coding-system)
- "Return `flags' of CODING-SYSTEM.
-A `flags' of a coding system is a vector of length 32 indicating detailed
-information of a coding system. See the function `make-coding-system'
-for more detail."
- (aref (coding-system-spec coding-system) coding-spec-flags-idx))
+(defun coding-system-mnemonic (coding-system)
+ "Return the mnemonic character of CODING-SYSTEM.
+The mnemonic character of a coding system is used in mode line to
+indicate the coding system. If CODING-SYSTEM. is nil, return ?=."
+ (plist-get (coding-system-plist coding-system) :mnemonic))
-(defun coding-system-get (coding-system prop)
- "Extract a value from CODING-SYSTEM's property list for property PROP."
- (plist-get (coding-system-plist coding-system) prop))
+(defun coding-system-type (coding-system)
+ "Return the coding type of CODING-SYSTEM.
+A coding type is a symbol indicating the encoding method of CODING-SYSTEM.
+See the function `define-coding-system' for more detail."
+ (plist-get (coding-system-plist coding-system) :coding-type))
-(defun coding-system-put (coding-system prop val)
- "Change value in CODING-SYSTEM's property list PROP to VAL."
- (let ((plist (coding-system-plist coding-system)))
- (if plist
- (plist-put plist prop val)
- (aset (coding-system-spec coding-system) coding-spec-plist-idx
- (list prop val)))))
+(defun coding-system-charset-list (coding-system)
+ "Return list of charsets supported by CODING-SYSTEM.
+If CODING-SYSTEM supports all ISO-2022 charsets, return `iso-2022'.
+If CODING-SYSTEM supports all emacs-mule charsets, return `emacs-mule'."
+ (plist-get (coding-system-plist coding-system) :charset-list))
(defun coding-system-category (coding-system)
- "Return the coding category of CODING-SYSTEM.
-See also `coding-category-list'."
- (coding-system-get coding-system 'coding-category))
-
-(defun coding-system-base (coding-system)
- "Return the base coding system of CODING-SYSTEM.
-A base coding system is what made by `make-coding-system'.
-Any alias nor subsidiary coding systems are not base coding system."
- (car (coding-system-get coding-system 'alias-coding-systems)))
-
-;; Coding system also has a property `eol-type'.
-;;
-;; This property indicates how the coding system handles end-of-line
-;; format. The value is integer 0, 1, 2, or a vector of three coding
-;; systems. Each integer value 0, 1, and 2 indicates the format of
-;; end-of-line LF, CRLF, and CR respectively. A vector value
-;; indicates that the format of end-of-line should be detected
-;; automatically. Nth element of the vector is the subsidiary coding
-;; system whose `eol-type' property is N.
-
-(defun coding-system-eol-type (coding-system)
- "Return eol-type of CODING-SYSTEM.
-An eol-type is integer 0, 1, 2, or a vector of coding systems.
-
-Integer values 0, 1, and 2 indicate a format of end-of-line; LF,
-CRLF, and CR respectively.
-
-A vector value indicates that a format of end-of-line should be
-detected automatically. Nth element of the vector is the subsidiary
-coding system whose eol-type is N."
- (get coding-system 'eol-type))
+ "Return a category symbol of CODING-SYSTEM."
+ (plist-get (coding-system-plist coding-system) :category))
+
+(defun coding-system-get (coding-system prop)
+ "Extract a value from CODING-SYSTEM's property list for property PROP.
+For compatibility with Emacs 20/21, this accepts old-style symbols
+like `mime-charset' as well as the current style like `:mime-charset'."
+ (or (plist-get (coding-system-plist coding-system) prop)
+ (if (not (keywordp prop))
+ ;; For backward compatiblity.
+ (if (eq prop 'ascii-incompatible)
+ (not (plist-get (coding-system-plist coding-system)
+ :ascii-compatible-p))
+ (plist-get (coding-system-plist coding-system)
+ (intern (concat ":" (symbol-name prop))))))))
(defun coding-system-eol-type-mnemonic (coding-system)
"Return the string indicating end-of-line format of CODING-SYSTEM."
Two coding systems are identical if two symbols are equal
or one is an alias of the other."
(or (eq coding-system-1 coding-system-2)
- (and (equal (coding-system-spec coding-system-1)
- (coding-system-spec coding-system-2))
+ (and (equal (coding-system-plist coding-system-1)
+ (coding-system-plist coding-system-2))
(let ((eol-type-1 (coding-system-eol-type coding-system-1))
(eol-type-2 (coding-system-eol-type coding-system-2)))
(or (eq eol-type-1 eol-type-2)
(defun coding-system-list (&optional base-only)
"Return a list of all existing non-subsidiary coding systems.
-If optional arg BASE-ONLY is non-nil, only base coding systems are listed.
-The value doesn't include subsidiary coding systems which are what
+If optional arg BASE-ONLY is non-nil, only base coding systems are
+listed. The value doesn't include subsidiary coding systems which are
made from bases and aliases automatically for various end-of-line
formats (e.g. iso-latin-1-unix, koi8-r-dos)."
(let* ((codings (copy-sequence coding-system-list))
;; coding systems (if necessary).
(while (cdr tail)
(let* ((coding (car (cdr tail)))
- (aliases (coding-system-get coding 'alias-coding-systems)))
+ (aliases (coding-system-aliases coding)))
(if (or
;; CODING is an eol variant if not in ALIASES.
(not (memq coding aliases))
(setq tail (cdr tail)))))
codings))
-(defun map-charset-chars (func charset)
- "Use FUNC to map over all characters in CHARSET for side effects.
-FUNC is a function of two args, the start and end (inclusive) of a
-character code range. Thus FUNC should iterate over [START, END]."
- (let* ((dim (charset-dimension charset))
- (chars (charset-chars charset))
- (start (if (= chars 94)
- 33
- 32)))
- (if (= dim 1)
- (funcall func
- (make-char charset start)
- (make-char charset (+ start chars -1)))
- (dotimes (i chars)
- (funcall func
- (make-char charset (+ i start) start)
- (make-char charset (+ i start) (+ start chars -1)))))))
-
-(defalias 'register-char-codings 'ignore "")
-(make-obsolete 'register-char-codings
- "it exists just for backward compatibility, and does nothing."
- "21.3")
-
(defconst char-coding-system-table nil
"This is an obsolete variable.
It exists just for backward compatibility, and the value is always nil.")
-(defun make-subsidiary-coding-system (coding-system)
- "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM."
- (let ((coding-spec (coding-system-spec coding-system))
- (subsidiaries (vector (intern (format "%s-unix" coding-system))
- (intern (format "%s-dos" coding-system))
- (intern (format "%s-mac" coding-system))))
- elt)
- (dotimes (i 3)
- (setq elt (aref subsidiaries i))
- (put elt 'coding-system coding-spec)
- (put elt 'eol-type i)
- (put elt 'coding-system-define-form nil)
- (add-to-coding-system-list elt)
- (or (assoc (symbol-name elt) coding-system-alist)
- (setq coding-system-alist
- (cons (list (symbol-name elt)) coding-system-alist))))
- subsidiaries))
-
(defun transform-make-coding-system-args (name type &optional doc-string props)
"For internal use only.
Transform XEmacs style args for `make-coding-system' to Emacs style.
properties
eol-type)
"Define a new coding system CODING-SYSTEM (symbol).
-Remaining arguments are TYPE, MNEMONIC, DOC-STRING, FLAGS (optional),
-and PROPERTIES (optional) which construct a coding-spec of CODING-SYSTEM
-in the following format:
- [TYPE MNEMONIC DOC-STRING PLIST FLAGS]
-
-TYPE is an integer value indicating the type of the coding system as follows:
- 0: Emacs internal format,
- 1: Shift-JIS (or MS-Kanji) used mainly on Japanese PCs,
- 2: ISO-2022 including many variants,
- 3: Big5 used mainly on Chinese PCs,
- 4: private, CCL programs provide encoding/decoding algorithm,
- 5: Raw-text, which means that text contains random 8-bit codes.
-
-MNEMONIC is a character to be displayed on mode line for the coding system.
-
-DOC-STRING is a documentation string for the coding system.
-
-FLAGS specifies more detailed information of the coding system as follows:
-
- If TYPE is 2 (ISO-2022), FLAGS is a list of these elements:
- CHARSET0, CHARSET1, CHARSET2, CHARSET3, SHORT-FORM,
- ASCII-EOL, ASCII-CNTL, SEVEN, LOCKING-SHIFT, SINGLE-SHIFT,
- USE-ROMAN, USE-OLDJIS, NO-ISO6429, INIT-BOL, DESIGNATION-BOL,
- SAFE, ACCEPT-LATIN-EXTRA-CODE.
- CHARSETn are character sets initially designated to Gn graphic registers.
- If CHARSETn is nil, Gn is never used.
- If CHARSETn is t, Gn can be used but nothing designated initially.
- If CHARSETn is a list of character sets, those character sets are
- designated to Gn on output, but nothing designated to Gn initially.
- But, character set `ascii' can be designated only to G0.
- SHORT-FORM non-nil means use short designation sequence on output.
- ASCII-EOL non-nil means designate ASCII to g0 at end of line on output.
- ASCII-CNTL non-nil means designate ASCII to g0 before control codes and
- SPACE on output.
- SEVEN non-nil means use 7-bit code only on output.
- LOCKING-SHIFT non-nil means use locking-shift.
- SINGLE-SHIFT non-nil means use single-shift.
- USE-ROMAN non-nil means designate JIS0201-1976-Roman instead of ASCII.
- USE-OLDJIS non-nil means designate JIS0208-1976 instead of JIS0208-1983.
- NO-ISO6429 non-nil means not use ISO6429's direction specification.
- INIT-BOL non-nil means any designation state is assumed to be reset
- to initial at each beginning of line on output.
- DESIGNATION-BOL non-nil means designation sequences should be placed
- at beginning of line on output.
- SAFE non-nil means convert unsafe characters to `?' on output.
- Characters not specified in the property `safe-charsets' nor
- `safe-chars' are unsafe.
- ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts
- a code specified in `latin-extra-code-table' (which see) as a valid
- code of the coding system.
-
- If TYPE is 4 (private), FLAGS should be a cons of CCL programs, for
- decoding and encoding. CCL programs should be specified by their
- symbols.
-
-PROPERTIES is an alist of properties vs the corresponding values. The
-following properties are recognized:
-
- o post-read-conversion
-
- The value is a function to call after some text is inserted and
- decoded by the coding system itself and before any functions in
- `after-insert-functions' are called. The argument of this
- function is the same as for a function in
- `after-insert-file-functions', i.e. LENGTH of the text inserted,
- with point at the head of the text to be decoded.
-
- o pre-write-conversion
-
- The value is a function to call after all functions in
- `write-region-annotate-functions' and `buffer-file-format' are
- called, and before the text is encoded by the coding system itself.
- The arguments to this function are the same as those of a function
- in `write-region-annotate-functions', i.e. FROM and TO, specifying
- a region of text.
-
- o translation-table-for-decode
-
- The value is a translation table to be applied on decoding. See
- the function `make-translation-table' for the format of translation
- table. This is not applicable to type 4 (CCL-based) coding systems.
-
- o translation-table-for-encode
-
- The value is a translation table to be applied on encoding. This is
- not applicable to type 4 (CCL-based) coding systems.
-
- o safe-chars
-
- The value is a char table. If a character has non-nil value in it,
- the character is safely supported by the coding system. This
- overrides the specification of safe-charsets.
-
- o safe-charsets
-
- The value is a list of charsets safely supported by the coding
- system. The value t means that all charsets Emacs handles are
- supported. Even if some charset is not in this list, it doesn't
- mean that the charset can't be encoded in the coding system;
- it just means that some other receiver of text encoded
- in the coding system won't be able to handle that charset.
-
- o mime-charset
-
- The value is a symbol whose name is the `MIME-charset' parameter of
- the coding system.
-
- o mime-text-unsuitable
-
- A non-nil value means the `mime-charset' property names a charset
- which is unsuitable for the top-level media type \"text\".
-
- o valid-codes (meaningful only for a coding system based on CCL)
-
- The value is a list to indicate valid byte ranges of the encoded
- file. Each element of the list is an integer or a cons of integer.
- In the former case, the integer value is a valid byte code. In the
- latter case, the integers specify the range of valid byte codes.
-
- o composition (meaningful only when TYPE is 0 or 2)
-
- If the value is non-nil, the coding system preserves composition
- information.
-
- o ascii-incompatible
-
- If the value is non-nil, the coding system is not compatible
- with ASCII, which means it encodes or decodes ASCII character
- string to the different byte sequence.
-
-These properties are set in PLIST, a property list. This function
-also sets properties `coding-category' and `alias-coding-systems'
-automatically.
-
-EOL-TYPE specifies the EOL type of the coding-system in one of the
-following formats:
-
- o symbol (unix, dos, or mac)
-
- The symbol `unix' means Unix-like EOL (LF), `dos' means
- DOS-like EOL (CRLF), and `mac' means MAC-like EOL (CR).
-
- o number (0, 1, or 2)
-
- The number 0, 1, and 2 mean UNIX, DOS, and MAC-like EOL
- respectively.
-
- o vector of coding-systems of length 3
-
- The EOL type is detected automatically for the coding system.
- And, according to the detected EOL type, one of the coding
- systems in the vector is selected. Elements of the vector
- corresponds to Unix-like EOL, DOS-like EOL, and Mac-like EOL
- in this order.
-
-Kludgy features for backward compatibility:
-
-1. If TYPE is 4 and car or cdr of FLAGS is a vector, the vector is
-treated as a compiled CCL code.
-
-2. If PROPERTIES is just a list of character sets, the list is set as
-a value of `safe-charsets' in PLIST."
-
+This function is provided for backward compatibility.
+Use `define-coding-system' instead."
;; For compatiblity with XEmacs, we check the type of TYPE. If it
;; is a symbol, perhaps, this function is called with XEmacs-style
;; arguments. Here, try to transform that kind of arguments to
properties (nth 5 args)
eol-type (nth 6 args))))
- ;; Set a value of `coding-system' property.
- (let ((coding-spec (make-vector 5 nil))
- (no-initial-designation t)
- (no-alternative-designation t)
- (accept-latin-extra-code nil)
- coding-category)
- (if (or (not (integerp type)) (< type 0) (> type 5))
- (error "TYPE argument must be 0..5"))
- (if (or (not (integerp mnemonic)) (<= mnemonic ? ) (> mnemonic 127))
- (error "MNEMONIC argument must be an ASCII printable character"))
- (aset coding-spec coding-spec-type-idx type)
- (aset coding-spec coding-spec-mnemonic-idx mnemonic)
- (aset coding-spec coding-spec-doc-string-idx
- (purecopy (if (stringp doc-string) doc-string "")))
- (cond ((= type 0)
- (setq coding-category 'coding-category-emacs-mule))
- ((= type 1)
- (setq coding-category 'coding-category-sjis))
- ((= type 2) ; ISO2022
- (let ((i 0)
- (vec (make-vector 32 nil))
- (g1-designation nil)
- (fl flags))
- (while (< i 4)
- (let ((charset (car fl)))
- (if (and no-initial-designation
- (> i 0)
- (or (charsetp charset)
- (and (consp charset)
- (charsetp (car charset)))))
- (setq no-initial-designation nil))
- (if (charsetp charset)
- (if (= i 1) (setq g1-designation charset))
- (if (consp charset)
- (let ((tail charset)
- elt)
- (while tail
- (setq elt (car tail))
- (if (eq elt t)
- (setq no-alternative-designation nil)
- (if (and elt (not (charsetp elt)))
- (error "Invalid charset: %s" elt)))
- (setq tail (cdr tail)))
- (setq g1-designation (car charset)))
- (if charset
- (if (eq charset t)
- (setq no-alternative-designation nil)
- (error "Invalid charset: %s" charset)))))
- (aset vec i charset))
- (setq fl (cdr fl) i (1+ i)))
- (while (and (< i 32) fl)
- (aset vec i (car fl))
- (if (and (= i 16) ; ACCEPT-LATIN-EXTRA-CODE
- (car fl))
- (setq accept-latin-extra-code t))
- (setq fl (cdr fl) i (1+ i)))
- (aset coding-spec 4 vec)
- (setq coding-category
- (if (aref vec 8) ; Use locking-shift.
- (or (and (aref vec 7) 'coding-category-iso-7-else)
- 'coding-category-iso-8-else)
- (if (aref vec 7) ; 7-bit only.
- (if (aref vec 9) ; Use single-shift.
- 'coding-category-iso-7-else
- (if no-alternative-designation
- 'coding-category-iso-7-tight
- 'coding-category-iso-7))
- (if (or no-initial-designation
- (not no-alternative-designation))
- 'coding-category-iso-8-else
- (if (and (charsetp g1-designation)
- (= (charset-dimension g1-designation) 2))
- 'coding-category-iso-8-2
- 'coding-category-iso-8-1)))))))
- ((= type 3)
- (setq coding-category 'coding-category-big5))
- ((= type 4) ; private
- (setq coding-category 'coding-category-ccl)
- (if (not (consp flags))
- (error "Invalid FLAGS argument for TYPE 4 (CCL)")
- (let ((decoder (check-ccl-program
- (car flags)
- (intern (format "%s-decoder" coding-system))))
- (encoder (check-ccl-program
- (cdr flags)
- (intern (format "%s-encoder" coding-system)))))
- (if (and decoder encoder)
- (aset coding-spec 4 (cons decoder encoder))
- (error "Invalid FLAGS argument for TYPE 4 (CCL)")))))
- (t ; i.e. (= type 5)
- (setq coding-category 'coding-category-raw-text)))
-
- (let ((plist (list 'coding-category coding-category
- 'alias-coding-systems (list coding-system))))
- (if no-initial-designation
- (plist-put plist 'no-initial-designation t))
- (if (and properties
- (or (eq properties t)
- (not (consp (car properties)))))
- ;; In the old version, the arg PROPERTIES is a list to be
- ;; set in PLIST as a value of property `safe-charsets'.
- (setq properties (list (cons 'safe-charsets properties))))
- ;; In the current version PROPERTIES is a property list.
- ;; Reflect it into PLIST one by one while handling safe-chars
- ;; specially.
- (let ((safe-charsets (cdr (assq 'safe-charsets properties)))
- (safe-chars (cdr (assq 'safe-chars properties)))
- (l properties)
- prop val)
- ;; If only safe-charsets is specified, make a char-table from
- ;; it, and store that char-table as the value of `safe-chars'.
- (if (and (not safe-chars) safe-charsets)
- (let (charset)
- (if (eq safe-charsets t)
- (setq safe-chars t)
- (setq safe-chars (make-char-table 'safe-chars))
- (while safe-charsets
- (setq charset (car safe-charsets)
- safe-charsets (cdr safe-charsets))
- (cond ((eq charset 'ascii)) ; just ignore
- ((eq charset 'eight-bit-control)
- (let ((i 128))
- (while (< i 160)
- (aset safe-chars i t)
- (setq i (1+ i)))))
- ((eq charset 'eight-bit-graphic)
- (let ((i 160))
- (while (< i 256)
- (aset safe-chars i t)
- (setq i (1+ i)))))
- (t
- (aset safe-chars (make-char charset) t))))
- (if accept-latin-extra-code
- (let ((i 128))
- (while (< i 160)
- (if (aref latin-extra-code-table i)
- (aset safe-chars i t))
- (setq i (1+ i))))))
- (setq l (cons (cons 'safe-chars safe-chars) l))))
- (while l
- (setq prop (car (car l)) val (cdr (car l)) l (cdr l))
- (if (eq prop 'safe-chars)
- (progn
- (if (and (symbolp val)
- (get val 'translation-table))
- (setq safe-chars (get val 'translation-table)))
- (setq val safe-chars)))
- (plist-put plist prop val)))
- ;; The property `coding-category' may have been set differently
- ;; through PROPERTIES.
- (setq coding-category (plist-get plist 'coding-category))
- (aset coding-spec coding-spec-plist-idx plist))
- (put coding-system 'coding-system coding-spec)
- (put coding-system 'coding-system-define-form nil)
- (put coding-category 'coding-systems
- (cons coding-system (get coding-category 'coding-systems))))
-
- ;; Next, set a value of `eol-type' property.
- (if (not eol-type)
- ;; If EOL-TYPE is nil, set a vector of subsidiary coding
- ;; systems, each corresponds to a coding system for the detected
- ;; EOL format.
- (setq eol-type (make-subsidiary-coding-system coding-system)))
- (setq eol-type
- (cond ((or (eq eol-type 'unix) (null eol-type))
- 0)
- ((eq eol-type 'dos)
- 1)
- ((eq eol-type 'mac)
- 2)
- ((or (and (vectorp eol-type)
- (= (length eol-type) 3))
- (and (numberp eol-type)
- (and (>= eol-type 0)
- (<= eol-type 2))))
- eol-type)
+ (setq type
+ (cond ((eq type 0) 'emacs-mule)
+ ((eq type 1) 'shift-jis)
+ ((eq type 2) 'iso2022)
+ ((eq type 3) 'big5)
+ ((eq type 4) 'ccl)
+ ((eq type 5) 'raw-text)
(t
- (error "Invalid EOL-TYPE spec:%S" eol-type))))
- (put coding-system 'eol-type eol-type)
-
- (define-coding-system-internal coding-system)
-
- ;; At last, register CODING-SYSTEM in `coding-system-list' and
- ;; `coding-system-alist'.
- (add-to-coding-system-list coding-system)
- (or (assoc (symbol-name coding-system) coding-system-alist)
- (setq coding-system-alist (cons (list (symbol-name coding-system))
- coding-system-alist)))
-
- ;; For a coding system of cateogory iso-8-1 and iso-8-2, create
- ;; XXX-with-esc variants.
- (let ((coding-category (coding-system-category coding-system)))
- (if (or (eq coding-category 'coding-category-iso-8-1)
- (eq coding-category 'coding-category-iso-8-2))
- (let ((esc (intern (concat (symbol-name coding-system) "-with-esc")))
- (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))
- (safe-charsets (assq 'safe-charsets properties))
- (mime-charset (assq 'mime-charset properties)))
- (if safe-charsets
- (setcdr safe-charsets t)
- (setq properties (cons (cons 'safe-charsets t) properties)))
- (if mime-charset
- (setcdr mime-charset nil))
- (make-coding-system esc type mnemonic doc
- (if (listp (car flags))
- (cons (append (car flags) '(t)) (cdr flags))
- (cons (list (car flags) t) (cdr flags)))
- properties))))
-
- coding-system)
-
-(put 'safe-chars 'char-table-extra-slots 0)
-
-(defun define-coding-system-alias (alias coding-system)
- "Define ALIAS as an alias for coding system CODING-SYSTEM."
- (put alias 'coding-system (coding-system-spec coding-system))
- (put alias 'coding-system-define-form nil)
- (add-to-coding-system-list alias)
- (or (assoc (symbol-name alias) coding-system-alist)
- (setq coding-system-alist (cons (list (symbol-name alias))
- coding-system-alist)))
- (let ((eol-type (coding-system-eol-type coding-system)))
- (if (vectorp eol-type)
- (progn
- (nconc (coding-system-get alias 'alias-coding-systems) (list alias))
- (put alias 'eol-type (make-subsidiary-coding-system alias)))
- (put alias 'eol-type eol-type))))
+ (error "Invalid coding system type: %s" type))))
+
+ (setq properties
+ (let ((plist nil) key)
+ (dolist (elt properties)
+ (setq key (car elt))
+ (cond ((eq key 'post-read-conversion)
+ (setq key :post-read-conversion))
+ ((eq key 'pre-write-conversion)
+ (setq key :pre-write-conversion))
+ ((eq key 'translation-table-for-decode)
+ (setq key :decode-translation-table))
+ ((eq key 'translation-table-for-encode)
+ (setq key :encode-translation-table))
+ ((eq key 'safe-charsets)
+ (setq key :charset-list))
+ ((eq key 'mime-charset)
+ (setq key :mime-charset))
+ ((eq key 'valid-codes)
+ (setq key :valids)))
+ (setq plist (plist-put plist key (cdr elt))))
+ plist))
+ (setq properties (plist-put properties :mnemonic mnemonic))
+ (plist-put properties :coding-type type)
+ (cond ((eq eol-type 0) (setq eol-type 'unix))
+ ((eq eol-type 1) (setq eol-type 'dos))
+ ((eq eol-type 2) (setq eol-type 'mac))
+ ((vectorp eol-type) (setq eol-type nil)))
+ (plist-put properties :eol-type eol-type)
+
+ (cond
+ ((eq type 'iso2022)
+ (plist-put properties :flags
+ (list (and (or (consp (nth 0 flags))
+ (consp (nth 1 flags))
+ (consp (nth 2 flags))
+ (consp (nth 3 flags))) 'designation)
+ (or (nth 4 flags) 'long-form)
+ (and (nth 5 flags) 'ascii-at-eol)
+ (and (nth 6 flags) 'ascii-at-cntl)
+ (and (nth 7 flags) '7-bit)
+ (and (nth 8 flags) 'locking-shift)
+ (and (nth 9 flags) 'single-shift)
+ (and (nth 10 flags) 'use-roman)
+ (and (nth 11 flags) 'use-oldjis)
+ (or (nth 12 flags) 'direction)
+ (and (nth 13 flags) 'init-at-bol)
+ (and (nth 14 flags) 'designate-at-bol)
+ (and (nth 15 flags) 'safe)
+ (and (nth 16 flags) 'latin-extra)))
+ (plist-put properties :designation
+ (let ((vec (make-vector 4 nil)))
+ (dotimes (i 4)
+ (let ((spec (nth i flags)))
+ (if (eq spec t)
+ (aset vec i '(94 96))
+ (if (consp spec)
+ (progn
+ (if (memq t spec)
+ (setq spec (append (delq t spec) '(94 96))))
+ (aset vec i spec))))))
+ vec)))
+
+ ((eq type 'ccl)
+ (plist-put properties :ccl-decoder (car flags))
+ (plist-put properties :ccl-encoder (cdr flags))))
+
+ (apply 'define-coding-system coding-system doc-string properties))
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
(interactive "zCoding system for file names (default nil): ")
(check-coding-system coding-system)
(if (and coding-system
- (coding-system-get coding-system 'ascii-incompatible))
- (error "%s is not ASCII-compatible" coding-system))
+ (not (coding-system-get coding-system :ascii-compatible-p))
+ (not (coding-system-get coding-system :suitable-for-file-name)))
+ (error "%s is not suitable for file names" coding-system))
(setq file-name-coding-system coding-system))
(defvar default-terminal-coding-system nil
(if coding-system
(setq default-keyboard-coding-system coding-system))
(if (and coding-system
- (coding-system-get coding-system 'ascii-incompatible))
- (error "%s is not ASCII-compatible" coding-system))
+ (not (coding-system-get coding-system :ascii-compatible-p))
+ (not (coding-system-get coding-system :suitable-for-keyboard)))
+ (error "%s is not suitable for keyboard" coding-system))
(set-keyboard-coding-system-internal coding-system)
(setq keyboard-coding-system coding-system)
(encoded-kbd-mode (if coding-system 1 0)))
(defvar last-next-selection-coding-system nil)
(defun set-next-selection-coding-system (coding-system)
- "Make CODING-SYSTEM used for the next communication with other X clients.
+ "Use CODING-SYSTEM for next communication with other window system clients.
This setting is effective for the next communication only."
(interactive
(list (read-coding-system
(if last-next-selection-coding-system
- (format "Coding system for the next X selection (default %S): "
+ (format "Coding system for the next selection (default %S): "
last-next-selection-coding-system)
- "Coding system for the next X selection: ")
+ "Coding system for the next selection: ")
last-next-selection-coding-system)))
(if coding-system
(setq last-next-selection-coding-system coding-system)
(defun set-coding-priority (arg)
"Set priority of coding categories according to ARG.
-ARG is a list of coding categories ordered by priority."
- (let ((l arg)
- (current-list (copy-sequence coding-category-list)))
- ;; Check the validity of ARG while deleting coding categories in
- ;; ARG from CURRENT-LIST. We assume that CODING-CATEGORY-LIST
- ;; contains all coding categories.
- (while l
- (if (or (null (get (car l) 'coding-category-index))
- (null (memq (car l) current-list)))
- (error "Invalid or duplicated element in argument: %s" arg))
- (setq current-list (delq (car l) current-list))
- (setq l (cdr l)))
- ;; Update `coding-category-list' and return it.
- (setq coding-category-list (append arg current-list))
- (set-coding-priority-internal)))
+ARG is a list of coding categories ordered by priority.
+
+This function is provided for backward compatibility.
+Now we have more convenient function `set-coding-system-priority'."
+ (apply 'set-coding-system-priority
+ (mapcar #'(lambda (x) (symbol-value x)) arg)))
+(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1")
;;; X selections
(defvar ctext-non-standard-encodings-alist
- '(("big5-0" big5 2 (chinese-big5-1 chinese-big5-2))
+ '(("big5-0" big5 2 big5)
("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
- ("ISO8859-15" iso-8859-15 1 latin-iso8859-15))
+ ("ISO8859-15" iso-8859-15 1 latin-iso8859-15)
+ ("gbk-0" gbk 2 chinese-gbk))
"Alist of non-standard encoding names vs the corresponding usages in CTEXT.
It controls how extended segments of a compound text are handled
character is variable), 1, 2, 3, or 4.
CHARSET is a charater set containing characters that are encoded
-in the segment. It can be a list of character sets. It can also
-be a char-table, in which case characters that have non-nil value
-in the char-table are the target.
+in the segment. It can be a list of character sets.
On decoding CTEXT, all encoding names listed here are recognized.
listed for the current language environment under the key
`ctext-non-standard-encodings' are used.")
-(defvar ctext-non-standard-encodings
- '("big5-0")
+(defvar ctext-non-standard-encodings nil
"List of non-standard encoding names used in extended segments of CTEXT.
Each element must be one of the names listed in the variable
`ctext-non-standard-encodings-alist' (which see).")
(defun ctext-post-read-conversion (len)
"Decode LEN characters encoded as Compound Text with Extended Segments."
+ ;; We don't need the following because it is expected that this
+ ;; function is mainly used for decoding X selection which is not
+ ;; that big data.
+ ;;(buffer-disable-undo) ; minimize consing due to insertions and deletions
(save-match-data
(save-restriction
+ (narrow-to-region (point) (+ (point) len))
(let ((case-fold-search nil)
- (in-workbuf (string= (buffer-name) " *code-converting-work*"))
last-coding-system-used
pos bytes)
- (or in-workbuf
- (narrow-to-region (point) (+ (point) len)))
- (if in-workbuf
- (set-buffer-multibyte t))
+ (decode-coding-region (point-min) (point-max) 'ctext)
(while (re-search-forward ctext-non-standard-encodings-regexp
nil 'move)
(setq pos (match-beginning 0))
(if (match-beginning 1)
;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
- (let* ((M (char-after (+ pos 4)))
- (L (char-after (+ pos 5)))
+ (let* ((M (multibyte-char-to-unibyte (char-after (+ pos 4))))
+ (L (multibyte-char-to-unibyte (char-after (+ pos 5))))
(encoding (match-string 2))
(encoding-info (assoc-string
encoding
(goto-char (point-min))
(- (point-max) (point)))))
-;; Return a char table of extended segment usage for each character.
-;; Each value of the char table is nil, one of the elements of
-;; `ctext-non-standard-encodings-alist', or the symbol `utf-8'.
+;; Return an alist of CHARSET vs CTEXT-USAGE-INFO generated from
+;; `ctext-non-standard-encodings' and a list specified by the key
+;; `ctext-non-standard-encodings' for the currrent language
+;; environment. CTEXT-USAGE-INFO is one of the element of
+;; `ctext-non-standard-encodings-alist' or nil. In the former case, a
+;; character in CHARSET is encoded using extended segment. In the
+;; latter case, a character in CHARSET is encoded using normal ISO2022
+;; designation sequence. If a character is not in any of CHARSETs, it
+;; is encoded using UTF-8 encoding extention.
(defun ctext-non-standard-encodings-table ()
- (let ((table (make-char-table 'translation-table)))
- (aset table (make-char 'mule-unicode-0100-24ff) 'utf-8)
- (aset table (make-char 'mule-unicode-2500-33ff) 'utf-8)
- (aset table (make-char 'mule-unicode-e000-ffff) 'utf-8)
- (dolist (encoding (reverse
- (append
+ (let (table)
+ ;; Setup charsets specified by the key
+ ;; `ctext-non-standard-encodings' for the current language
+ ;; environment and in `ctext-non-standard-encodings'.
+ (dolist (encoding (append
(get-language-info current-language-environment
'ctext-non-standard-encodings)
- ctext-non-standard-encodings)))
+ ctext-non-standard-encodings))
(let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
(charset (nth 3 slot)))
- (if charset
- (cond ((charsetp charset)
- (aset table (make-char charset) slot))
- ((listp charset)
- (dolist (elt charset)
- (aset table (make-char elt) slot)))
- ((char-table-p charset)
- (map-char-table #'(lambda (k v)
- (if (and v (> k 128)) (aset table k slot)))
- charset))))))
- table))
+ (if (charsetp charset)
+ (push (cons charset slot) table)
+ (dolist (cs charset)
+ (push (cons cs slot) table)))))
+
+ ;; Next prepend charsets for ISO2022 designation sequence.
+ (dolist (charset charset-list)
+ (let ((final (plist-get (charset-plist charset) :iso-final-char)))
+ (if (and (integerp final)
+ (>= final #x40) (<= final #x7e)
+ ;; Exclude ascii and chinese-cns11643-X.
+ (not (eq charset 'ascii))
+ (not (string-match "cns11643" (symbol-name charset))))
+ (push (cons charset nil) table))))
+
+ ;; Returned reversed list so that the charsets specified by the
+ ;; key `ctext-non-standard-encodings' for the current language
+ ;; have the highest priority.
+ (nreverse table)))
(defun ctext-pre-write-conversion (from to)
"Encode characters between FROM and TO as Compound Text w/Extended Segments.
by encode-coding-string, generate a new temp buffer, insert the
text, and convert it in the temporary buffer. Otherwise, convert in-place."
(save-match-data
- (let ((workbuf (get-buffer-create " *code-conversion-work*")))
- ;; Setup a working buffer if necessary.
- (cond ((stringp from)
- (set-buffer workbuf)
- (erase-buffer)
- (set-buffer-multibyte (multibyte-string-p from))
- (insert from))
- ((not (eq (current-buffer) workbuf))
- (let ((buf (current-buffer))
- (multibyte enable-multibyte-characters))
- (set-buffer workbuf)
- (erase-buffer)
- (set-buffer-multibyte multibyte)
- (insert-buffer-substring buf from to)))))
+ ;; Setup a working buffer if necessary.
+ (when (stringp from)
+ (set-buffer (generate-new-buffer " *temp"))
+ (set-buffer-multibyte (multibyte-string-p from))
+ (insert from))
;; Now we can encode the whole buffer.
(let ((encoding-table (ctext-non-standard-encodings-table))
last-coding-system-used
last-pos last-encoding-info
- encoding-info end-pos)
+ encoding-info end-pos ch)
(goto-char (setq last-pos (point-min)))
(setq end-pos (point-marker))
(while (re-search-forward "[^\000-\177]+" nil t)
;; Found a sequence of non-ASCII characters.
(setq last-pos (match-beginning 0)
- last-encoding-info (aref encoding-table (char-after last-pos)))
+ ch (char-after last-pos)
+ last-encoding-info (catch 'tag
+ (dolist (elt encoding-table)
+ (if (encode-char ch (car elt))
+ (throw 'tag (cdr elt))))
+ 'utf-8))
(set-marker end-pos (match-end 0))
(goto-char (1+ last-pos))
(catch 'tag
(while t
(setq encoding-info
(if (< (point) end-pos)
- (aref encoding-table (following-char))))
+ (catch 'tag
+ (setq ch (following-char))
+ (dolist (elt encoding-table)
+ (if (encode-char ch (car elt))
+ (throw 'tag (cdr elt))))
+ 'utf-8)))
(unless (eq last-encoding-info encoding-info)
(cond ((consp last-encoding-info)
;; Encode the previous range using an extended
(encode-coding-region last-pos (point) coding-system)
(setq len (+ (length encoding-name) 1
(- (point) last-pos)))
+ ;; According to the spec of CTEXT, it is not
+ ;; necessary to produce this extra designation
+ ;; sequence, but some buggy application
+ ;; (e.g. crxvt-gb) requires it.
+ (insert "\e(B")
(save-excursion
(goto-char last-pos)
- (insert (string-to-multibyte
- (format "\e%%/%d%c%c%s\ 2"
- noctets
- (+ (/ len 128) 128)
- (+ (% len 128) 128)
- encoding-name))))))
+ (insert (format "\e%%/%d" noctets))
+ (insert-byte (+ (/ len 128) 128) 1)
+ (insert-byte (+ (% len 128) 128) 1)
+ (insert encoding-name)
+ (insert 2))))
((eq last-encoding-info 'utf-8)
;; Encode the previous range using UTF-8 encoding
;; extention.
(defcustom auto-coding-regexp-alist
'(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion)
- ("\\`\xEF\xBB\xBF" . utf-8))
+ ("\\`\xFE\xFF" . utf-16be-with-signature)
+ ("\\`\xFF\xFE" . utf-16le-with-signature)
++ ("\\`\xEF\xBB\xBF" . utf-8)
+ ("\\`;ELC\024\0\0\0" . emacs-mule)) ; Emacs 20-compiled
"Alist of patterns vs corresponding coding systems.
Each element looks like (REGEXP . CODING-SYSTEM).
A file whose first bytes match REGEXP is decoded by CODING-SYSTEM on reading.
(setq buffer-file-coding-system-explicit coding-system-for-read))
(if last-coding-system-used
(let ((coding-system
- (find-new-buffer-file-coding-system last-coding-system-used))
- (modified-p (buffer-modified-p)))
+ (find-new-buffer-file-coding-system last-coding-system-used)))
(when coding-system
;; Tell set-buffer-file-coding-system not to mark the file
;; as modified; we just read it, and it's supposed to be unmodified.
;; Marking it modified would try to lock it, which would
;; check the modtime, and we don't want to do that again now.
- (set-buffer-file-coding-system coding-system t t)
- (if (and enable-multibyte-characters
- (or (eq coding-system 'no-conversion)
- (eq (coding-system-type coding-system) 5))
- ;; If buffer was unmodified and the size is the
- ;; same as INSERTED, we must be visiting it.
- (not modified-p)
- (= (buffer-size) inserted))
- ;; For coding systems no-conversion and raw-text...,
- ;; edit the buffer as unibyte.
- (let ((pos-marker (copy-marker (+ (point) inserted)))
- ;; Prevent locking.
- (buffer-file-name nil))
- (set-buffer-multibyte nil)
- (setq inserted (- pos-marker (point)))))
- (set-buffer-modified-p modified-p))))
+ (set-buffer-file-coding-system coding-system t t))))
inserted)
;; The coding-spec and eol-type of coding-system returned is decided
;; But eol-type is not yet set.
(setq local-eol nil))
(if (and buffer-file-coding-system
- (not (eq (coding-system-type buffer-file-coding-system) t)))
- ;; This is not `undecided'.
+ (not (eq (coding-system-type buffer-file-coding-system)
+ 'undecided)))
(setq local-coding (coding-system-base buffer-file-coding-system)))
(if (and (local-variable-p 'buffer-file-coding-system)
;; But eol-type is not found.
;; If EOL conversions are inhibited, force unix eol-type.
(setq found-eol (if inhibit-eol-conversion 0)))
- (if (eq (coding-system-type coding) t)
- (setq found-coding 'undecided)
- (setq found-coding (coding-system-base coding)))
+ (setq found-coding (coding-system-base coding))
(if (and (not found-eol) (eq found-coding 'undecided))
;; No valid coding information found.
Each argument is a list of elements of the form (FROM . TO), where FROM
is a character to be translated to TO.
-FROM can be a generic character (see `make-char'). In this case, TO is
-a generic character containing the same number of characters, or an
-ordinary character. If FROM and TO are both generic characters, all
-characters belonging to FROM are translated to characters belonging to TO
-without changing their position code(s).
-
The arguments and forms in each argument are processed in the given
order, and if a previous form already translates TO to some other
character, say TO-ALT, FROM is also translated to TO-ALT."
(let ((table (make-char-table 'translation-table))
revlist)
- (while args
- (let ((elts (car args)))
- (while elts
- (let* ((from (car (car elts)))
- (from-i 0) ; degree of freedom of FROM
- (from-rev (nreverse (split-char from)))
- (to (cdr (car elts)))
- (to-i 0) ; degree of freedom of TO
- (to-rev (nreverse (split-char to))))
- ;; Check numbers of heading 0s in FROM-REV and TO-REV.
- (while (eq (car from-rev) 0)
- (setq from-i (1+ from-i) from-rev (cdr from-rev)))
- (while (eq (car to-rev) 0)
- (setq to-i (1+ to-i) to-rev (cdr to-rev)))
- (if (and (/= from-i to-i) (/= to-i 0))
- (error "Invalid character pair (%d . %d)" from to))
- ;; If we have already translated TO to TO-ALT, FROM should
- ;; also be translated to TO-ALT. But, this is only if TO
- ;; is a generic character or TO-ALT is not a generic
- ;; character.
- (let ((to-alt (aref table to)))
- (if (and to-alt
- (or (> to-i 0) (not (generic-char-p to-alt))))
- (setq to to-alt)))
- (if (> from-i 0)
- (set-char-table-default table from to)
- (aset table from to))
- ;; If we have already translated some chars to FROM, they
- ;; should also be translated to TO.
- (let ((l (assq from revlist)))
- (if l
- (let ((ch (car l)))
- (setcar l to)
- (setq l (cdr l))
- (while l
- (aset table ch to)
- (setq l (cdr l)) ))))
- ;; Now update REVLIST.
- (let ((l (assq to revlist)))
- (if l
- (setcdr l (cons from (cdr l)))
- (setq revlist (cons (list to from) revlist)))))
- (setq elts (cdr elts))))
- (setq args (cdr args)))
+ (dolist (elts args)
+ (dolist (elt elts)
+ (let ((from (car elt))
+ (to (cdr elt))
+ to-alt rev-from rev-to)
+ ;; If we have already translated TO to TO-ALT, FROM should
+ ;; also be translated to TO-ALT.
+ (if (setq to-alt (aref table to))
+ (setq to to-alt))
+ (aset table from to)
+ ;; If we have already translated some chars to FROM, they
+ ;; should also be translated to TO.
+ (when (setq rev-from (assq from revlist))
+ (dolist (elt (cdr rev-from))
+ (aset table elt to))
+ (setq revlist (delq rev-from revlist)
+ rev-from (cdr rev-from)))
+ ;; Now update REVLIST.
+ (setq rev-to (assq to revlist))
+ (if rev-to
+ (setcdr rev-to (cons from (cdr rev-to)))
+ (setq rev-to (list to from)
+ revlist (cons rev-to revlist)))
+ (if rev-from
+ (setcdr rev-to (append rev-from (cdr rev-to)))))))
;; Return TABLE just created.
+ (set-char-table-extra-slot table 1 1)
table))
(defun make-translation-table-from-vector (vec)
(if (>= ch 256)
(aset rev-table ch i))))
(set-char-table-extra-slot table 0 rev-table)
+ (set-char-table-extra-slot table 1 1)
+ (set-char-table-extra-slot rev-table 1 1)
table))
+(defun make-translation-table-from-alist (alist)
+ "Make translation table from N<->M mapping in ALIST.
+ALIST is an alist, each element has the form (FROM . TO).
+FROM and TO are a character or a vector of characters.
+If FROM is a character, that character is translated to TO.
+If FROM is a vector of characters, that sequence is translated to TO.
+The first extra-slot of the value is a translation table for reverse mapping."
+ (let ((tables (vector (make-char-table 'translation-table)
+ (make-char-table 'translation-table)))
+ table max-lookup from to idx val)
+ (dotimes (i 2)
+ (setq table (aref tables i))
+ (setq max-lookup 1)
+ (dolist (elt alist)
+ (if (= i 0)
+ (setq from (car elt) to (cdr elt))
+ (setq from (cdr elt) to (car elt)))
+ (if (characterp from)
+ (setq idx from)
+ (setq idx (aref from 0)
+ max-lookup (max max-lookup (length from))))
+ (setq val (aref table idx))
+ (if val
+ (progn
+ (or (consp val)
+ (setq val (list (cons (vector idx) val))))
+ (if (characterp from)
+ (setq from (vector from)))
+ (setq val (nconc val (list (cons from to)))))
+ (if (characterp from)
+ (setq val to)
+ (setq val (list (cons from to)))))
+ (aset table idx val))
+ (set-char-table-extra-slot table 1 max-lookup))
+ (set-char-table-extra-slot (aref tables 0) 0 (aref tables 1))
+ (aref tables 0)))
+
(defun define-translation-table (symbol &rest args)
"Define SYMBOL as the name of translation table made by ARGS.
This sets up information so that the table can be used for
(put 'with-category-table 'lisp-indent-function 1)
(defmacro with-category-table (table &rest body)
- "Evaluate BODY with category table of current buffer set to TABLE.
+ "Execute BODY like `progn' with CATEGORY-TABLE the current category table.
The category table of the current buffer is saved, BODY is evaluated,
then the saved table is restored, even in case of an abnormal exit.
Value is what BODY returns."
(setq ignore-relative-composition
(make-char-table 'ignore-relative-composition))
+(make-obsolete 'set-char-table-default
+ "Generic characters no longer exist" "23.1")
;;; Built-in auto-coding-functions:
(defvar isearch-mode-map
(let* ((i 0)
(map (make-keymap)))
- (or (vectorp (nth 1 map))
- (char-table-p (nth 1 map))
+ (or (char-table-p (nth 1 map))
(error "The initialization of isearch-mode-map must be updated"))
;; Make all multibyte characters search for themselves.
- (let ((l (generic-character-list))
- (table (nth 1 map)))
- (while l
- (set-char-table-default table (car l) 'isearch-printing-char)
- (setq l (cdr l))))
+ (set-char-table-range (nth 1 map) (cons #x100 (max-char))
+ 'isearch-printing-char)
;; Make function keys, etc, which aren't bound to a scrolling-function
;; exit the search.
(define-key map [t] 'isearch-other-control-char)
(and (integerp main-event)
(memq 'shift mods)
(memq 'control mods)
- (lookup-key isearch-mode-map
- (let ((copy (copy-sequence key)))
- (aset copy 0
- (- main-event (- ?\C-\S-a ?\C-a)))
- copy)
- nil)))
+ (not (memq (lookup-key isearch-mode-map
+ (let ((copy (copy-sequence key)))
+ (aset copy 0
+ (- main-event
+ (- ?\C-\S-a ?\C-a)))
+ copy)
+ nil)
+ '(nil
+ isearch-other-control-char)))))
(setcar keylist (- main-event (- ?\C-\S-a ?\C-a)))
(cancel-kbd-macro-events)
(apply 'isearch-unread keylist))
"String to prepend to Subject line when replying to a message.")
;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
- ;; This pattern should catch all the common variants. The pattern
- ;; also ignores mailing list identifiers sometimes added in square
- ;; brackets at the beginning of subject lines.
- (defvar rmail-reply-regexp "\\`\\(\\[.+?\\] \\)?\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
+ ;; This pattern should catch all the common variants.
+ ;; rms: I deleted the change to delete tags in square brackets
+ ;; because they mess up RT tags.
+ (defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
(defcustom rmail-display-summary nil
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
- ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
- ;; earlier versions did that with the current buffer's encoding.
- ;; So we want to favor detection of emacs-mule (whose normal
- ;; priority is quite low), but still allow detection of other
- ;; encodings if emacs-mule won't fit. The call to
- ;; detect-coding-with-priority below achieves that.
- (car (detect-coding-with-priority
- from to
- '((coding-category-emacs-mule . emacs-mule))))))
- (unless (memq coding-system
- '(undecided undecided-unix))
+ ;; If rmail-file-coding-system is nil, Emacs 21 writes
+ ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
+ ;; earlier versions did that with the current buffer's
+ ;; encoding. So we want to favor detection of emacs-mule
+ ;; (whose normal priority is quite low) and utf-8, but
+ ;; still allow detection of other encodings if they won't
+ ;; fit. The call to with-coding-priority below achieves
+ ;; that.
+ (with-coding-priority '(emacs-mule utf-8)
+ (detect-coding-region from to 'highest))))
+ (unless (eq (coding-system-type coding-system) 'undecided)
(set-buffer-modified-p t) ; avoid locking when decoding
(let ((buffer-undo-list t))
(decode-coding-region from to coding-system))
-2006-03-19 Bill Wohler <wohler@newt.com>
-
- * mh-compat.el (mh-image-load-path-for-library): Shorten first line in
- docstring.
-
+ 2006-03-17 Bill Wohler <wohler@newt.com>
+
+ * mh-compat.el (mh-image-load-path-for-library): Minor docstring
+ fix.
+
+ 2006-03-16 Bill Wohler <wohler@newt.com>
+
+ * mh-comp.el (mh-send-letter): Use split-string to break up
+ mh-send-args (closes SF #1448604).
+ (mh-compose-and-send-mail): Use run-hook-with-args for
+ mh-compose-letter-function.
+
+ * mh-e.el (mh-list-to-string-1): Use dolist.
+
+ * mh-compat.el (mh-image-load-path-for-library): Prefer user's
+ images.
+
+ 2006-03-15 Bill Wohler <wohler@newt.com>
+
+ * mh-compat.el (mh-image-load-path-for-library): Fix example by
+ not recommending that one binds image-load-path. Just defvar it to
+ placate compiler and only use it if previously defined.
+
+ * mh-e.el (image-load-path): Don't bind!
+
+ * mh-folder.el (mh-folder-mode): Only use image-load-path if
+ previously defined.
+
+ * mh-letter.el (mh-letter-mode): Ditto.
+
+ * mh-utils.el (mh-logo-display): Ditto.
+
+ 2006-03-14 Bill Wohler <wohler@newt.com>
+
+ * mh-compat.el (mh-image-load-path-for-library): Incorporate
+ changes from image-load-path-for-library, which are:
+ (image-load-path-for-library): Pass value of path rather than
+ symbol. Always return list of directories. Guarantee that image
+ directory comes first.
+
+ * mh-e.el (image-load-path): Define on those Emacsen that lack it
+ to avoid compile and run-time errors.
+
+ * mh-folder.el (mh-folder-mode): Use new idiom for setting
+ image-load-path.
+
+ * mh-letter.el (mh-letter-mode): Ditto.
+
+ * mh-utils.el (mh-logo-display): Ditto.
+
2006-03-12 Bill Wohler <wohler@newt.com>
* mh-utils.el (mh-folder-list): Fix docstring (closes SF
(mh-defun-compat mh-image-load-path-for-library
image-load-path-for-library (library image &optional path no-error)
- "Return a suitable search path for images relative to LIBRARY.
- "Return a suitable search path for images used by LIBRARY.
++ "Return a suitable search path for images used by the Lisp package LIBRARY.
- Images for LIBRARY are searched for in \"../../etc/images\" and
- \"../etc/images\" relative to the files in \"lisp/LIBRARY\" as
- well as in `image-load-path' and `load-path'.
+ It searches for IMAGE in `image-load-path' (excluding
+ \"`data-directory'/images\") and `load-path', followed by a path
+ suitable for LIBRARY, which includes \"../../etc/images\" and
+ \"../etc/images\" relative to the library file itself, and then
+ in \"`data-directory'/images\".
- This function returns the value of `load-path' augmented with the
- directory containing IMAGE. If PATH is given, it is used instead
- of `load-path'. If PATH is t, just return the directory that
- contains IMAGE.
+ Then this function returns a list of directories which contains
+ first the directory in which IMAGE was found, followed by the
+ value of `load-path'. If PATH is given, it is used instead of
+ `load-path'.
- If NO-ERROR is non-nil, return nil if a suitable path can't be
- found rather than signaling an error.
+ If NO-ERROR is non-nil and a suitable path can't be found, don't
+ signal an error. Instead, return a list of directories as before,
+ except that nil appears in place of the image directory.
Here is an example that uses a common idiom to provide
compatibility with versions of Emacs that lack the variable
`image-load-path':
- (let ((load-path
- (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
- (image-load-path
- (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path)))
- (mh-tool-bar-folder-buttons-init))
+ ;; Shush compiler.
+ (defvar image-load-path)
- This function is used by Emacs versions that don't have
- `image-load-path-for-library'."
+ (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path))))
+ (mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
(unless image (error "No image specified"))
- (let ((image-directory))
+ (let (image-directory image-directory-load-path)
+ ;; Check for images in image-load-path or load-path.
+ (let ((img image)
+ (dir (or
+ ;; Images in image-load-path.
+ (mh-image-search-load-path image)
+ ;; Images in load-path.
+ (locate-library image)))
+ parent)
+ ;; Since the image might be in a nested directory (for
+ ;; example, mail/attach.pbm), adjust `image-directory'
+ ;; accordingly.
+ (when dir
+ (setq dir (file-name-directory dir))
+ (while (setq parent (file-name-directory img))
+ (setq img (directory-file-name parent)
+ dir (expand-file-name "../" dir))))
+ (setq image-directory-load-path dir))
+
+ ;; If `image-directory-load-path' isn't Emacs' image directory,
+ ;; it's probably a user preference, so use it. Then use a
+ ;; relative setting if possible; otherwise, use
+ ;; `image-directory-load-path'.
(cond
+ ;; User-modified image-load-path?
+ ((and image-directory-load-path
+ (not (equal image-directory-load-path
+ (file-name-as-directory
+ (expand-file-name "images" data-directory)))))
+ (setq image-directory image-directory-load-path))
;; Try relative setting.
((let (library-name d1ei d2ei)
;; First, find library in the load-path.
;; And then set image-directory relative to that.
(setq
;; Go down 2 levels.
- d2ei (expand-file-name
- (concat (file-name-directory library-name) "../../etc/images"))
+ d2ei (file-name-as-directory
+ (expand-file-name
+ (concat (file-name-directory library-name) "../../etc/images")))
;; Go down 1 level.
- d1ei (expand-file-name
- (concat (file-name-directory library-name) "../etc/images")))
+ d1ei (file-name-as-directory
+ (expand-file-name
+ (concat (file-name-directory library-name) "../etc/images"))))
(setq image-directory
;; Set it to nil if image is not found.
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Check for images in image-load-path or load-path.
- ((let ((img image)
- (dir (or
- ;; Images in image-load-path.
- (mh-image-search-load-path image)
- ;; Images in load-path.
- (locate-library image)))
- parent)
- ;; Since the image might be in a nested directory (for
- ;; example, mail/attach.pbm), adjust `image-directory'
- ;; accordingly.
- (and dir
- (setq dir (file-name-directory dir))
- (progn
- (while (setq parent (file-name-directory img))
- (setq img (directory-file-name parent)
- dir (expand-file-name "../" dir)))
- (setq image-directory dir)))))
+ ;; Use Emacs' image directory.
+ (image-directory-load-path
+ (setq image-directory image-directory-load-path))
(no-error
- ;; In this case we will return nil.
(message "Could not find image %s for library %s" image library))
(t
(error "Could not find image %s for library %s" image library)))
- ;; Return the directory, nil if no-error was non-nil and a
- ;; suitable path could not be found, or an augmented
- ;; `image-load-path' or `load-path'.
- (cond ((or (null image-directory)
- (eq path t))
- image-directory)
- ((and path (symbolp path))
- (nconc (list image-directory)
- (delete image-directory
- (if (boundp path)
- (copy-sequence (symbol-value path))
- nil))))
- (t
- (nconc (list image-directory)
- (delete image-directory (copy-sequence load-path)))))))
+ ;; Return an augmented `path' or `load-path'.
+ (nconc (list image-directory)
+ (delete image-directory (copy-sequence (or path load-path))))))
(mh-defun-compat mh-image-search-load-path
image-search-load-path (file &optional path)
(list face (if (equal value "") nil value))))
;;; Enable Japanese fonts on Windows to be used by default.
-(set-fontset-font nil (make-char 'katakana-jisx0201) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'latin-jisx0201) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'japanese-jisx0208) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'japanese-jisx0208-1978) '("*" . "JISX0208-SJIS"))
+;; (set-fontset-font nil (make-char 'katakana-jisx0201) '("*" . "JISX0208-SJIS"))
+;; (set-fontset-font nil (make-char 'latin-jisx0201) '("*" . "JISX0208-SJIS"))
+;; (set-fontset-font nil (make-char 'japanese-jisx0208) '("*" . "JISX0208-SJIS"))
+;; (set-fontset-font nil (make-char 'japanese-jisx0208-1978) '("*" . "JISX0208-SJIS"))
(defun mouse-set-font (&rest fonts)
- "Select a font.
+ "Select an Emacs font from a list of known good fonts and fontsets.
+
If `w32-use-w32-font-dialog' is non-nil (the default), use the Windows
- font dialog to get the matching FONTS. Otherwise use a pop-up menu
- \(like Emacs on other platforms) initialized with the fonts in
- `w32-fixed-font-alist'."
+ font dialog to display the list of possible fonts. Otherwise use a
+ pop-up menu (like Emacs does on other platforms) initialized with
+ the fonts in `w32-fixed-font-alist'.
+ If `w32-list-proportional-fonts' is non-nil, add proportional fonts
+ to the list in the font selection dialog (the fonts listed by the
+ pop-up menu are unaffected by `w32-list-proportional-fonts')."
(interactive
(if w32-use-w32-font-dialog
(let ((chosen-font (w32-select-font (selected-frame)
(decode-coding-string str (ispell-get-coding-system))
str))
-(put 'ispell-unified-chars-table 'char-table-extra-slots 0)
-
-;; Char-table that maps an Unicode character (charset:
-;; latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-34ff) to
-;; a string in which all equivalent characters are listed.
-
-(defconst ispell-unified-chars-table
- (let ((table (make-char-table 'ispell-unified-chars-table)))
- (map-char-table
- #'(lambda (c v)
- (if (and v (/= c v))
- (let ((unified (or (aref table v) (string v))))
- (aset table v (concat unified (string c))))))
- ucs-mule-8859-to-mule-unicode)
- table))
-
-;; Return a string decoded from Nth element of the current dictionary
-;; while splicing equivalent characters into the string. This splicing
-;; is done only if the string is a regular expression of the form
-;; "[...]" because, otherwise, splicing will result in incorrect
-;; regular expression matching.
-
+;; Return a string decoded from Nth element of the current dictionary.
(defun ispell-get-decoded-string (n)
(let* ((slot (or
(assoc ispell-current-dictionary ispell-local-dictionary-alist)
(when (and (> (length str) 0)
(not (multibyte-string-p str)))
(setq str (ispell-decode-string str))
- (if (and (= (aref str 0) ?\[)
- (eq (string-match "\\]" str) (1- (length str))))
- (setq str
- (string-as-multibyte
- (mapconcat
- #'(lambda (c)
- (let ((unichar (aref ucs-mule-8859-to-mule-unicode c)))
- (if unichar
- (aref ispell-unified-chars-table unichar)
- (string c))))
- str ""))))
+ (or (multibyte-string-p str)
+ (setq str (string-to-multibyte str)))
(setcar (nthcdr n slot) str))
str))
("^%!PS-Adobe-[123].0" . "\n%%EOF\n")
("^---* \\(Start of \\)?[Ff]orwarded [Mm]essage"
. "^---* End of [Ff]orwarded [Mm]essage")
- ;; Matches e-mail addresses, file names, http addresses, etc. The `-+'
- ;; pattern necessary for performance reasons when `-' part of word syntax.
- ("\\(--+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")
+ ;; Matches e-mail addresses, file names, http addresses, etc. The
+ ;; `-+' `_+' patterns are necessary for performance reasons when
+ ;; `-' or `_' part of word syntax.
+ ("\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")
;; above checks /.\w sequences
;;("\\(--+\\|\\(/\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")
;; This is a pretty complex regexp. It can be simplified to the following:
+ 2006-03-18 Chong Yidong <cyd@stupidchicken.com>
+
+ * xterm.c (x_display_ok): Fix minor bug and compilation warnings.
+
+ 2006-03-18 Nozomu Ando <nand@mac.com>
+
+ * m/pmax.h (BROKEN_NOCOMBRELOC) [__NetBSD__]: Define.
+ (LIB_STANDARD, START_FILES) [__NetBSD__]: Don't define.
+ (START_FILES, RUN_TIME_REMAP, UNEXEC) [__NetBSD__, __OpenBSD__]:
+ Don't redefine.
+
+ * m/mips.h: Don't use unexmips on NetBSD.
+ (LIBS_MACHINE): Move definition lower, so it doesn't use
+ LD_SWITCH_MACHINE, START_FILES, LIB_STANDARD, LIBS_TERMCAP,
+ C_SWITCH_MACHINE, and C_DEBUG_SWITCH.
+
+ * unexelf.c [BROKEN_NOCOMBRELOC]: Include assert.h.
+ (unexec) [BROKEN_NOCOMBRELOC]: Handle platforms whose nocombreloc
+ option is broken (e.g., MIPS/NetBSD).
+
+ 2006-03-18 Craig McDaniel <craigmcd@gmail.com> (tiny change)
+
+ * sheap.c (STATIC_HEAP_SIZE): Enlarge STATIC_HEAP_SIZE to 12MB.
+ Remove the HAVE_X_WINDOWS conditional.
+
+ 2006-03-18 Vivek Dasmohapatra <vivek@etla.org> (tiny change)
+
+ * emacs.c (main): If user asks for a display that is unavailable,
+ simulate -nw.
+
+ * xterm.c (x_display_ok): New function.
+
+ * xterm.h: Add prototype for x_display_ok.
+
+ 2006-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (Fw32_select_font): Doc fix.
+
+ 2006-03-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * image.c [MAC_OS] (XPutPixel, XGetPixel)
+ [!WORDS_BIG_ENDIAN && USE_CG_DRAWING]: Don't use specialized
+ version when depth is 32.
+ (mac_create_cg_image_from_image) [MAC_OS && USE_CG_DRAWING]: New
+ function.
+ (prepare_image_for_display) [MAC_OS && USE_CG_DRAWING]: Use it.
+ (x_clear_image_1) [MAC_OS && USE_CG_DRAWING]: Release CGImage.
+
+ * macterm.c (XCreatePixmap) [!WORDS_BIG_ENDIAN && USE_CG_DRAWING]:
+ Create GWorld in ARGB pixel format.
+ (mac_copy_area, mac_copy_area_with_mask) [USE_CG_DRAWING]: Remove
+ functions.
+ (x_draw_image_foreground) [USE_CG_DRAWING]: Use mac_draw_cg_image
+ instead of mac_copy_area/mac_copy_area_with_mask.
+
+ 2006-03-15 Kim F. Storm <storm@cua.dk>
+
+ * xdisp.c (extend_face_to_end_of_line): Always add space glyph to
+ empty row. Fixes memory corruption revealed by 2006-03-02 change.
+ (display_tool_bar_line): Skip empty tool-bar line if HEIGHT < 0.
+ (tool_bar_lines_needed): Fix tool-bar display in case the tool-bar
+ width is exactly the same as the window width. Don't count a final
+ empty tool-bar line (pass HEIGHT = -1 to display_tool_bar_line).
+
+ 2006-03-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * fringe.c (w32_init_fringe, w32_reset_fringes): Revert to being
+ conditional on HAVE_NTGUI, not WINDOWS_NT.
+
+ 2006-03-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * dispextern.h (mac_init_fringe) [MAC_OS]: Add prototype.
+
+ * fringe.c (mac_init_fringe) [MAC_OS]: New function.
+
+ * macterm.c (mac_initialize) [USE_CG_DRAWING]: Call mac_init_fringe.
+ (max_fringe_bmp, fringe_bmp) [USE_CG_DRAWING]: New variables.
+ (mac_define_fringe_bitmap, mac_destroy_fringe_bitmap)
+ (mac_draw_cg_image) [USE_CG_DRAWING]: New functions.
+ (mac_draw_bitmap) [USE_CG_DRAWING]: Remove function.
+ (x_draw_fringe_bitmap) [USE_CG_DRAWING]: Use mac_draw_cg_image
+ instead of mac_draw_bitmap.
+ (x_redisplay_interface) [USE_CG_DRAWING]: Set handlers for
+ define_fringe_bitmap and destroy_fringe_bitmap.
+
+ 2006-03-14 Chong Yidong <cyd@stupidchicken.com>
+
+ * xterm.c (x_uncatch_errors): Block input for entire function.
+
2006-03-12 Jason Rumney <jasonr@gnu.org>
* w32fns.c (Fx_create_frame): Remove call to
- Qface_set_after_frame_default. (from xfns.c 2003-05-26)
+ Qface_set_after_frame_default (from xfns.c 2003-05-26).
* w32menu.c (Fx_popup_menu): Call w32_free_menu_strings when
finished with the menu.
(note_mouse_movement): Say mouse moved if current frame differs
from last_mouse_glyph_frame, and update last_mouse_glyph_frame.
(w32_mouse_position): Set last_mouse_glyph_frame.
- Remove OLD_REDISPLAY_CODE block.
+ Remove OLD_REDISPLAY_CODE block.
2006-03-12 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* xdisp.c: Minimize the unpleasent visual impact of the requirement
that non-toolkit tool-bars must occupy an integral number of screen
- lines, by distributing the rows evenly over the tool-bar screen area.
+ lines, by distributing the rows evenly over the tool-bar screen area.
(Vtool_bar_border): New variable.
(syms_of_xdisp): DEFVAR_LISP it.
(display_tool_bar_line): Add HEIGHT arg for desired row height.
* xterm.h, xterm.c (x_uncatch_errors): Delete unneccessary argument.
- * xterm.c: (x_load_font, x_term_init, XTmouse_position)
- (handle_one_xevent, x_connection_closed, x_list_fonts): No arg for
- x_uncatch_errors.
+ * xterm.c (x_load_font, x_term_init, XTmouse_position)
+ (handle_one_xevent, x_connection_closed, x_list_fonts):
+ No arg for x_uncatch_errors.
* xselect.c (x_own_selection, x_decline_selection_request)
(x_reply_selection_request, x_get_foreign_selection)
* fringe.c (syms_of_fringe) <fringe-bitmaps>: Doc fix.
- 2006-02-21 Zhang Wei <brep@newsmth.org>
+ 2006-02-21 Zhang Wei <brep@newsmth.org>
* xfns.c (Fx_file_dialog, Motif and GTK): DECODE_FILE before
returning it.
(draw_fringe_bitmap_1): Make static.
(get_logical_cursor_bitmap, get_logical_fringe_bitmap): New functions
to map from logical cursors and indicators to physical bitmaps.
- (draw_fringe_bitmap): Resolve fringe cursor and overlay-arrow
+ (draw_fringe_bitmap): Resolve fringe cursor and overlay-arrow
bitmaps using symbol names instead of bitmap numbers.
(update_window_fringes): Use logical indicator symbol names
instead of bitmap numbers for logical. Add bitmap cache.
* regex.c (re_error_msgid): Add an entry for REG_ERANGEX.
(regex_compile): Return REG_ERANGEX if appropriate.
-2004-10-22 Kenichi Handa <handa@m17n.org>
-
- * editfns.c (Ftranslate_region_internal): New function.
- (syms_of_editfns): Defsubr it.
-
2004-10-22 Jan Dj\e,Ad\e(Brv <jan.h.d@swipnet.se>
* xfns.c (xic_create_xfontset): Initialize missing_list to NULL.
LFACE_FONT_INDEX,
LFACE_INHERIT_INDEX,
LFACE_AVGWIDTH_INDEX,
+ LFACE_FONTSET_INDEX,
LFACE_VECTOR_SIZE
};
reallocated. */
int font_info_id;
- /* Fontset ID if this face uses a fontset, or -1. This is only >= 0
- if the face was realized for a composition sequence.
- Otherwise, a specific font is loaded from the set of fonts
- specified by the fontset given by the family attribute of the face. */
+ /* Fontset ID if for this face's fontset. Non-ASCII faces derived
+ from the same ASCII face have the same fontset. */
int fontset;
/* Pixmap width and height. */
/* The hash value of this face. */
unsigned hash;
- /* The charset for which this face was realized if it was realized
- for use in multibyte text. If fontset >= 0, this is the charset
- of the first character of the composition sequence. A value of
- charset < 0 means the face was realized for use in unibyte text
- where the idea of Emacs charsets isn't applicable. */
- int charset;
-
/* Non-zero if text in this face should be underlined, overlined,
strike-through or have a box drawn around it. */
unsigned underline_p : 1;
/* Next and previous face in hash collision list of face cache. */
struct face *next, *prev;
- /* If this face is for ASCII characters, this points this face
- itself. Otherwise, this points a face for ASCII characters. */
+ /* If this face is an ASCII face, this points to this face itself.
+ Otherwise, this points to an ASCII face that has the same
+ attributes except the font. */
struct face *ascii_face;
};
/* Non-zero if FACE is suitable for displaying character CHAR. */
#define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) \
- (SINGLE_BYTE_CHAR_P (CHAR) \
+ (ASCII_CHAR_P (CHAR) \
? (FACE) == (FACE)->ascii_face \
: face_suitable_for_char_p ((FACE), (CHAR)))
with id ID but is suitable for displaying character CHAR.
This macro is only meaningful for multibyte character CHAR. */
-#define FACE_FOR_CHAR(F, FACE, CHAR) \
- (SINGLE_BYTE_CHAR_P (CHAR) \
- ? (FACE)->ascii_face->id \
- : face_for_char ((F), (FACE), (CHAR)))
+#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \
+ (ASCII_CHAR_P (CHAR) \
+ ? (FACE)->ascii_face->id \
+ : face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT)))
#else /* not HAVE_WINDOW_SYSTEM */
#define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) 1
-#define FACE_FOR_CHAR(F, FACE, CHAR) ((FACE)->id)
+#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) ((FACE)->id)
#endif /* not HAVE_WINDOW_SYSTEM */
enum prop_idx
{
+ AUTO_COMPOSED_PROP_IDX,
FONTIFIED_PROP_IDX,
FACE_PROP_IDX,
INVISIBLE_PROP_IDX,
the two-byte form of C. Encoding is returned in *CHAR2B. If
TWO_BYTE_P is non-null, return non-zero there if font is two-byte. */
int (*encode_char) P_ ((int c, XChar2b *char2b,
- struct font_info *font_into, int *two_byte_p));
+ struct font_info *font_into,
+ struct charset *charset,
+ int *two_byte_p));
/* Compute left and right overhang of glyph string S.
A NULL pointer if platform does not support this. */
void w32_init_fringe P_ ((void));
void w32_reset_fringes P_ ((void));
#endif
+ #ifdef MAC_OS
+ void mac_init_fringe P_ ((void));
+ #endif
/* Defined in image.c */
unsigned long load_color P_ ((struct frame *, struct face *, Lisp_Object,
enum lface_attribute_index));
void unload_color P_ ((struct frame *, unsigned long));
-int face_font_available_p P_ ((struct frame *, Lisp_Object));
+char *choose_face_font P_ ((struct frame *, Lisp_Object *, Lisp_Object,
+ int *));
int ascii_face_of_lisp_face P_ ((struct frame *, int));
void prepare_face_for_display P_ ((struct frame *, struct face *));
int xstricmp P_ ((const unsigned char *, const unsigned char *));
-int lookup_face P_ ((struct frame *, Lisp_Object *, int, struct face *));
-int lookup_named_face P_ ((struct frame *, Lisp_Object, int, int));
+int lookup_face P_ ((struct frame *, Lisp_Object *));
+int lookup_non_ascii_face P_ ((struct frame *, int, struct face *));
+int lookup_named_face P_ ((struct frame *, Lisp_Object, int));
int smaller_face P_ ((struct frame *, int, int));
int face_with_height P_ ((struct frame *, int, int));
-int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int, int));
+int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int));
void init_frame_faces P_ ((struct frame *));
void free_frame_faces P_ ((struct frame *));
void recompute_basic_faces P_ ((struct frame *));
int merge_faces P_ ((struct frame *, Lisp_Object, int, int));
int compute_char_face P_ ((struct frame *, int, Lisp_Object));
void free_all_realized_faces P_ ((Lisp_Object));
+void free_realized_face P_ ((struct frame *, struct face *));
extern Lisp_Object Qforeground_color, Qbackground_color;
extern Lisp_Object Qframe_set_background_mode;
extern char unspecified_fg[], unspecified_bg[];
-void free_realized_multibyte_face P_ ((struct frame *, int));
+extern Lisp_Object split_font_name_into_vector P_ ((Lisp_Object));
+extern Lisp_Object build_font_name_from_vector P_ ((Lisp_Object));
/* Defined in xfns.c */
#include "buffer.h"
#include "window.h"
+ #ifdef HAVE_X_WINDOWS
+ #include "xterm.h"
+ #endif
+
#include "systty.h"
#include "blockinput.h"
#include "syssignal.h"
init_alloc_once ();
init_obarray ();
init_eval_once ();
+ init_character_once ();
init_charset_once ();
init_coding_once ();
init_syntax_once (); /* Create standard syntax table. */
Lisp_Object buffer;
buffer = Fcdr (XCAR (tail));
- /* Verify that all buffers are empty now, as they
- ought to be. */
- if (BUF_Z (XBUFFER (buffer)) > BUF_BEG (XBUFFER (buffer)))
- abort ();
- /* It is safe to do this crudely in an empty buffer. */
- XBUFFER (buffer)->enable_multibyte_characters = Qnil;
+ /* Make a multibyte buffer unibyte. */
+ if (BUF_Z_BYTE (XBUFFER (buffer)) > BUF_Z (XBUFFER (buffer)))
+ {
+ struct buffer *current = current_buffer;
+
+ set_buffer_temp (XBUFFER (buffer));
+ Fset_buffer_multibyte (Qnil);
+ set_buffer_temp (current);
+ }
}
}
}
/* Don't actually discard this arg. */
skip_args = count_before;
+
+ /* Do not be lenient if the user explicitly asked for a named display. */
+ if (display_arg != 1 && !x_display_ok (displayname))
+ {
+ fprintf (stderr, "Display %s unavailable, simulating -nw\n",
+ displayname);
+ inhibit_window_system = 1;
+ }
}
#endif
syms_of_data ();
#endif
syms_of_alloc ();
+ syms_of_chartab ();
syms_of_lread ();
syms_of_print ();
syms_of_eval ();
/* Called before init_window_once for Mac OS Classic. */
syms_of_ccl ();
#endif
+ syms_of_character ();
syms_of_charset ();
syms_of_cmds ();
#ifndef NO_DIR_LIBRARY
#endif /* HAVE_NTGUI */
}
+ init_charset ();
+
if (!noninteractive)
{
#ifdef VMS
Lisp_Object face;
if ((face = fringe_faces[which], NILP (face))
- || (face_id = lookup_derived_face (f, face, 'A', FRINGE_FACE_ID, 0),
+ || (face_id = lookup_derived_face (f, face, FRINGE_FACE_ID, 0),
face_id < 0))
face_id = FRINGE_FACE_ID;
}
if (!NILP (face))
{
face_id = lookup_derived_face (SELECTED_FRAME (), face,
- 'A', FRINGE_FACE_ID, 1);
+ FRINGE_FACE_ID, 1);
if (face_id < 0)
error ("No such face");
}
}
}
- #ifdef HAVE_NTGUI
+ #if defined (HAVE_NTGUI) || defined (MAC_OS)
void
+ #ifdef HAVE_NTGUI
w32_init_fringe ()
+ #else /* MAC_OS */
+ mac_init_fringe ()
+ #endif
{
int bt;
rif->define_fringe_bitmap (bt, fb->bits, fb->height, fb->width);
}
}
+ #endif
+ #ifdef HAVE_NTGUI
void
w32_reset_fringes ()
{
#include "intervals.h"
#include "atimer.h"
#include "keymap.h"
+#include "character.h"
+#include "ccl.h"
\f
#if USE_CG_DRAWING
#define FRAME_CG_CONTEXT(f) ((f)->output_data.mac->cg_context)
+ /* Fringe bitmaps. */
+
+ static int max_fringe_bmp = 0;
+ static CGImageRef *fringe_bmp = 0;
+
static CGContextRef
mac_begin_cg_clip (f, gc)
struct frame *f;
/* Mac replacement for XCopyArea. */
+ #if USE_CG_DRAWING
+ static void
+ mac_draw_cg_image (image, f, gc, src_x, src_y, width, height,
+ dest_x, dest_y, overlay_p)
+ CGImageRef image;
+ struct frame *f;
+ GC gc;
+ int src_x, src_y;
+ unsigned int width, height;
+ int dest_x, dest_y, overlay_p;
+ {
+ CGContextRef context;
+ float port_height = FRAME_PIXEL_HEIGHT (f);
+ CGRect dest_rect = CGRectMake (dest_x, dest_y, width, height);
+
+ context = mac_begin_cg_clip (f, gc);
+ if (!overlay_p)
+ {
+ CG_SET_FILL_COLOR (context, gc->xgcv.background);
+ CGContextFillRect (context, dest_rect);
+ }
+ CGContextClipToRect (context, dest_rect);
+ CGContextScaleCTM (context, 1, -1);
+ CGContextTranslateCTM (context, 0, -port_height);
+ if (CGImageIsMask (image))
+ CG_SET_FILL_COLOR (context, gc->xgcv.foreground);
+ CGContextDrawImage (context,
+ CGRectMake (dest_x - src_x,
+ port_height - (dest_y - src_y
+ + CGImageGetHeight (image)),
+ CGImageGetWidth (image),
+ CGImageGetHeight (image)),
+ image);
+ mac_end_cg_clip (f);
+ }
+
+ #else /* !USE_CG_DRAWING */
+
static void
mac_draw_bitmap (f, gc, x, y, width, height, bits, overlay_p)
struct frame *f;
bitmap.baseAddr = (char *)bits;
SetRect (&(bitmap.bounds), 0, 0, width, height);
- #if USE_CG_DRAWING
- mac_prepare_for_quickdraw (f);
- #endif
SetPortWindowPort (FRAME_MAC_WINDOW (f));
RGBForeColor (GC_FORE_COLOR (gc));
RGBBackColor (GC_BACK_COLOR (FRAME_NORMAL_GC (f)));
}
+ #endif /* !USE_CG_DRAWING */
/* Mac replacement for XCreateBitmapFromBitmapData. */
SetPortWindowPort (w);
SetRect (&r, 0, 0, width, height);
- err = NewGWorld (&pixmap, depth, &r, NULL, NULL, 0);
+ #if !defined (WORDS_BIG_ENDIAN) && USE_CG_DRAWING
+ if (depth == 1)
+ #endif
+ err = NewGWorld (&pixmap, depth, &r, NULL, NULL, 0);
+ #if !defined (WORDS_BIG_ENDIAN) && USE_CG_DRAWING
+ else
+ /* CreateCGImageFromPixMaps requires ARGB format. */
+ err = QTNewGWorld (&pixmap, k32ARGBPixelFormat, &r, NULL, NULL, 0);
+ #endif
if (err != noErr)
return NULL;
return pixmap;
#endif
+ #if !USE_CG_DRAWING
/* Mac replacement for XCopyArea: dest must be window. */
static void
{
Rect src_r, dest_r;
- #if USE_CG_DRAWING
- mac_prepare_for_quickdraw (f);
- #endif
SetPortWindowPort (FRAME_MAC_WINDOW (f));
SetRect (&src_r, src_x, src_y, src_x + width, src_y + height);
{
Rect src_r, dest_r;
- #if USE_CG_DRAWING
- mac_prepare_for_quickdraw (f);
- #endif
SetPortWindowPort (FRAME_MAC_WINDOW (f));
SetRect (&src_r, src_x, src_y, src_x + width, src_y + height);
RGBBackColor (GC_BACK_COLOR (FRAME_NORMAL_GC (f)));
}
+ #endif /* !USE_CG_DRAWING */
/* Mac replacement for XCopyArea: used only for scrolling. */
#endif
}
- if (p->which)
+ if (p->which
+ #if USE_CG_DRAWING
+ && p->which < max_fringe_bmp
+ #endif
+ )
{
- unsigned short *bits = p->bits + p->dh;
XGCValues gcv;
XGetGCValues (display, face->gc, GCForeground, &gcv);
? (p->overlay_p ? face->background
: f->output_data.mac->cursor_pixel)
: face->foreground));
+ #if USE_CG_DRAWING
+ mac_draw_cg_image (fringe_bmp[p->which], f, face->gc, 0, p->dh,
+ p->wd, p->h, p->x, p->y, p->overlay_p);
+ #else
mac_draw_bitmap (f, face->gc, p->x, p->y,
- p->wd, p->h, bits, p->overlay_p);
+ p->wd, p->h, p->bits + p->dh, p->overlay_p);
+ #endif
XSetForeground (display, face->gc, gcv.foreground);
}
mac_reset_clip_rectangles (display, face->gc);
}
+ #if USE_CG_DRAWING
+ static void
+ mac_define_fringe_bitmap (which, bits, h, wd)
+ int which;
+ unsigned short *bits;
+ int h, wd;
+ {
+ unsigned short *mask_bits;
+ int i;
+ CGDataProviderRef provider;
+
+ if (which >= max_fringe_bmp)
+ {
+ i = max_fringe_bmp;
+ max_fringe_bmp = which + 20;
+ fringe_bmp = (CGImageRef *) xrealloc (fringe_bmp, max_fringe_bmp * sizeof (CGImageRef));
+ while (i < max_fringe_bmp)
+ fringe_bmp[i++] = 0;
+ }
+
+ for (i = 0; i < h; i++)
+ bits[i] = ~bits[i];
+ provider = CGDataProviderCreateWithData (NULL, bits,
+ sizeof (unsigned short) * h, NULL);
+ if (provider)
+ {
+ fringe_bmp[which] = CGImageMaskCreate (wd, h, 1, 1,
+ sizeof (unsigned short),
+ provider, NULL, 0);
+ CGDataProviderRelease (provider);
+ }
+ }
+
+ static void
+ mac_destroy_fringe_bitmap (which)
+ int which;
+ {
+ if (which >= max_fringe_bmp)
+ return;
+
+ if (fringe_bmp[which])
+ CGImageRelease (fringe_bmp[which]);
+ fringe_bmp[which] = 0;
+ }
+ #endif
\f
/* This is called when starting Emacs and when restarting after
/* Function prototypes of this page. */
static XCharStruct *x_per_char_metric P_ ((XFontStruct *, XChar2b *));
-static int mac_encode_char P_ ((int, XChar2b *, struct font_info *, int *));
+static int mac_encode_char P_ ((int, XChar2b *, struct font_info *,
+ struct charset *, int *));
/* Get metrics of character CHAR2B in FONT. Value is null if CHAR2B
the two-byte form of C. Encoding is returned in *CHAR2B. */
static int
-mac_encode_char (c, char2b, font_info, two_byte_p)
+mac_encode_char (c, char2b, font_info, charset, two_byte_p)
int c;
XChar2b *char2b;
struct font_info *font_info;
+ struct charset *charset;
int *two_byte_p;
{
- int charset = CHAR_CHARSET (c);
XFontStruct *font = font_info->font;
/* FONT_INFO may define a scheme by which to encode byte1 and byte2.
check_ccl_update (ccl);
if (CHARSET_DIMENSION (charset) == 1)
{
- ccl->reg[0] = charset;
- ccl->reg[1] = char2b->byte2;
+ ccl->reg[0] = CHARSET_ID (charset);
+ ccl->reg[1] = XCHAR2B_BYTE2 (char2b);
ccl->reg[2] = -1;
}
else
{
- ccl->reg[0] = charset;
- ccl->reg[1] = char2b->byte1;
- ccl->reg[2] = char2b->byte2;
+ ccl->reg[0] = CHARSET_ID (charset);
+ ccl->reg[1] = XCHAR2B_BYTE1 (char2b);
+ ccl->reg[2] = XCHAR2B_BYTE2 (char2b);
}
- ccl_driver (ccl, NULL, NULL, 0, 0, NULL);
+ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
if (font->max_byte1 == 0) /* 1-byte font */
- char2b->byte1 = 0, char2b->byte2 = ccl->reg[1];
+ STORE_XCHAR2B (char2b, 0, ccl->reg[1]);
else
- char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2];
+ STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
- else if (font_info->encoding[charset])
+ else if (font_info->encoding_type)
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
- int enc = font_info->encoding[charset];
+ unsigned char enc = font_info->encoding_type;
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
char2b->byte2 |= 0x80;
if (enc == 4)
- {
- int sjis1, sjis2;
+ {
+ int code = (char2b->byte1 << 8) | char2b->byte2;
- ENCODE_SJIS (char2b->byte1, char2b->byte2, sjis1, sjis2);
- char2b->byte1 = sjis1;
- char2b->byte2 = sjis2;
- }
+ JIS_TO_SJIS (code);
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ }
}
if (two_byte_p)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
if (s->first_glyph->type == CHAR_GLYPH)
- face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
+ face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
s->face = FACE_FROM_ID (s->f, face_id);
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
{
x_set_glyph_string_clipping (s);
+ #if USE_CG_DRAWING
+ mac_draw_cg_image (s->img->data.ptr_val,
+ s->f, s->gc, s->slice.x, s->slice.y,
+ s->slice.width, s->slice.height, x, y, 1);
+ #endif
if (s->img->mask)
+ #if !USE_CG_DRAWING
mac_copy_area_with_mask (s->img->pixmap, s->img->mask,
s->f, s->gc, s->slice.x, s->slice.y,
s->slice.width, s->slice.height, x, y);
+ #else
+ ;
+ #endif
else
{
+ #if !USE_CG_DRAWING
mac_copy_area (s->img->pixmap,
s->f, s->gc, s->slice.x, s->slice.y,
s->slice.width, s->slice.height, x, y);
+ #endif
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
+ if (FRAME_FONT (f) == (XFontStruct *) (fontp->font))
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return build_string (fontp->full_name);
+
FRAME_FONT (f) = (XFontStruct *) (fontp->font);
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
return build_string (fontp->full_name);
}
+\f
+/* Give frame F the fontset named FONTSETNAME as its default fontset,
+ and return the full name of that fontset. FONTSETNAME may be a
+ wildcard pattern; in that case, we choose some fontset that fits
+ the pattern. FONTSETNAME may be a font name for ASCII characters;
+ in that case, we create a fontset from that font name.
-/* Give frame F the fontset named FONTSETNAME as its default font, and
- return the full name of that fontset. FONTSETNAME may be a wildcard
- pattern; in that case, we choose some fontset that fits the pattern.
- The return value shows which fontset we chose. */
+ The return value shows which fontset we chose.
+ If FONTSETNAME specifies the default fontset, return Qt.
+ If an ASCII font in the specified fontset can't be loaded, return
+ Qnil. */
Lisp_Object
x_new_fontset (f, fontsetname)
struct frame *f;
- char *fontsetname;
+ Lisp_Object fontsetname;
{
- int fontset = fs_query_fontset (build_string (fontsetname), 0);
+ int fontset = fs_query_fontset (fontsetname, 0);
Lisp_Object result;
- if (fontset < 0)
- return Qnil;
-
- if (FRAME_FONTSET (f) == fontset)
+ if (fontset > 0 && FRAME_FONTSET(f) == fontset)
/* This fontset is already set in frame F. There's nothing more
to do. */
return fontset_name (fontset);
+ else if (fontset == 0)
+ /* The default fontset can't be the default font. */
+ return Qt;
- result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ if (fontset > 0)
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
+ result = x_new_font (f, SDATA (fontsetname));
if (!STRINGP (result))
/* Can't load ASCII font. */
return Qnil;
+ if (fontset < 0)
+ fontset = new_fontset_from_font_name (result);
+
/* Since x_new_font doesn't update any fontset information, do it now. */
FRAME_FONTSET (f) = fontset;
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
\f
coding.src_multibyte = 0;
coding.dst_multibyte = 1;
coding.mode |= CODING_MODE_LAST_BLOCK;
- coding.composing = COMPOSITION_DISABLED;
- buf = (char *) alloca (size);
+ coding.dst_bytes = size;
+ coding.destination = (unsigned char *) alloca (coding.dst_bytes);
- decode_coding (&coding, name, buf, strlen (name), size - 1);
- bcopy (buf, name, coding.produced);
- name[coding.produced] = '\0';
+ decode_coding_c_string (&coding, name, strlen (name), Qnil);
+ bcopy (coding.destination, name, min (coding.produced, size));
+ name[min (coding.produced, size)] = '\0';
}
}
bzero (fontp, sizeof (*fontp));
fontp->font = font;
fontp->font_idx = i;
+ fontp->charset = -1; /* fs_load_font sets it. */
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
fontp->height = max_height;
}
+ /* MAC_TODO: The script encoding is irrelevant in unicode? */
/* The slot `encoding' specifies how to map a character
code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
if (font->mac_scriptcode == smJapanese)
- fontp->encoding[1] = 4;
+ fontp->encoding_type = 4;
else
{
- fontp->encoding[1]
+ fontp->encoding_type
= (font->max_byte1 == 0
/* 1-byte font */
? (font->min_char_or_byte2 < 0x80
x_get_glyph_overhangs,
x_fix_overlapping_area,
x_draw_fringe_bitmap,
+ #if USE_CG_DRAWING
+ mac_define_fringe_bitmap,
+ mac_destroy_fringe_bitmap,
+ #else
0, /* define_fringe_bitmap */
0, /* destroy_fringe_bitmap */
+ #endif
mac_per_char_metric,
mac_encode_char,
mac_compute_glyph_string_overhangs,
MakeMeTheFrontProcess ();
#endif
#endif
+
+ #if USE_CG_DRAWING
+ mac_init_fringe ();
+ #endif
+
UNBLOCK_INPUT;
}
#include <errno.h>
#include "lisp.h"
-#include "charset.h"
-#include "dispextern.h"
#include "w32term.h"
-#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
-#include "fontset.h"
#include "intervals.h"
+#include "dispextern.h"
+#include "keyboard.h"
#include "blockinput.h"
#include "epaths.h"
-#include "w32heap.h"
-#include "termhooks.h"
+#include "character.h"
+#include "charset.h"
#include "coding.h"
#include "ccl.h"
+#include "fontset.h"
#include "systime.h"
+#include "termhooks.h"
+#include "w32heap.h"
#include "bitmaps/gray.xbm"
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
fontp->average_width = font->tm.tmAveCharWidth;
}
+
+ fontp->charset = -1;
charset = xlfd_charset_of_font (fontname);
/* Cache the W32 codepage for a font. This makes w32_encode_char
(0:0x20..0x7F, 1:0xA0..0xFF,
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
type FONT_ENCODING_NOT_DECIDED. */
encoding = strrchr (fontp->name, '-');
if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
- fontp->encoding[1] = 4;
+ fontp->encoding_type = 4;
else
- fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
+ fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
/* The following three values are set to 0 under W32, which is
what they get set to if XGetFontProperty fails under X. */
if (strncmp (lpcs, "*-#", 3) == 0)
return atoi (lpcs + 3);
+ /* All Windows fonts qualify as unicode. */
+ if (!strncmp (lpcs, "iso10646", 8))
+ return DEFAULT_CHARSET;
+
/* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
charset = alloca (len + 1);
strcpy (charset, lpcs);
lpcs = strchr (charset, '*');
if (lpcs)
- *lpcs = 0;
+ *lpcs = '\0';
/* Look through w32-charset-info-alist for the character set.
Format of each entry is
static char *
-w32_to_x_charset (fncharset)
+w32_to_x_charset (fncharset, matching)
int fncharset;
+ char *matching;
{
static char buf[32];
Lisp_Object charset_type;
+ int match_len = 0;
+
+ if (matching)
+ {
+ /* If fully specified, accept it as it is. Otherwise use a
+ substring match. */
+ char *wildcard = strchr (matching, '*');
+ if (wildcard)
+ *wildcard = '\0';
+ else if (strchr (matching, '-'))
+ return matching;
+
+ match_len = strlen (matching);
+ }
switch (fncharset)
{
{
Lisp_Object rest;
char * best_match = NULL;
+ int matching_found = 0;
/* Look through w32-charset-info-alist for the character set.
Prefer ISO codepages, and prefer lower numbers in the ISO
/* If we don't have a match already, then this is the
best. */
if (!best_match)
- best_match = x_charset;
- /* If this is an ISO codepage, and the best so far isn't,
- then this is better. */
- else if (strnicmp (best_match, "iso", 3) != 0
- && strnicmp (x_charset, "iso", 3) == 0)
- best_match = x_charset;
+ {
+ best_match = x_charset;
+ if (matching && !strnicmp (x_charset, matching, match_len))
+ matching_found = 1;
+ }
+ /* If we already found a match for MATCHING, then
+ only consider other matches. */
+ else if (matching_found
+ && strnicmp (x_charset, matching, match_len))
+ continue;
+ /* If this matches what we want, and the best so far doesn't,
+ then this is better. */
+ else if (!matching_found && matching
+ && !strnicmp (x_charset, matching, match_len))
+ {
+ best_match = x_charset;
+ matching_found = 1;
+ }
+ /* If this is fully specified, and the best so far isn't,
+ then this is better. */
+ else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
+ /* If this is an ISO codepage, and the best so far isn't,
+ then this is better, but only if it fully specifies the
+ encoding. */
+ || (strnicmp (best_match, "iso", 3) != 0
+ && strnicmp (x_charset, "iso", 3) == 0
+ && strchr (x_charset, '-')))
+ best_match = x_charset;
/* If both are ISO8859 codepages, choose the one with the
lowest number in the encoding field. */
else if (strnicmp (best_match, "iso8859-", 8) == 0
return buf;
}
- strncpy(buf, best_match, 31);
+ strncpy (buf, best_match, 31);
+ /* If the charset is not fully specified, put -0 on the end. */
+ if (!strchr (best_match, '-'))
+ {
+ int pos = strlen (best_match);
+ /* Charset specifiers shouldn't be very long. If it is a made
+ up one, truncating it should not do any harm since it isn't
+ recognized anyway. */
+ if (pos > 29)
+ pos = 29;
+ strcpy (buf + pos, "-0");
+ }
buf[31] = '\0';
return buf;
}
{
Lisp_Object rest;
/* Look through w32-charset-info-alist for the character set.
- Only return charsets for codepages which are installed.
+ Only return fully specified charsets for codepages which are
+ installed.
Format of each entry in Vw32_charset_info_alist is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
w32_charset = XCAR (XCDR (this_entry));
codepage = XCDR (XCDR (this_entry));
+ if (!strchr (SDATA (x_charset), '-'))
+ continue;
+
/* Look for Same charset and a valid codepage (or non-int
which means ignore). */
if (EQ (w32_charset, charset_type)
Lisp_Object codepage, entry;
char *charset_str, *charset, *end;
- if (NILP (Vw32_charset_info_alist))
- return CP_DEFAULT;
-
/* Extract charset part of font string. */
charset = xlfd_charset_of_font (fontname);
*end = '\0';
}
+ if (!strcmp (charset, "iso10646"))
+ return CP_UNICODE;
+
+ if (NILP (Vw32_charset_info_alist))
+ return CP_DEFAULT;
+
entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
if (NILP (entry))
return CP_UNKNOWN;
char *fontname_dash;
int display_resy = (int) one_w32_display_info.resy;
int display_resx = (int) one_w32_display_info.resx;
- int bufsz;
struct coding_system coding;
if (!lpxstr) abort ();
coding.mode |= CODING_MODE_LAST_BLOCK;
/* We explicitely disable composition handling because selection
data should not contain any composition sequence. */
- coding.composing = COMPOSITION_DISABLED;
- bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+ coding.dst_bytes = LF_FACESIZE * 2;
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
+ decode_coding_c_string (&coding, lplogfont->lfFaceName,
+ strlen(lplogfont->lfFaceName), Qnil);
+ fontname = coding.destination;
- fontname = alloca(sizeof(*fontname) * bufsz);
- decode_coding (&coding, lplogfont->lfFaceName, fontname,
- strlen(lplogfont->lfFaceName), bufsz - 1);
*(fontname + coding.produced) = '\0';
/* Replace dashes with underscores so the dashes are not
((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
? 'p' : 'c', /* spacing */
width_pixels, /* avg width */
- specific_charset ? specific_charset
- : w32_to_x_charset (lplogfont->lfCharSet)
+ w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
/* charset registry and encoding */
);
if (fields > 0 && name[0] != '*')
{
- int bufsize;
- unsigned char *buf;
-
+ Lisp_Object string = build_string (name);
setup_coding_system
(Fcheck_coding_system (Vlocale_coding_system), &coding);
- coding.src_multibyte = 1;
- coding.dst_multibyte = 0;
- /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
- encode_coding_iso2022 trying to dereference a null pointer. */
- coding.composing = COMPOSITION_DISABLED;
- if (coding.type == coding_type_iso2022)
- coding.flags |= CODING_FLAG_ISO_SAFE;
- bufsize = encoding_buffer_size (&coding, strlen (name));
- buf = (unsigned char *) alloca (bufsize);
- coding.mode |= CODING_MODE_LAST_BLOCK;
- encode_coding (&coding, name, buf, strlen (name), bufsize);
+ coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
+ /* Disable composition/charset annotation. */
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+ coding.dst_bytes = SCHARS (string) * 2;
+
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ encode_coding_object (&coding, string, 0, 0,
+ SCHARS (string), SBYTES (string), Qnil);
if (coding.produced >= LF_FACESIZE)
coding.produced = LF_FACESIZE - 1;
- buf[coding.produced] = 0;
- strcpy (lplogfont->lfFaceName, buf);
+
+ coding.destination[coding.produced] = '\0';
+
+ strcpy (lplogfont->lfFaceName, coding.destination);
+ xfree (coding.destination);
}
else
{
if (charset
&& strncmp (charset, "*-*", 3) != 0
&& lpef->logfont.lfCharSet == DEFAULT_CHARSET
- && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0)
+ && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
return 1;
}
if (charset)
charset_list = Fcons (build_string (charset), Qnil);
else
- charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
+ /* Always prefer unicode. */
+ charset_list
+ = Fcons (build_string ("iso10646-1"),
+ w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
/* Loop through the charsets. */
for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
Lisp_Object this_charset = Fcar (charset_list);
charset = SDATA (this_charset);
+ enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
+ charset, width);
+
/* List bold and italic variations if w32-enable-synthesized-fonts
is non-nil and this is a plain font. */
if (w32_enable_synthesized_fonts
&& lplf->elfLogFont.lfWeight == FW_NORMAL
&& lplf->elfLogFont.lfItalic == FALSE)
{
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
/* bold. */
lplf->elfLogFont.lfWeight = FW_BOLD;
enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
charset, width);
}
- else
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
}
}
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
***********************************************************************/
DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
- doc: /* Select a font using the W32 font dialog.
- Returns an X font string corresponding to the selection. */)
+ doc: /* Select a font for the named FRAME using the W32 font dialog.
+ Returns an X-style font string corresponding to the selection.
+
+ If FRAME is omitted or nil, it defaults to the selected frame.
+ If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
+ in the font selection dialog. */)
(frame, include_proportional)
Lisp_Object frame, include_proportional;
{
find_ccl_program_func = w32_find_ccl_program;
query_font_func = w32_query_font;
set_frame_fontset_func = x_set_font;
+ get_font_repertory_func = x_get_font_repertory;
check_window_system_func = check_w32;
#include "termchar.h"
#include "dispextern.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "indent.h"
#include "commands.h"
static enum prop_handled handle_composition_prop P_ ((struct it *));
static enum prop_handled handle_overlay_change P_ ((struct it *));
static enum prop_handled handle_fontified_prop P_ ((struct it *));
+static enum prop_handled handle_auto_composed_prop P_ ((struct it *));
/* Properties handled by iterators. */
static struct props it_props[] =
{
+ {&Qauto_composed, AUTO_COMPOSED_PROP_IDX, handle_auto_composed_prop},
{&Qfontified, FONTIFIED_PROP_IDX, handle_fontified_prop},
/* Handle `face' before `display' because some sub-properties of
`display' need to know the face. */
struct face *face = FACE_FROM_ID (it->f, face_id);
c = string_char_and_length (p, rest, &len);
- face_id = FACE_FOR_CHAR (it->f, face, c);
+ face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), it->string);
}
}
else
{
int c = FETCH_MULTIBYTE_CHAR (BYTEPOS (pos));
struct face *face = FACE_FROM_ID (it->f, face_id);
- face_id = FACE_FOR_CHAR (it->f, face, c);
+ face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), Qnil);
}
}
{
Lisp_Object face_name = XCAR (XCDR (XCDR (spec)));
int face_id2 = lookup_derived_face (it->f, face_name,
- 'A', FRINGE_FACE_ID, 0);
+ FRINGE_FACE_ID, 0);
if (face_id2 >= 0)
face_id = face_id2;
}
`composition' property
***********************************************************************/
+static enum prop_handled
+handle_auto_composed_prop (it)
+ struct it *it;
+{
+ enum prop_handled handled = HANDLED_NORMALLY;
+
+ if (FUNCTIONP (Vauto_composition_function))
+ {
+ Lisp_Object val;
+ EMACS_INT pos, this_pos;
+
+ if (STRINGP (it->string))
+ pos = IT_STRING_CHARPOS (*it);
+ else
+ pos = IT_CHARPOS (*it);
+ this_pos = pos;
+
+ val =Fget_char_property (make_number (pos), Qauto_composed, it->string);
+ if (! NILP (val))
+ {
+ Lisp_Object limit = Qnil, next;
+
+ /* As Fnext_single_char_property_change is very slow, we
+ limit the search to the current line. */
+ if (STRINGP (it->string))
+ limit = make_number (SCHARS (it->string));
+ else
+ limit = make_number (find_next_newline_no_quit (pos, 1));
+
+ next = (Fnext_single_property_change
+ (make_number (pos), Qauto_composed, it->string, limit));
+ if (XINT (next) < XINT (limit))
+ {
+ /* The current point is auto-composed, but there exist
+ characters not yet composed beyond the auto-composed
+ region. There's a possiblity that the last
+ characters in the region may be newly composed. */
+ int charpos = XINT (next) - 1, bytepos, c;
+
+ if (STRINGP (it->string))
+ {
+ bytepos = string_char_to_byte (it->string, charpos);
+ c = SDATA (it->string)[bytepos];
+ }
+ else
+ {
+ bytepos = CHAR_TO_BYTE (charpos);
+ c = FETCH_BYTE (bytepos);
+ }
+ if (c != '\n')
+ /* If the last character is not newline, it may be
+ composed with the following characters. */
+ val = Qnil, pos = charpos + 1;
+ }
+ }
+ if (NILP (val))
+ {
+ int count = SPECPDL_INDEX ();
+ Lisp_Object args[3];
+
+ args[0] = Vauto_composition_function;
+ specbind (Qauto_composition_function, Qnil);
+ args[1] = make_number (pos);
+ args[2] = it->string;
+ safe_call (3, args);
+ unbind_to (count, Qnil);
+
+ if (this_pos == pos)
+ {
+ val = Fget_char_property (args[1], Qauto_composed, it->string);
+ /* Return HANDLED_RECOMPUTE_PROPS only if function composed
+ something. This avoids an endless loop if they failed to
+ fontify the text for which reason ever. */
+ if (! NILP (val))
+ handled = HANDLED_RECOMPUTE_PROPS;
+ }
+ else
+ handled = HANDLED_RECOMPUTE_PROPS;
+ }
+ }
+
+ return handled;
+}
+
/* Set up iterator IT from `composition' property at its current
position. Called from handle_stop. */
struct it *it;
{
Lisp_Object prop, string;
- int pos, pos_byte, end;
+ EMACS_INT pos, pos_byte, start, end;
enum prop_handled handled = HANDLED_NORMALLY;
if (STRINGP (it->string))
/* If there's a valid composition and point is not inside of the
composition (in the case that the composition is from the current
buffer), draw a glyph composed from the composition components. */
- if (find_composition (pos, -1, &pos, &end, &prop, string)
- && COMPOSITION_VALID_P (pos, end, prop)
- && (STRINGP (it->string) || (PT <= pos || PT >= end)))
+ if (find_composition (pos, -1, &start, &end, &prop, string)
+ && COMPOSITION_VALID_P (start, end, prop)
+ && (STRINGP (it->string) || (PT <= start || PT >= end)))
{
- int id = get_composition_id (pos, pos_byte, end - pos, prop, string);
+ int id;
+
+ if (start != pos)
+ {
+ if (STRINGP (it->string))
+ pos_byte = string_char_to_byte (it->string, start);
+ else
+ pos_byte = CHAR_TO_BYTE (start);
+ }
+ id = get_composition_id (start, pos_byte, end - start, prop, string);
if (id >= 0)
{
the translation. This could easily be changed but I
don't believe that it is worth doing.
- If it->multibyte_p is nonzero, eight-bit characters and
- non-printable multibyte characters are also translated to
- octal form.
+ If it->multibyte_p is nonzero, non-printable non-ASCII
+ characters are also translated to octal form.
If it->multibyte_p is zero, eight-bit characters that
don't have corresponding multibyte char code are also
translated to octal form. */
else if ((it->c < ' '
- && (it->area != TEXT_AREA
- /* In mode line, treat \n like other crl chars. */
- || (it->c != '\t'
- && it->glyph_row && it->glyph_row->mode_line_p)
- || (it->c != '\n' && it->c != '\t')))
- || (it->multibyte_p
- ? ((it->c >= 127
- && it->len == 1)
- || !CHAR_PRINTABLE_P (it->c)
+ ? (it->area != TEXT_AREA
+ /* In mode line, treat \n, \t like other crl chars. */
+ || (it->c != '\t'
+ && it->glyph_row && it->glyph_row->mode_line_p)
+ || (it->c != '\n' && it->c != '\t'))
+ : (it->multibyte_p
+ ? (!CHAR_PRINTABLE_P (it->c)
|| (!NILP (Vnobreak_char_display)
- && (it->c == 0x8a0 || it->c == 0x8ad
- || it->c == 0x920 || it->c == 0x92d
- || it->c == 0xe20 || it->c == 0xe2d
- || it->c == 0xf20 || it->c == 0xf2d)))
+ && (it->c == 0xA0 /* NO-BREAK SPACE */
+ || it->c == 0xAD /* SOFT HYPHEN */)))
: (it->c >= 127
- && (!unibyte_display_via_language_environment
- || it->c == unibyte_char_to_multibyte (it->c)))))
+ && (! unibyte_display_via_language_environment
+ || (UNIBYTE_CHAR_HAS_MULTIBYTE_P (it->c)))))))
{
/* IT->c is a control character which must be displayed
either as '\003' or as `^C' where the '\\' and '^'
highlighting. */
if (EQ (Vnobreak_char_display, Qt)
- && (it->c == 0x8a0 || it->c == 0x920
- || it->c == 0xe20 || it->c == 0xf20))
+ && it->c == 0xA0)
{
/* Merge the no-break-space face into the current face. */
face_id = merge_faces (it->f, Qnobreak_space, 0,
highlighting. */
if (EQ (Vnobreak_char_display, Qt)
- && (it->c == 0x8ad || it->c == 0x92d
- || it->c == 0xe2d || it->c == 0xf2d))
+ && it->c == 0xAD)
{
g = it->c = '-';
XSETINT (it->ctl_chars[0], g);
/* Handle non-break space and soft hyphen
with the escape glyph. */
- if (it->c == 0x8a0 || it->c == 0x8ad
- || it->c == 0x920 || it->c == 0x92d
- || it->c == 0xe20 || it->c == 0xe2d
- || it->c == 0xf20 || it->c == 0xf2d)
+ if (it->c == 0xA0 || it->c == 0xAD)
{
XSETINT (it->ctl_chars[0], escape_glyph);
- g = it->c = ((it->c & 0xf) == 0 ? ' ' : '-');
+ g = it->c = (it->c == 0xA0 ? ' ' : '-');
XSETINT (it->ctl_chars[1], g);
ctl_len = 2;
goto display_control;
int i;
/* Set IT->ctl_chars[0] to the glyph for `\\'. */
- if (SINGLE_BYTE_CHAR_P (it->c))
- str[0] = it->c, len = 1;
+ if (CHAR_BYTE8_P (it->c))
+ {
+ str[0] = CHAR_TO_BYTE8 (it->c);
+ len = 1;
+ }
+ else if (it->c < 256)
+ {
+ str[0] = it->c;
+ len = 1;
+ }
else
{
- len = CHAR_STRING_NO_SIGNAL (it->c, str);
- if (len < 0)
- {
- /* It's an invalid character, which shouldn't
- happen actually, but due to bugs it may
- happen. Let's print the char as is, there's
- not much meaningful we can do with it. */
- str[0] = it->c;
- str[1] = it->c >> 8;
- str[2] = it->c >> 16;
- str[3] = it->c >> 24;
- len = 4;
- }
+ /* It's an invalid character, which shouldn't
+ happen actually, but due to bugs it may
+ happen. Let's print the char as is, there's
+ not much meaningful we can do with it. */
+ str[0] = it->c;
+ str[1] = it->c >> 8;
+ str[2] = it->c >> 16;
+ str[3] = it->c >> 24;
+ len = 4;
}
for (i = 0; i < len; i++)
&& FRAME_WINDOW_P (it->f))
{
struct face *face = FACE_FROM_ID (it->f, it->face_id);
- it->face_id = FACE_FOR_CHAR (it->f, face, it->c);
+ int pos = (it->s ? -1
+ : STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
+ : IT_CHARPOS (*it));
+
+ it->face_id = FACE_FOR_CHAR (it->f, face, it->c, pos, it->string);
}
}
the line. */
if (skip == MOVE_X_REACHED)
{
+ /* Wait! We can conclude that TO_Y is in the line if
+ the already scanned glyphs make the line tall enough
+ because further scanning doesn't make it shorter. */
+ line_height = it->max_ascent + it->max_descent;
+ if (to_y >= it->current_y
+ && to_y < it->current_y + line_height)
+ {
+ reached = 6;
+ break;
+ }
it_backup = *it;
TRACE_MOVE ((stderr, "move_it: from %d\n", IT_CHARPOS (*it)));
skip2 = move_it_in_display_line_to (it, to_charpos, -1,
for (i = 0; i < nbytes; i += char_bytes)
{
c = string_char_and_length (m + i, nbytes - i, &char_bytes);
- work[0] = (SINGLE_BYTE_CHAR_P (c)
+ work[0] = (ASCII_CHAR_P (c)
? c
: multibyte_char_to_unibyte (c, Qnil));
insert_1_both (work, 1, 1, 1, 0, 0);
for the *Message* buffer. */
for (i = 0; i < nbytes; i++)
{
- c = unibyte_char_to_multibyte (msg[i]);
+ c = msg[i];
+ c = unibyte_char_to_multibyte (c);
char_bytes = CHAR_STRING (c, str);
insert_1_both (str, 1, char_bytes, 1, 0, 0);
}
for (i = 0; i < nbytes; i += n)
{
c = string_char_and_length (s + i, nbytes - i, &n);
- work[0] = (SINGLE_BYTE_CHAR_P (c)
+ work[0] = (ASCII_CHAR_P (c)
? c
: multibyte_char_to_unibyte (c, Qnil));
insert_1_both (work, 1, 1, 1, 0, 0);
/* Convert a single-byte string to multibyte. */
for (i = 0; i < nbytes; i++)
{
- c = unibyte_char_to_multibyte (msg[i]);
+ c = msg[i];
+ c = unibyte_char_to_multibyte (c);
n = CHAR_STRING (c, str);
insert_1_both (str, 1, n, 1, 0, 0);
}
HEIGHT specifies the desired height of the tool-bar line.
If the actual height of the glyph row is less than HEIGHT, the
row's height is increased to HEIGHT, and the icons are centered
- vertically in the new height. */
+ vertically in the new height.
+
+ If HEIGHT is -1, we are counting needed tool-bar lines, so don't
+ count a final empty row in case the tool-bar width exactly matches
+ the window width.
+ */
static void
display_tool_bar_line (it, height)
/* Get the next display element. */
if (!get_next_display_element (it))
- break;
+ {
+ /* Don't count empty row if we are counting needed tool-bar lines. */
+ if (height < 0 && !it->hpos)
+ return;
+ break;
+ }
/* Produce glyphs. */
x_before = it->current_x;
{
it.glyph_row = w->desired_matrix->rows;
clear_glyph_row (it.glyph_row);
- display_tool_bar_line (&it, 0);
+ display_tool_bar_line (&it, -1);
}
+ /* f->n_tool_bar_rows == 0 means "unknown"; -1 means no tool-bar. */
if (n_rows)
- *n_rows = it.vpos;
+ *n_rows = it.vpos > 0 ? it.vpos : -1;
return (it.current_y + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
}
reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1);
if (f->n_tool_bar_rows == 0)
- {
- (void)tool_bar_lines_needed (f, &f->n_tool_bar_rows);
- if (f->n_tool_bar_rows == 0)
- f->n_tool_bar_rows = -1;
- }
+ (void)tool_bar_lines_needed (f, &f->n_tool_bar_rows);
/* Display as many lines as needed to display all tool-bar items. */
struct buffer *prev_buf, *buf;
int prev_pt, pt;
{
- int start, end;
+ EMACS_INT start, end;
Lisp_Object prop;
Lisp_Object buffer;
struct Lisp_Char_Table *dp;
int c;
{
- int code[4], i;
Lisp_Object val;
- if (SINGLE_BYTE_CHAR_P (c))
- return (dp->contents[c]);
-
- SPLIT_CHAR (c, code[0], code[1], code[2]);
- if (code[1] < 32)
- code[1] = -1;
- else if (code[2] < 32)
- code[2] = -1;
-
- /* Here, the possible range of code[0] (== charset ID) is
- 128..max_charset. Since the top level char table contains data
- for multibyte characters after 256th element, we must increment
- code[0] by 128 to get a correct index. */
- code[0] += 128;
- code[3] = -1; /* anchor */
-
- for (i = 0; code[i] >= 0; i++, dp = XCHAR_TABLE (val))
+ if (ASCII_CHAR_P (c))
{
- val = dp->contents[code[i]];
- if (!SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? dp->defalt : val);
+ val = dp->ascii;
+ if (SUB_CHAR_TABLE_P (val))
+ val = XSUB_CHAR_TABLE (val)->contents[c];
}
+ else
+ {
+ Lisp_Object table;
- /* Here, val is a sub char table. We return the default value of
- it. */
- return (dp->defalt);
+ XSETCHAR_TABLE (table, dp);
+ val = char_table_ref (table, c);
+ }
+ if (NILP (val))
+ val = dp->defalt;
+ return val;
}
x += glyph->pixel_width;
++glyph;
if (cursor_from_overlay_pos
- && last_pos >= cursor_from_overlay_pos)
+ && last_pos > cursor_from_overlay_pos)
{
cursor_from_overlay_pos = 0;
cursor = 0;
/* Skip all glyphs from string. */
do
{
- Lisp_Object cprop;
int pos;
if ((cursor == NULL || glyph > cursor)
- && (cprop = Fget_char_property (make_number ((glyph)->charpos),
- Qcursor, (glyph)->object),
- !NILP (cprop))
+ && !NILP (Fget_char_property (make_number ((glyph)->charpos),
+ Qcursor, (glyph)->object))
&& (pos = string_buffer_position (w, glyph->object,
string_before_pos),
(pos == 0 /* From overlay */
Add 1 to last_pos so that if point corresponds to the
glyph right after the overlay, we still use a 'cursor'
property found in that overlay. */
- cursor_from_overlay_pos = (pos ? 0 : last_pos
- + (INTEGERP (cprop) ? XINT (cprop) : 0));
+ cursor_from_overlay_pos = pos == 0 ? last_pos+1 : 0;
cursor = glyph;
cursor_x = x;
}
x += glyph->pixel_width;
++glyph;
}
- while (glyph < end && EQ (glyph->object, string_start->object));
+ while (glyph < end && STRINGP (glyph->object));
}
}
else if (it->face_before_selective_p)
it->face_id = it->saved_face_id;
face = FACE_FROM_ID (it->f, it->face_id);
- it->face_id = FACE_FOR_CHAR (it->f, face, 0);
+ it->face_id = FACE_FOR_CHAR (it->f, face, 0, -1, Qnil);
PRODUCE_GLYPHS (it);
face = FACE_FROM_ID (f, it->face_id);
if (FRAME_WINDOW_P (f)
+ && it->glyph_row->displays_text_p
&& face->box == FACE_NO_BOX
&& face->background == FRAME_BACKGROUND_PIXEL (f)
&& !face->stipple)
ASCII face. This will be automatically undone the next time
get_next_display_element returns a multibyte character. Note
that the character will always be single byte in unibyte text. */
- if (!SINGLE_BYTE_CHAR_P (it->c))
+ if (!ASCII_CHAR_P (it->c))
{
- it->face_id = FACE_FOR_CHAR (f, face, 0);
+ it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
}
if (FRAME_WINDOW_P (f))
&& glyph->u.ch == ' '))
&& trailing_whitespace_p (glyph->charpos))
{
- int face_id = lookup_named_face (f, Qtrailing_whitespace, 0, 0);
+ int face_id = lookup_named_face (f, Qtrailing_whitespace, 0);
if (face_id < 0)
return;
{
if (EQ (face, Qt))
face = (EQ (window, selected_window) ? Qmode_line : Qmode_line_inactive);
- face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0, 0);
+ face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0);
}
if (face_id < 0)
/* The EOL conversion we are using. */
Lisp_Object eoltype;
- val = Fget (coding_system, Qcoding_system);
+ val = CODING_SYSTEM_SPEC (coding_system);
eoltype = Qnil;
if (!VECTORP (val)) /* Not yet decided. */
}
else
{
+ Lisp_Object attrs;
Lisp_Object eolvalue;
- eolvalue = Fget (coding_system, Qeol_type);
+ attrs = AREF (val, 0);
+ eolvalue = AREF (val, 2);
if (multibyte)
- *buf++ = XFASTINT (AREF (val, 1));
+ *buf++ = XFASTINT (CODING_ATTR_MNEMONIC (attrs));
if (eol_flag)
{
eoltype = eol_mnemonic_undecided;
else if (VECTORP (eolvalue)) /* Not yet decided. */
eoltype = eol_mnemonic_undecided;
- else /* INTEGERP (eolvalue) -- 0:LF, 1:CRLF, 2:CR */
- eoltype = (XFASTINT (eolvalue) == 0
+ else /* eolvalue is Qunix, Qdos, or Qmac. */
+ eoltype = (EQ (eolvalue, Qunix)
? eol_mnemonic_unix
- : (XFASTINT (eolvalue) == 1
+ : (EQ (eolvalue, Qdos) == 1
? eol_mnemonic_dos : eol_mnemonic_mac));
}
}
eol_str = SDATA (eoltype);
eol_str_len = SBYTES (eoltype);
}
- else if (INTEGERP (eoltype)
- && CHAR_VALID_P (XINT (eoltype), 0))
+ else if (CHARACTERP (eoltype))
{
unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
eol_str_len = CHAR_STRING (XINT (eoltype), tmp);
{
/* No need to mention EOL here--the terminal never needs
to do EOL conversion. */
- p = decode_mode_spec_coding (keyboard_coding.symbol, p, 0);
- p = decode_mode_spec_coding (terminal_coding.symbol, p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME (keyboard_coding.id),
+ p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME (terminal_coding.id),
+ p, 0);
}
p = decode_mode_spec_coding (b->buffer_file_coding_system,
p, eol_flag);
}
break;
}
- else if (x + glyph->pixel_width > it->first_visible_x)
+ else if (x + glyph->pixel_width >= it->first_visible_x)
{
/* Glyph is at least partially visible. */
++it->hpos;
}
else
{
- int c1, c2, charset;
+ struct font_info *font_info
+ = FONT_INFO_FROM_ID (f, face->font_info_id);
+ if (font_info)
+ {
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ unsigned code = ENCODE_CHAR (charset, glyph->u.ch);
- /* Split characters into bytes. If c2 is -1 afterwards, C is
- really a one-byte character so that byte1 is zero. */
- SPLIT_CHAR (glyph->u.ch, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (char2b, c1, c2);
- else
- STORE_XCHAR2B (char2b, 0, c1);
+ if (CHARSET_DIMENSION (charset) == 1)
+ STORE_XCHAR2B (char2b, 0, code);
+ else
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
- /* Maybe encode the character in *CHAR2B. */
- if (charset != CHARSET_ASCII)
- {
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
- glyph->font_type
- = rif->encode_char (glyph->u.ch, char2b, font_info, two_byte_p);
+ /* Maybe encode the character in *CHAR2B. */
+ if (CHARSET_ID (charset) != charset_ascii)
+ {
+ glyph->font_type
+ = rif->encode_char (glyph->u.ch, char2b, font_info, charset,
+ two_byte_p);
+ }
}
}
s->for_overlaps = overlaps;
s->face = faces[s->gidx];
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+ if (s->face == NULL)
+ {
+ s->font = NULL;
+ s->font_info = NULL;
+ }
+ else
+ {
+ s->font = s->face->font;
+ s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+ }
/* For all glyphs of this composition, starting at the offset
S->gidx, until we reach the end of the definition or encounter a
glyph that requires the different face, add it to S. */
++s->nchars;
- for (i = s->gidx + 1; i < s->cmp->glyph_len && faces[i] == s->face; ++i)
+ for (i = s->gidx + 1;
+ i < s->cmp->glyph_len && (faces[i] == s->face || ! faces[i] || ! s->face);
+ ++i)
++s->nchars;
/* All glyph strings for the same composition has the same width,
/* Adjust base line for subscript/superscript text. */
s->ybase += s->first_glyph->voffset;
- xassert (s->face && s->face->gc);
-
/* This glyph string must always be drawn with 16-bit functions. */
s->two_byte_p = 1;
*left = -pcm->lbearing;
}
}
+ else if (glyph->type == COMPOSITE_GLYPH)
+ {
+ struct composition *cmp = composition_table[glyph->u.cmp_id];
+
+ *right = cmp->rbearing - cmp->pixel_width;
+ *left = - cmp->lbearing;
+ }
}
/* Unibyte case. We don't have to encode, but we have to make
sure to use a face suitable for unibyte. */
STORE_XCHAR2B (char2b, 0, c);
- face_id = FACE_FOR_CHAR (f, face, c);
+ face_id = FACE_FOR_CHAR (f, face, c, -1, Qnil);
face = FACE_FROM_ID (f, face_id);
}
else if (c < 128 && face_id < BASIC_FACE_ID_SENTINEL)
/* Case of ASCII in a face known to fit ASCII. */
STORE_XCHAR2B (char2b, 0, c);
}
- else
+ else if (face->font != NULL)
{
- int c1, c2, charset;
+ struct font_info *font_info
+ = FONT_INFO_FROM_ID (f, face->font_info_id);
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ unsigned code = ENCODE_CHAR (charset, c);
- /* Split characters into bytes. If c2 is -1 afterwards, C is
- really a one-byte character so that byte1 is zero. */
- SPLIT_CHAR (c, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (char2b, c1, c2);
+ if (CHARSET_DIMENSION (charset) == 1)
+ STORE_XCHAR2B (char2b, 0, code);
else
- STORE_XCHAR2B (char2b, 0, c1);
-
- /* Maybe encode the character in *CHAR2B. */
- if (face->font != NULL)
- {
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
- rif->encode_char (c, char2b, font_info, 0);
- }
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ /* Maybe encode the character in *CHAR2B. */
+ rif->encode_char (c, char2b, font_info, charset, NULL);
}
/* Make sure X resources of the face are allocated. */
#define BUILD_CHAR_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- int c, face_id; \
+ int face_id; \
XChar2b *char2b; \
\
- c = (row)->glyphs[area][START].u.ch; \
face_id = (row)->glyphs[area][START].face_id; \
\
s = (struct glyph_string *) alloca (sizeof *s); \
for (n = 0; n < glyph_len; n++) \
{ \
int c = COMPOSITION_GLYPH (cmp, n); \
- int this_face_id = FACE_FOR_CHAR (f, base_face, c); \
- faces[n] = FACE_FROM_ID (f, this_face_id); \
- get_char_face_and_encoding (f, c, this_face_id, \
+ \
+ if (c == '\t') \
+ faces[n] = NULL; \
+ else \
+ { \
+ int this_face_id = FACE_FOR_CHAR (f, base_face, c, -1, Qnil); \
+ faces[n] = FACE_FROM_ID (f, this_face_id); \
+ get_char_face_and_encoding (f, c, this_face_id, \
char2b + n, 1, 1); \
+ } \
} \
\
/* Make glyph_strings for each glyph sequence that is drawable by \
abort (); \
} \
\
- set_glyph_string_background_width (s, START, LAST_X); \
- (X) += s->width; \
+ if (s) \
+ { \
+ set_glyph_string_background_width (s, START, LAST_X); \
+ (X) += s->width; \
+ } \
} \
} \
while (0)
int x;
struct glyph_row *row;
enum glyph_row_area area;
- int start, end;
+ EMACS_INT start, end;
enum draw_glyphs_face hl;
int overlaps;
{
if (i >= 0)
{
clip_tail = tail;
+ i++; /* We must include the Ith glyph. */
BUILD_GLYPH_STRINGS (end, i, h, t,
DRAW_NORMAL_TEXT, x, last_x);
for (s = h; s; s = s->next)
struct face *face;
struct font_info *font_info;
- face_id = lookup_named_face (it->f, face_name, ' ', 0);
+ face_id = lookup_named_face (it->f, face_name, 0);
if (face_id < 0)
return make_number (-1);
/* Maybe translate single-byte characters to multibyte, or the
other way. */
it->char_to_display = it->c;
- if (!ASCII_BYTE_P (it->c))
+ if (!ASCII_BYTE_P (it->c)
+ && ! it->multibyte_p)
{
- if (unibyte_display_via_language_environment
- && SINGLE_BYTE_CHAR_P (it->c)
- && (it->c >= 0240
- || !NILP (Vnonascii_translation_table)))
+ if (SINGLE_BYTE_CHAR_P (it->c)
+ && unibyte_display_via_language_environment)
+ it->char_to_display = unibyte_char_to_multibyte (it->c);
+ if (! SINGLE_BYTE_CHAR_P (it->c))
{
- it->char_to_display = unibyte_char_to_multibyte (it->c);
it->multibyte_p = 1;
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
- face = FACE_FROM_ID (it->f, it->face_id);
- }
- else if (!SINGLE_BYTE_CHAR_P (it->c)
- && !it->multibyte_p)
- {
- it->multibyte_p = 1;
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
+ it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display,
+ -1, Qnil);
face = FACE_FROM_ID (it->f, it->face_id);
}
}
/* If we found a font, this font should give us the right
metrics. If we didn't find a font, use the frame's
- default font and calculate the width of the character
- from the charset width; this is what old redisplay code
- did. */
+ default font and calculate the width of the character by
+ multiplying the width of font by the width of the
+ character. */
pcm = rif->per_char_metric (font, &char2b,
FONT_TYPE_FOR_MULTIBYTE (font, it->c));
if (font_not_found_p || !pcm)
{
- int charset = CHAR_CHARSET (it->char_to_display);
-
it->glyph_not_available_p = 1;
it->pixel_width = (FRAME_COLUMN_WIDTH (it->f)
- * CHARSET_WIDTH (charset));
+ * CHAR_WIDTH (it->char_to_display));
it->phys_ascent = FONT_BASE (font) + boff;
it->phys_descent = FONT_DESCENT (font) - boff;
}
struct font_info *font_info;
int boff; /* baseline offset */
struct composition *cmp = composition_table[it->cmp_id];
+ int pos;
/* Maybe translate single-byte characters to multibyte. */
it->char_to_display = it->c;
if (unibyte_display_via_language_environment
- && SINGLE_BYTE_CHAR_P (it->c)
- && (it->c >= 0240
- || (it->c >= 0200
- && !NILP (Vnonascii_translation_table))))
+ && it->c >= 0200)
{
it->char_to_display = unibyte_char_to_multibyte (it->c);
}
/* Get face and font to use. Encode IT->char_to_display. */
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
+ pos = STRINGP (it->string) ? IT_STRING_CHARPOS (*it) : IT_CHARPOS (*it);
+ it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display,
+ pos, it->string);
face = FACE_FROM_ID (it->f, it->face_id);
get_char_face_and_encoding (it->f, it->char_to_display, it->face_id,
&char2b, it->multibyte_p, 0);
now. Theoretically, we have to check all fonts for the
glyphs, but that requires much time and memory space. So,
here we check only the font of the first glyph. This leads
- to incorrect display very rarely, and C-l (recenter) can
- correct the display anyway. */
- if (cmp->font != (void *) font)
+ to incorrect display, but it's very rare, and C-l (recenter)
+ can correct the display anyway. */
+ if (cmp->glyph_len == 0)
+ {
+ cmp->lbearing = cmp->rbearing = 0;
+ cmp->pixel_width = cmp->ascent = cmp->descent = 0;
+ }
+ else if (cmp->font != (void *) font)
{
/* Ascent and descent of the font of the first character of
this composition (adjusted by baseline offset). Ascent
them respectively. */
int font_ascent = FONT_BASE (font) + boff;
int font_descent = FONT_DESCENT (font) - boff;
+ int font_height = FONT_HEIGHT (font);
/* Bounding box of the overall glyphs. */
int leftmost, rightmost, lowest, highest;
+ int lbearing, rbearing;
int i, width, ascent, descent;
+ int fully_padded = 0;
cmp->font = (void *) font;
width = pcm->width;
ascent = pcm->ascent;
descent = pcm->descent;
+ lbearing = pcm->lbearing;
+ if (lbearing > 0)
+ lbearing = 0;
+ rbearing = pcm->rbearing;
+ if (rbearing < width)
+ rbearing = width;
}
else
{
width = FONT_WIDTH (font);
ascent = FONT_BASE (font);
descent = FONT_DESCENT (font);
+ lbearing = 0;
+ rbearing = width;
}
rightmost = width;
the left. */
cmp->offsets[0] = 0;
cmp->offsets[1] = boff;
+ cmp->lbearing = lbearing;
+ cmp->rbearing = rbearing;
/* Set cmp->offsets for the remaining glyphs. */
for (i = 1; i < cmp->glyph_len; i++)
{
int left, right, btm, top;
int ch = COMPOSITION_GLYPH (cmp, i);
- int face_id = FACE_FOR_CHAR (it->f, face, ch);
+ int face_id;
+
+ if (ch == '\t')
+ {
+ fully_padded = 1;
+ cmp->offsets[i * 2] = 0;
+ cmp->offsets[i * 2 + 1] = boff;
+ continue;
+ }
+ face_id = FACE_FOR_CHAR (it->f, face, ch, pos, it->string);
face = FACE_FROM_ID (it->f, face_id);
get_char_face_and_encoding (it->f, ch, face->id,
&char2b, it->multibyte_p, 0);
width = pcm->width;
ascent = pcm->ascent;
descent = pcm->descent;
+ lbearing = pcm->lbearing;
+ if (lbearing > 0)
+ lbearing = 0;
+ rbearing = pcm->rbearing;
+ if (rbearing < width)
+ rbearing = width;
}
else
{
width = FONT_WIDTH (font);
ascent = 1;
descent = 0;
+ lbearing = 0;
+ rbearing = width;
}
if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
6---7---8 -- descent
*/
int rule = COMPOSITION_RULE (cmp, i);
- int gref, nref, grefx, grefy, nrefx, nrefy;
+ int gref, nref, grefx, grefy, nrefx, nrefy, xoff, yoff;
- COMPOSITION_DECODE_RULE (rule, gref, nref);
+ COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
grefx = gref % 3, nrefx = nref % 3;
grefy = gref / 3, nrefy = nref / 3;
+ if (xoff)
+ xoff = font_height * (xoff - 128) / 256;
+ if (yoff)
+ yoff = font_height * (yoff - 128) / 256;
left = (leftmost
+ grefx * (rightmost - leftmost) / 2
- - nrefx * width / 2);
+ - nrefx * width / 2
+ + xoff);
+
btm = ((grefy == 0 ? highest
: grefy == 1 ? 0
: grefy == 2 ? lowest
- (nrefy == 0 ? ascent + descent
: nrefy == 1 ? descent - boff
: nrefy == 2 ? 0
- : (ascent + descent) / 2));
+ : (ascent + descent) / 2)
+ + yoff);
}
cmp->offsets[i * 2] = left;
cmp->offsets[i * 2 + 1] = btm + descent;
/* Update the bounding box of the overall glyphs. */
- right = left + width;
+ if (width > 0)
+ {
+ right = left + width;
+ if (left < leftmost)
+ leftmost = left;
+ if (right > rightmost)
+ rightmost = right;
+ }
top = btm + descent + ascent;
- if (left < leftmost)
- leftmost = left;
- if (right > rightmost)
- rightmost = right;
if (top > highest)
highest = top;
if (btm < lowest)
lowest = btm;
+
+ if (cmp->lbearing > left + lbearing)
+ cmp->lbearing = left + lbearing;
+ if (cmp->rbearing < left + rbearing)
+ cmp->rbearing = left + rbearing;
}
/* If there are glyphs whose x-offsets are negative,
for (i = 0; i < cmp->glyph_len; i++)
cmp->offsets[i * 2] -= leftmost;
rightmost -= leftmost;
+ cmp->lbearing -= leftmost;
+ cmp->rbearing -= leftmost;
+ }
+
+ if (fully_padded)
+ {
+ for (i = 0; i < cmp->glyph_len; i++)
+ cmp->offsets[i * 2] -= cmp->lbearing;
+ rightmost = cmp->rbearing - cmp->lbearing;
+ cmp->lbearing = 0;
+ cmp->rbearing = rightmost;
}
cmp->pixel_width = rightmost;
cmp->descent = font_descent;
}
+ if (it->glyph_row
+ && (cmp->lbearing < 0
+ || cmp->rbearing > cmp->pixel_width))
+ it->glyph_row->contains_overlapping_glyphs_p = 1;
+
it->pixel_width = cmp->pixel_width;
it->ascent = it->phys_ascent = cmp->ascent;
it->descent = it->phys_descent = cmp->descent;
int line_height, shift_by_width, shifted_region_width;
struct glyph_row *row;
struct glyph *glyph;
- int frame_x, frame_y, hpos;
+ int frame_x, frame_y;
+ EMACS_INT hpos;
xassert (updated_window && updated_row);
BLOCK_INPUT;
static int
fast_find_position (w, charpos, hpos, vpos, x, y, stop)
struct window *w;
- int charpos;
+ EMACS_INT charpos;
int *hpos, *vpos, *x, *y;
Lisp_Object stop;
{
static int
fast_find_position (w, pos, hpos, vpos, x, y, stop)
struct window *w;
- int pos;
+ EMACS_INT pos;
int *hpos, *vpos, *x, *y;
Lisp_Object stop;
{
static int
fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p)
struct window *w;
- int pos;
+ EMACS_INT pos;
Lisp_Object object;
int *hpos, *vpos, *x, *y;
int right_p;
/* #include <sys/param.h> */
#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "ccl.h"
#include "frame.h"
/* Function prototypes of this page. */
-static int x_encode_char P_ ((int, XChar2b *, struct font_info *, int *));
+static int x_encode_char P_ ((int, XChar2b *, struct font_info *,
+ struct charset *, int *));
/* Get metrics of character CHAR2B in FONT. Value is null if CHAR2B
the two-byte form of C. Encoding is returned in *CHAR2B. */
static int
-x_encode_char (c, char2b, font_info, two_byte_p)
+x_encode_char (c, char2b, font_info, charset, two_byte_p)
int c;
XChar2b *char2b;
struct font_info *font_info;
+ struct charset *charset;
int *two_byte_p;
{
- int charset = CHAR_CHARSET (c);
XFontStruct *font = font_info->font;
/* FONT_INFO may define a scheme by which to encode byte1 and byte2.
check_ccl_update (ccl);
if (CHARSET_DIMENSION (charset) == 1)
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = char2b->byte2;
ccl->reg[2] = -1;
}
else
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = char2b->byte1;
ccl->reg[2] = char2b->byte2;
}
- ccl_driver (ccl, NULL, NULL, 0, 0, NULL);
+ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
if (font->max_byte1 == 0) /* 1-byte font */
- char2b->byte1 = 0, char2b->byte2 = ccl->reg[1];
+ STORE_XCHAR2B (char2b, 0, ccl->reg[1]);
else
- char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2];
+ STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
- else if (font_info->encoding[charset])
+ else if (font_info->encoding_type)
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
- int enc = font_info->encoding[charset];
+ unsigned char enc = font_info->encoding_type;
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
if (s->first_glyph->type == CHAR_GLYPH)
- face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
+ face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
s->face = FACE_FROM_ID (s->f, face_id);
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
}
+/* Set SRC's clipping for output of glyph string DST. This is called
+ when we are drawing DST's left_overhang or right_overhang only in
+ the area of SRC. */
+
+static void
+x_set_glyph_string_clipping_exactly (src, dst)
+ struct glyph_string *src, *dst;
+{
+ XRectangle r;
+ struct glyph_string *clip_head = src->clip_head;
+ struct glyph_string *clip_tail = src->clip_tail;
+
+ /* This foces clipping just this glyph string. */
+ src->clip_head = src->clip_tail = src;
+ get_glyph_string_clip_rect (src, &r);
+ src->clip_head = clip_head, src->clip_tail = clip_tail;
+ XSetClipRectangles (dst->display, dst->gc, 0, 0, &r, 1, Unsorted);
+}
+
+
/* RIF:
- Compute left and right overhang of glyph string S. If S is a glyph
- string for a composition, assume overhangs don't exist. */
+ Compute left and right overhang of glyph string S. */
static void
x_compute_glyph_string_overhangs (s)
s->right_overhang = cs.rbearing > cs.width ? cs.rbearing - cs.width : 0;
s->left_overhang = cs.lbearing < 0 ? -cs.lbearing : 0;
}
+ else if (s->cmp)
+ {
+ s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width;
+ s->left_overhang = - s->cmp->lbearing;
+ }
}
/* If first glyph of S has a left box line, start drawing the text
of S to the right of that box line. */
- if (s->face->box != FACE_NO_BOX
+ if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
else
{
for (i = 0; i < s->nchars; i++, ++s->gidx)
- {
- XDrawString16 (s->display, s->window, s->gc,
- x + s->cmp->offsets[s->gidx * 2],
- s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
- s->char2b + i, 1);
- if (s->face->overstrike)
+ if (s->face)
+ {
XDrawString16 (s->display, s->window, s->gc,
- x + s->cmp->offsets[s->gidx * 2] + 1,
+ x + s->cmp->offsets[s->gidx * 2],
s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
s->char2b + i, 1);
- }
+ if (s->face->overstrike)
+ XDrawString16 (s->display, s->window, s->gc,
+ x + s->cmp->offsets[s->gidx * 2] + 1,
+ s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
+ s->char2b + i, 1);
+ }
}
}
{
int relief_drawn_p = 0;
- /* If S draws into the background of its successor, draw the
- background of the successor first so that S can draw into it.
+ /* If S draws into the background of its successors, draw the
+ background of the successors first so that S can draw into it.
This makes S->next use XDrawString instead of XDrawImageString. */
if (s->next && s->right_overhang && !s->for_overlaps)
{
- xassert (s->next->img == NULL);
- x_set_glyph_string_gc (s->next);
- x_set_glyph_string_clipping (s->next);
- x_draw_glyph_string_background (s->next, 1);
+ int width;
+ struct glyph_string *next;
+
+ for (width = 0, next = s->next; next;
+ width += next->width, next = next->next)
+ if (next->first_glyph->type != IMAGE_GLYPH)
+ {
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping (next);
+ x_draw_glyph_string_background (next, 1);
+ }
}
/* Set up S->gc, set clipping and draw S. */
x_set_glyph_string_clipping (s);
relief_drawn_p = 1;
}
+ else if ((s->prev && s->prev->hl != s->hl && s->left_overhang)
+ || (s->next && s->next->hl != s->hl && s->right_overhang))
+ /* We must clip just this glyph. left_overhang part has already
+ drawn when s->prev was drawn, and right_overhang part will be
+ drawn later when s->next is drawn. */
+ x_set_glyph_string_clipping_exactly (s, s);
else
x_set_glyph_string_clipping (s);
/* Draw relief if not yet drawn. */
if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
x_draw_glyph_string_box (s);
+
+ if (s->prev)
+ {
+ struct glyph_string *prev;
+
+ for (prev = s->prev; prev; prev = prev->prev)
+ if (prev->hl != s->hl
+ && prev->x + prev->width + prev->right_overhang > s->x)
+ {
+ /* As prev was drawn while clipped to its own area, we
+ must draw the right_overhang part using s->hl now. */
+ enum draw_glyphs_face save = prev->hl;
+
+ prev->hl = s->hl;
+ x_set_glyph_string_gc (prev);
+ x_set_glyph_string_clipping_exactly (s, prev);
+ x_draw_glyph_string_foreground (prev);
+ XSetClipMask (prev->display, prev->gc, None);
+ prev->hl = save;
+ }
+ }
+
+ if (s->next)
+ {
+ struct glyph_string *next;
+
+ for (next = s->next; next; next = next->next)
+ if (next->hl != s->hl
+ && next->x - next->left_overhang && s->next->hl != s->hl)
+ {
+ /* As next will be drawn while clipped to its own area,
+ we must draw the left_overhang part using s->hl now. */
+ enum draw_glyphs_face save = next->hl;
+
+ next->hl = s->hl;
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping_exactly (s, next);
+ x_draw_glyph_string_foreground (next);
+ XSetClipMask (next->display, next->gc, None);
+ next->hl = save;
+ }
+ }
}
/* Reset clipping. */
goto done_keysym;
}
- /* Keysyms directly mapped to supported Unicode characters. */
- if ((keysym >= 0x01000000 && keysym <= 0x010033ff)
- || (keysym >= 0x0100e000 && keysym <= 0x0100ffff))
+ /* Keysyms directly mapped to Unicode characters. */
+ if (keysym >= 0x01000000 && keysym <= 0x0110FFFF)
{
- int code = keysym & 0xFFFF, charset_id, c1, c2;
-
- if (code < 0x80)
- {
- inev.ie.kind = ASCII_KEYSTROKE_EVENT;
- inev.ie.code = code;
- }
- else if (code < 0x100)
- {
- if (code < 0xA0)
- charset_id = CHARSET_8_BIT_CONTROL;
- else
- charset_id = charset_latin_iso8859_1;
- inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
- inev.ie.code = MAKE_CHAR (charset_id, code, 0);
- }
+ if (keysym < 0x01000080)
+ inev.ie.kind = ASCII_KEYSTROKE_EVENT;
else
- {
- if (code < 0x2500)
- charset_id = charset_mule_unicode_0100_24ff,
- code -= 0x100;
- else if (code < 0xE000)
- charset_id = charset_mule_unicode_2500_33ff,
- code -= 0x2500;
- else
- charset_id = charset_mule_unicode_e000_ffff,
- code -= 0xE000;
- c1 = (code / 96) + 32, c2 = (code % 96) + 32;
- inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
- inev.ie.code = MAKE_CHAR (charset_id, c1, c2);
- }
+ inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
+ inev.ie.code = keysym & 0xFFFFFF;
goto done_keysym;
}
register int c;
int nchars, len;
- /* The input should be decoded with `coding_system'
- which depends on which X*LookupString function
- we used just above and the locale. */
- setup_coding_system (coding_system, &coding);
- coding.src_multibyte = 0;
- coding.dst_multibyte = 1;
- /* The input is converted to events, thus we can't
- handle composition. Anyway, there's no XIM that
- gives us composition information. */
- coding.composing = COMPOSITION_DISABLED;
-
- for (i = 0; i < nbytes; i++)
+ for (i = 0, nchars = 0; i < nbytes; i++)
{
+ if (ASCII_BYTE_P (copy_bufptr[i]))
+ nchars++;
STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]);
}
- {
- /* Decode the input data. */
- int require;
- unsigned char *p;
-
- require = decoding_buffer_size (&coding, nbytes);
- p = (unsigned char *) alloca (require);
- coding.mode |= CODING_MODE_LAST_BLOCK;
- /* We explicitly disable composition handling because
- key data should not contain any composition sequence. */
- coding.composing = COMPOSITION_DISABLED;
- decode_coding (&coding, copy_bufptr, p, nbytes, require);
- nbytes = coding.produced;
- nchars = coding.produced_char;
- copy_bufptr = p;
- }
+ if (nchars < nbytes)
+ {
+ /* Decode the input data. */
+ int require;
+ unsigned char *p;
+
+ /* The input should be decoded with `coding_system'
+ which depends on which X*LookupString function
+ we used just above and the locale. */
+ setup_coding_system (coding_system, &coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte = 1;
+ /* The input is converted to events, thus we can't
+ handle composition. Anyway, there's no XIM that
+ gives us composition information. */
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+ require = MAX_MULTIBYTE_LENGTH * nbytes;
+ coding.destination = alloca (require);
+ coding.dst_bytes = require;
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ decode_coding_c_string (&coding, copy_bufptr, nbytes, Qnil);
+ nbytes = coding.produced;
+ nchars = coding.produced_char;
+ copy_bufptr = coding.destination;
+ }
/* Convert the input data to a sequence of
character events. */
{
struct x_error_message_stack *tmp;
+ BLOCK_INPUT;
+
/* The display may have been closed before this function is called.
Check if it is still open before calling XSync. */
if (x_display_info_for_display (x_error_message->dpy) != 0)
- {
- BLOCK_INPUT;
- XSync (x_error_message->dpy, False);
- UNBLOCK_INPUT;
- }
+ XSync (x_error_message->dpy, False);
tmp = x_error_message;
x_error_message = x_error_message->prev;
xfree (tmp);
+ UNBLOCK_INPUT;
}
/* If any X protocol errors have arrived since the last call to
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
+ if (FRAME_FONT (f) == (XFontStruct *) (fontp->font))
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return build_string (fontp->full_name);
+
FRAME_FONT (f) = (XFontStruct *) (fontp->font);
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
return build_string (fontp->full_name);
}
-/* Give frame F the fontset named FONTSETNAME as its default font, and
- return the full name of that fontset. FONTSETNAME may be a wildcard
- pattern; in that case, we choose some fontset that fits the pattern.
- The return value shows which fontset we chose. */
+/* Give frame F the fontset named FONTSETNAME as its default fontset,
+ and return the full name of that fontset. FONTSETNAME may be a
+ wildcard pattern; in that case, we choose some fontset that fits
+ the pattern. FONTSETNAME may be a font name for ASCII characters;
+ in that case, we create a fontset from that font name.
+
+ The return value shows which fontset we chose.
+ If FONTSETNAME specifies the default fontset, return Qt.
+ If an ASCII font in the specified fontset can't be loaded, return
+ Qnil. */
Lisp_Object
x_new_fontset (f, fontsetname)
struct frame *f;
- char *fontsetname;
+ Lisp_Object fontsetname;
{
- int fontset = fs_query_fontset (build_string (fontsetname), 0);
+ int fontset = fs_query_fontset (fontsetname, 0);
Lisp_Object result;
- if (fontset < 0)
- return Qnil;
-
- if (FRAME_FONTSET (f) == fontset)
+ if (fontset > 0 && f->output_data.x->fontset == fontset)
/* This fontset is already set in frame F. There's nothing more
to do. */
return fontset_name (fontset);
+ else if (fontset == 0)
+ /* The default fontset can't be the default font. */
+ return Qt;
- result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ if (fontset > 0)
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
+ result = x_new_font (f, SDATA (fontsetname));
if (!STRINGP (result))
/* Can't load ASCII font. */
return Qnil;
+ if (fontset < 0)
+ fontset = new_fontset_from_font_name (result);
+
/* Since x_new_font doesn't update any fontset information, do it now. */
FRAME_FONTSET (f) = fontset;
xic_set_xfontset (f, SDATA (fontset_ascii (fontset)));
#endif
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
\f
If SIZE is > 0, it is the size (maximum bounds width) of fonts
to be listed.
- SIZE < 0 means include scalable fonts.
+ SIZE < 0 means include auto scaled fonts.
Frame F null means we have not yet created any frame on X, and
consult the first display in x_display_list. MAXNAMES sets a limit
bzero (fontp, sizeof (*fontp));
fontp->font = font;
fontp->font_idx = i;
+ fontp->charset = -1; /* fs_load_font sets it. */
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
- fontp->encoding[1]
+ fontp->encoding_type
= (font->max_byte1 == 0
/* 1-byte font */
? (font->min_char_or_byte2 < 0x80
}
+/* Return a char-table whose elements are t if the font FONT_INFO
+ contains a glyph for the corresponding character, and nil if
+ not. */
+
+Lisp_Object
+x_get_font_repertory (f, font_info)
+ FRAME_PTR f;
+ struct font_info *font_info;
+{
+ XFontStruct *font = (XFontStruct *) font_info->font;
+ Lisp_Object table;
+ int min_byte1, max_byte1, min_byte2, max_byte2;
+ int c;
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ int offset = CHARSET_OFFSET (charset);
+
+ table = Fmake_char_table (Qnil, Qnil);
+
+ min_byte1 = font->min_byte1;
+ max_byte1 = font->max_byte1;
+ min_byte2 = font->min_char_or_byte2;
+ max_byte2 = font->max_char_or_byte2;
+ if (min_byte1 == 0 && max_byte1 == 0)
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + min_byte2,
+ offset + max_byte2, Qt);
+ else
+ for (; min_byte2 <= max_byte2; min_byte2++)
+ {
+ c = DECODE_CHAR (charset, min_byte2);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int from = -1;
+ int i;
+
+ for (i = min_byte2; i <= max_byte2; i++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from,
+ offset + i - 1, Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = i;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from, offset + i - 1,
+ Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ int i, j;
+
+ if (offset >= 0)
+ for (i = min_byte1; i <= max_byte1; i++)
+ char_table_set_range
+ (table, offset + ((i << 8) | min_byte2),
+ offset + ((i << 8) | max_byte2), Qt);
+ else
+ for (i = min_byte1; i <= max_byte1; i++)
+ for (j = min_byte2; j <= max_byte2; j++)
+ {
+ unsigned code = (i << 8) | j;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int i;
+
+ for (i = min_byte1; i <= max_byte1; i++)
+ {
+ int from = -1;
+ int j;
+
+ for (j = min_byte2; j <= max_byte2; j++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = ENCODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = j;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return table;
+}
\f
/***********************************************************************
Initialization
*bits = nr;
}
+ int
+ x_display_ok (display)
+ const char * display;
+ {
+ int dpy_ok = 1;
+ Display *dpy;
+
+ if (!display)
+ display = getenv("DISPLAY");
+ if (!display)
+ return 0;
+
+ if ((dpy = XOpenDisplay (display)))
+ XCloseDisplay (dpy);
+ else
+ dpy_ok = 0;
+ return dpy_ok;
+ }
+
struct x_display_info *
x_term_init (display_name, xrm_option, resource_name)
Lisp_Object display_name;
staticpro (&Qvendor_specific_keysyms);
Qvendor_specific_keysyms = intern ("vendor-specific-keysyms");
- staticpro (&Qutf_8);
- Qutf_8 = intern ("utf-8");
staticpro (&Qlatin_1);
Qlatin_1 = intern ("latin-1");
extern struct x_display_info *x_display_info_for_name P_ ((Lisp_Object));
extern struct x_display_info *x_term_init P_ ((Lisp_Object, char *, char *));
+ extern int x_display_ok P_ ((const char *));
extern Lisp_Object x_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
extern void select_visual P_ ((struct x_display_info *));
extern struct font_info *x_load_font P_ ((struct frame *, char *, int));
extern struct font_info *x_query_font P_ ((struct frame *, char *));
extern void x_find_ccl_program P_ ((struct font_info *));
+extern Lisp_Object x_get_font_repertory P_ ((struct frame *,
+ struct font_info *));
+
\f
/* Each X frame object points to its own struct x_output object
in the output_data.x field. The x_output structure contains
HCoop / bpt / emacs.git / commitdiff