procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from trunk.

Browse source
This commit is contained in:
Paul Eggert 2011-07-08 02:38:32 -07:00
commit 1692ae2dd5
84 changed files with 1673 additions and 798 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
ChangeLog
View file

@ -1,4 +1,4 @@
2011-07-06 Paul Eggert <eggert@cs.ucla.edu>
2011-07-08 Paul Eggert <eggert@cs.ucla.edu>
Add gnulib support for pthread_sigmask (Bug#9010).
* Makefile.in (GNULIB_MODULES): Add pthread_sigmask.
@ -12,6 +12,14 @@
due to the above changes.
* .bzrignore: Add lib/signal.h.
2011-07-07 Andreas Schwab <schwab@linux-m68k.org>
* configure.in (maintainer-mode): Reflect default in help string.
2011-07-07 Dan Nicolaescu <dann@ics.uci.edu>
* configure.in: Remove reference to iris4d.h.
2011-07-05 Jan Djärv <jan.h.d@swipnet.se>
* configure.in (HAVE_GCONF): Allow both HAVE_GCONF and HAVE_GSETTINGS.

44
admin/ChangeLog
View file

@ -1,3 +1,43 @@
2011-07-07 Juanma Barranquero <lekktu@gmail.com>
* unidata/makefile.w32-in (charprop-SH, charprop-CMD):
Duplicate change in Makefile.in (2011-07-06T22:43:48Z!handa@m17n.org).
2011-07-06 Kenichi Handa <handa@m17n.org>
* unidata/unidata-gen.el (unidata-dir): New variable.
(unidata-setup-list): Expand unidata-text-file in unidata-dir.
(unidata-prop-alist): INDEX element may be a function. New
optional element VAL-LIST (for general-category and bidi-class).
New entry `mirroring'.
(unidata-prop-default, unidata-prop-val-list): New subst.
(unidata-get-character, unidata-put-character): Delete them.
(unidata-gen-table-character): New arg IGNORE. Adjusted for the
above changes.
(unidata-get-symbol, unidata-get-integer, unidata-get-numeric)
(unidata-put-symbol, unidata-put-integer, unidata-put-numeric):
Delete them.
(unidata-encode-val): Assume that the first element of VAL-LIST is
a cons (nil . 0).
(unidata-gen-table): Change argument DEFAULT-VALUE to VAL-LIST.
Always store the encoded value.
(unidata-gen-table-symbol): New args DEFAULT-VALUE and VAL-LIST.
Set the 1st and the 2nd extra slots to index numbers for C
functions.
(unidata-gen-table-integer): Likewise.
(unidata-gen-table-numeric): Likewise.
(unidata-gen-table-name): New arg IGNORE.
(unidata-gen-table-decomposition): Likewise.
(unidata-describe-general-category): Add the case nil to the
description alist.
(unidata-gen-mirroring-list): New function.
(unidata-gen-files): New arg DATA-DIR. Adjusted for the change of
unidata-prop-alist. Handle the case of storing multiple
char-tables in a file.
* unidata/Makefile.in (${DSTDIR}/charprop.el): New arg to
unidata-gen-files.
2011-05-21 Glenn Morris <rgm@gnu.org>
* bzrmerge.el (bzrmerge-resolve): Suppress prompts about file-locals.
@ -187,7 +227,7 @@
* unidata/BidiMirroring.txt: New file from
http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt.
* unidata/Makefile.in: (../../src/bidimirror.h): New target.
* unidata/Makefile.in (../../src/bidimirror.h): New target.
(all): Depend on ../../src/biditype.h and ../../src/bidimirror.h.
* unidata/makefile.w32-in (../../src/bidimirror.h): New target.
@ -236,7 +276,7 @@
* quick-install-emacs: Use more portable shell syntax.
* quick-install-emacs: (AVOID): Be more picky about files we avoid
* quick-install-emacs (AVOID): Be more picky about files we avoid
installing.
2010-02-14 Juanma Barranquero <lekktu@gmail.com>

5
admin/unidata/Makefile.in
View file

@ -33,9 +33,10 @@ unidata.txt: UnicodeData.txt
${DSTDIR}/charprop.el: unidata-gen.elc unidata.txt
ELC=`/bin/pwd`/unidata-gen.elc; \
DATA=`/bin/pwd`/unidata.txt; \
DATADIR=`/bin/pwd`; \
DATA=unidata.txt; \
cd ${DSTDIR}; \
${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATA}
${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
../../src/biditype.h: UnicodeData.txt
gawk -F";" -f biditype.awk $< > $@

7
admin/unidata/makefile.w32-in
View file

@ -41,12 +41,13 @@ unidata.txt: UnicodeData.txt
charprop-SH: unidata-gen.elc unidata.txt
ELC=$(CURDIR)/unidata-gen.elc; \
DATA=$(CURDIR)/unidata.txt; \
DATADIR=$(CURDIR); \
DATA=unidata.txt; \
cd $(DSTDIR); \
$(RUNEMACS) --load $${ELC} -f unidata-gen-files $${DATA}
$(RUNEMACS) --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
charprop-CMD: unidata-gen.elc unidata.txt
$(RUNEMACS) --eval $(ARGQUOTE)(cd $(DQUOTE)$(DSTDIR)$(DQUOTE))$(ARGQUOTE) --load $(CURDIR)/unidata-gen.elc -f unidata-gen-files $(CURDIR)/unidata.txt
$(RUNEMACS) --eval $(ARGQUOTE)(cd $(DQUOTE)$(DSTDIR)$(DQUOTE))$(ARGQUOTE) --load $(CURDIR)/unidata-gen.elc -f unidata-gen-files $(CURDIR) unidata.txt
${DSTDIR}/charprop.el: charprop-$(SHELLTYPE)

435
admin/unidata/unidata-gen.el
View file

@ -33,24 +33,25 @@
;;
;; charprop.el
;; It contains a series of forms of this format:
;; (char-code-property-register PROP FILE)
;; (define-char-code-property PROP FILE)
;; where PROP is a symbol representing a character property
;; (name, generic-category, etc), and FILE is a name of one of
;; (name, general-category, etc), and FILE is a name of one of
;; the following files.
;;
;; uni-name.el, uni-category.el, uni-combining.el, uni-bidi.el,
;; uni-decomposition.el, uni-decimal.el, uni-digit.el, uni-numeric.el,
;; uni-mirrored.el, uni-old-name.el, uni-comment.el, uni-uppercase.el,
;; uni-lowercase.el, uni-titlecase.el
;; They each contain a single form of this format:
;; (char-code-property-register PROP CHAR-TABLE)
;; They contain one or more forms of this format:
;; (define-char-code-property PROP CHAR-TABLE)
;; where PROP is the same as above, and CHAR-TABLE is a
;; char-table containing property values in a compressed format.
;;
;; When they are installed in .../lisp/international/, the file
;; "charprop.el" is preloaded in loadup.el. The other files are
;; automatically loaded when the functions `get-char-code-property'
;; and `put-char-code-property' are called.
;; automatically loaded when the Lisp functions
;; `get-char-code-property' and `put-char-code-property', and C
;; function uniprop_table are called.
;;
;; FORMAT OF A CHAR TABLE
;;
@ -62,17 +63,22 @@
;; data in a char-table as below.
;;
;; If succeeding 128*N characters have the same property value, we
;; store that value for them. Otherwise, compress values for
;; succeeding 128 characters into a single string and store it as a
;; value for those characters. The way of compression depends on a
;; property. See the section "SIMPLE TABLE", "RUN-LENGTH TABLE",
;; and "WORD-LIST TABLE".
;; store that value (or the encoded one) for them. Otherwise,
;; compress values (or the encoded ones) for succeeding 128
;; characters into a single string and store it for those
;; characters. The way of compression depends on a property. See
;; the section "SIMPLE TABLE", "RUN-LENGTH TABLE", and "WORD-LIST
;; TABLE".
;; The char table has four extra slots:
;; The char table has five extra slots:
;; 1st: property symbol
;; 2nd: function to call to get a property value
;; 3nd: function to call to put a property value
;; 4th: function to call to get a description of a property value
;; 2nd: function to call to get a property value,
;; or an index number of C function to decode the value,
;; or nil if the value can be directly got from the table.
;; 3nd: function to call to put a property value,
;; or an index number of C function to encode the value,
;; or nil if the value can be directly stored in the table.
;; 4th: function to call to get a description of a property value, or nil
;; 5th: data referred by the above functions
;; List of elements of this form:
@ -82,6 +88,11 @@
(defvar unidata-list nil)
;; Name of the directory containing files of Unicode Character
;; Database.
(defvar unidata-dir nil)
(defun unidata-setup-list (unidata-text-file)
(let* ((table (list nil))
(tail table)
@ -90,6 +101,7 @@
("^<.*Surrogate" . nil)
("^<.*Private Use" . PRIVATE\ USE)))
val char name)
(setq unidata-text-file (expand-file-name unidata-text-file unidata-dir))
(or (file-readable-p unidata-text-file)
(error "File not readable: %s" unidata-text-file))
(with-temp-buffer
@ -134,12 +146,17 @@
(setq unidata-list (cdr table))))
;; Alist of this form:
;; (PROP INDEX GENERATOR FILENAME)
;; (PROP INDEX GENERATOR FILENAME DOCSTRING DESCRIBER VAL-LIST)
;; PROP: character property
;; INDEX: index to each element of unidata-list for PROP
;; INDEX: index to each element of unidata-list for PROP.
;; It may be a function that generates an alist of character codes
;; vs. the corresponding property values.
;; GENERATOR: function to generate a char-table
;; FILENAME: filename to store the char-table
;; DOCSTRING: docstring for the property
;; DESCRIBER: function to call to get a description string of property value
;; DEFAULT: the default value of the property
;; VAL-LIST: list of specially ordered property values
(defconst unidata-prop-alist
'((name
@ -152,7 +169,12 @@ Property value is a string.")
Property value is one of the following symbols:
Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn"
unidata-describe-general-category)
unidata-describe-general-category
nil
;; The order of elements must be in sync with unicode_category_t
;; in src/character.h.
(Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po
Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co Cn))
(canonical-combining-class
3 unidata-gen-table-integer "uni-combining.el"
"Unicode canonical combining class.
@ -164,7 +186,11 @@ Property value is an integer."
Property value is one of the following symbols:
L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET,
AN, CS, NSM, BN, B, S, WS, ON"
unidata-describe-bidi-class)
unidata-describe-bidi-class
L
;; The order of elements must be in sync with bidi_type_t in
;; src/dispextern.h.
(L R EN AN BN B AL LRE LRO RLE RLO PDF ES ET CS NSM S WS ON))
(decomposition
5 unidata-gen-table-decomposition "uni-decomposition.el"
"Unicode decomposition mapping.
@ -188,7 +214,7 @@ Property value is an integer or a floating point.")
(mirrored
9 unidata-gen-table-symbol "uni-mirrored.el"
"Unicode bidi mirrored flag.
Property value is a symbol `Y' or `N'.")
Property value is a symbol `Y' or `N'. See also the property `mirroring'.")
(old-name
10 unidata-gen-table-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
@ -211,7 +237,12 @@ Property value is a character."
14 unidata-gen-table-character "uni-titlecase.el"
"Unicode simple titlecase mapping.
Property value is a character."
string)))
string)
(mirroring
unidata-gen-mirroring-list unidata-gen-table-character "uni-mirrored.el"
"Unicode bidi-mirroring characters.
Property value is a character that has the corresponding mirroring image,
or nil for non-mirrored character.")))
;; Functions to access the above data.
(defsubst unidata-prop-index (prop) (nth 1 (assq prop unidata-prop-alist)))
@ -219,6 +250,8 @@ Property value is a character."
(defsubst unidata-prop-file (prop) (nth 3 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-docstring (prop) (nth 4 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-describer (prop) (nth 5 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-default (prop) (nth 6 (assq prop unidata-prop-alist)))
(defsubst unidata-prop-val-list (prop) (nth 7 (assq prop unidata-prop-alist)))
;; SIMPLE TABLE
@ -227,52 +260,34 @@ Property value is a character."
;; values of succeeding character codes are usually different, we use
;; a char-table described here to store such values.
;;
;; If succeeding 128 characters has no property, a char-table has the
;; symbol t for them. Otherwise a char-table has a string of the
;; following format for them.
;; A char-table divides character code space (#x0..#x3FFFFF) into
;; #x8000 blocks (each block contains 128 characters).
;; If all characters of a block have no property, a char-table has the
;; symbol nil for that block. Otherwise a char-table has a string of
;; the following format for it.
;;
;; The first character of the string is FIRST-INDEX.
;; The Nth (N > 0) character of the string is a property value of the
;; character (BLOCK-HEAD + FIRST-INDEX + N - 1), where BLOCK-HEAD is
;; the first of the characters in the block.
;; The first character of the string is ?\001.
;; The second character of the string is FIRST-INDEX.
;; The Nth (N > 1) character of the string is a property value of the
;; character (BLOCK-HEAD + FIRST-INDEX + N - 2), where BLOCK-HEAD is
;; the first character of the block.
;;
;; The 4th extra slot of a char-table is nil.
;; This kind of char-table has these extra slots:
;; 1st: the property symbol
;; 2nd: nil
;; 3rd: 0 (corresponding to uniprop_encode_character in chartab.c)
;; 4th to 5th: nil
(defun unidata-get-character (char val table)
(cond
((characterp val)
val)
((stringp val)
(let* ((len (length val))
(block-head (lsh (lsh char -7) 7))
(vec (make-vector 128 nil))
(first-index (aref val 0)))
(dotimes (i (1- len))
(let ((elt (aref val (1+ i))))
(if (> elt 0)
(aset vec (+ first-index i) elt))))
(dotimes (i 128)
(aset table (+ block-head i) (aref vec i)))
(aref vec (- char block-head))))))
(defun unidata-put-character (char val table)
(or (characterp val)
(not val)
(error "Not a character nor nil: %S" val))
(let ((current-val (aref table char)))
(unless (eq current-val val)
(if (stringp current-val)
(funcall (char-table-extra-slot table 1) char current-val table))
(aset table char val))))
(defun unidata-gen-table-character (prop)
(defun unidata-gen-table-character (prop &rest ignore)
(let ((table (make-char-table 'char-code-property-table))
(prop-idx (unidata-prop-index prop))
(vec (make-vector 128 0))
(tail unidata-list)
elt range val idx slot)
(set-char-table-range table (cons 0 (max-char)) t)
(if (functionp prop-idx)
(setq tail (funcall prop-idx)
prop-idx 1))
(while tail
(setq elt (car tail) tail (cdr tail))
(setq range (car elt)
@ -301,7 +316,7 @@ Property value is a character."
(setq first-index last-index)))
(setq tail (cdr tail)))
(when first-index
(let ((str (string first-index))
(let ((str (string 1 first-index))
c)
(while (<= first-index last-index)
(setq str (format "%s%c" str (or (aref vec first-index) 0))
@ -309,184 +324,78 @@ Property value is a character."
(set-char-table-range table (cons start limit) str))))))
(set-char-table-extra-slot table 0 prop)
(byte-compile 'unidata-get-character)
(byte-compile 'unidata-put-character)
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-character))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-character))
(set-char-table-extra-slot table 2 0)
table))
;; RUN-LENGTH TABLE
;;
;; If the type of character property value is symbol, integer,
;; boolean, or character, we use a char-table described here to store
;; the values.
;; If many characters of successive character codes have the same
;; property value, we use a char-table described here to store the
;; values.
;;
;; The 4th extra slot is a vector of property values (VAL-TABLE), and
;; values for succeeding 128 characters are encoded into this
;; character sequence:
;; At first, instead of a value itself, we store an index number to
;; the VAL-TABLE (5th extra slot) in the table. We call that index
;; number as VAL-CODE here after.
;;
;; A char-table divides character code space (#x0..#x3FFFFF) into
;; #x8000 blocks (each block contains 128 characters).
;;
;; If all characters of a block have the same value, a char-table has
;; VAL-CODE for that block. Otherwise a char-table has a string of
;; the following format for that block.
;;
;; The first character of the string is ?\002.
;; The following characters has this form:
;; ( VAL-CODE RUN-LENGTH ? ) +
;; where:
;; VAL-CODE (0..127):
;; (VAL-CODE - 1) is an index into VAL-TABLE.
;; The value 0 means no-value.
;; VAL-CODE (0..127): index into VAL-TABLE.
;; RUN-LENGTH (130..255):
;; (RUN-LENGTH - 128) specifies how many characters have the same
;; value. If omitted, it means 1.
;; Return a symbol-type character property value of CHAR. VAL is the
;; current value of (aref TABLE CHAR).
(defun unidata-get-symbol (char val table)
(let ((val-table (char-table-extra-slot table 4)))
(cond ((symbolp val)
val)
((stringp val)
(let ((first-char (lsh (lsh char -7) 7))
(str val)
(len (length val))
(idx 0)
this-val count)
(set-char-table-range table (cons first-char (+ first-char 127))
nil)
(while (< idx len)
(setq val (aref str idx) idx (1+ idx)
count (if (< idx len) (aref str idx) 1))
(setq val (and (> val 0) (aref val-table (1- val)))
count (if (< count 128)
1
(prog1 (- count 128) (setq idx (1+ idx)))))
(dotimes (i count)
(if val
(aset table first-char val))
(if (= first-char char)
(setq this-val val))
(setq first-char (1+ first-char))))
this-val))
((> val 0)
(aref val-table (1- val))))))
;; Return a integer-type character property value of CHAR. VAL is the
;; current value of (aref TABLE CHAR).
(defun unidata-get-integer (char val table)
(let ((val-table (char-table-extra-slot table 4)))
(cond ((integerp val)
val)
((stringp val)
(let ((first-char (lsh (lsh char -7) 7))
(str val)
(len (length val))
(idx 0)
this-val count)
(while (< idx len)
(setq val (aref str idx) idx (1+ idx)
count (if (< idx len) (aref str idx) 1))
(setq val (and (> val 0) (aref val-table (1- val)))
count (if (< count 128)
1
(prog1 (- count 128) (setq idx (1+ idx)))))
(dotimes (i count)
(aset table first-char val)
(if (= first-char char)
(setq this-val val))
(setq first-char (1+ first-char))))
this-val)))))
;; Return a numeric-type (integer or float) character property value
;; of CHAR. VAL is the current value of (aref TABLE CHAR).
(defun unidata-get-numeric (char val table)
(cond
((numberp val)
val)
((stringp val)
(let ((val-table (char-table-extra-slot table 4))
(first-char (lsh (lsh char -7) 7))
(str val)
(len (length val))
(idx 0)
this-val count)
(while (< idx len)
(setq val (aref str idx) idx (1+ idx)
count (if (< idx len) (aref str idx) 1))
(setq val (and (> val 0) (aref val-table (1- val)))
count (if (< count 128)
1
(prog1 (- count 128) (setq idx (1+ idx)))))
(dotimes (i count)
(aset table first-char val)
(if (= first-char char)
(setq this-val val))
(setq first-char (1+ first-char))))
this-val))))
;; Store VAL (symbol) as a character property value of CHAR in TABLE.
(defun unidata-put-symbol (char val table)
(or (symbolp val)
(error "Not a symbol: %S" val))
(let ((current-val (aref table char)))
(unless (eq current-val val)
(if (stringp current-val)
(funcall (char-table-extra-slot table 1) char current-val table))
(aset table char val))))
;; Store VAL (integer) as a character property value of CHAR in TABLE.
(defun unidata-put-integer (char val table)
(or (integerp val)
(not val)
(error "Not an integer nor nil: %S" val))
(let ((current-val (aref table char)))
(unless (eq current-val val)
(if (stringp current-val)
(funcall (char-table-extra-slot table 1) char current-val table))
(aset table char val))))
;; Store VAL (integer or float) as a character property value of CHAR
;; in TABLE.
(defun unidata-put-numeric (char val table)
(or (numberp val)
(not val)
(error "Not a number nor nil: %S" val))
(let ((current-val (aref table char)))
(unless (equal current-val val)
(if (stringp current-val)
(funcall (char-table-extra-slot table 1) char current-val table))
(aset table char val))))
;;
;; This kind of char-table has these extra slots:
;; 1st: the property symbol
;; 2nd: 0 (corresponding to uniprop_decode_value in chartab.c)
;; 3rd: 1..3 (corresponding to uniprop_encode_xxx in chartab.c)
;; 4th: function or nil
;; 5th: VAL-TABLE
;; Encode the character property value VAL into an integer value by
;; VAL-LIST. By side effect, VAL-LIST is modified.
;; VAL-LIST has this form:
;; (t (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...)
;; If VAL is one of VALn, just return VAL-CODEn. Otherwise,
;; VAL-LIST is modified to this:
;; (t (VAL . (1+ VAL-CODE1)) (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...)
;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ...)
;; If VAL is one of VALn, just return n.
;; Otherwise, VAL-LIST is modified to this:
;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ... (VAL . n+1))
(defun unidata-encode-val (val-list val)
(let ((slot (assoc val val-list))
val-code)
(if slot
(cdr slot)
(setq val-code (if (cdr val-list) (1+ (cdr (nth 1 val-list))) 1))
(setcdr val-list (cons (cons val val-code) (cdr val-list)))
(setq val-code (length val-list))
(nconc val-list (list (cons val val-code)))
val-code)))
;; Generate a char-table for the character property PROP.
(defun unidata-gen-table (prop val-func default-value)
(defun unidata-gen-table (prop val-func default-value val-list)
(let ((table (make-char-table 'char-code-property-table))
(prop-idx (unidata-prop-index prop))
(val-list (list t))
(vec (make-vector 128 0))
tail elt range val val-code idx slot
prev-range-data)
(set-char-table-range table (cons 0 (max-char)) default-value)
(setq val-list (cons nil (copy-sequence val-list)))
(setq tail val-list val-code 0)
;; Convert (nil A B ...) to ((nil . 0) (A . 1) (B . 2) ...)
(while tail
(setcar tail (cons (car tail) val-code))
(setq tail (cdr tail) val-code (1+ val-code)))
(setq default-value (unidata-encode-val val-list default-value))
(set-char-table-range table t default-value)
(set-char-table-range table nil default-value)
(setq tail unidata-list)
(while tail
(setq elt (car tail) tail (cdr tail))
@ -495,7 +404,7 @@ Property value is a character."
(setq val-code (if val (unidata-encode-val val-list val)))
(if (consp range)
(when val-code
(set-char-table-range table range val)
(set-char-table-range table range val-code)
(let ((from (car range)) (to (cdr range)))
;; If RANGE doesn't end at the char-table boundary (each
;; 128 characters), we may have to carry over the data
@ -534,7 +443,7 @@ Property value is a character."
(if val-code
(aset vec (- range start) val-code))
(setq tail (cdr tail)))
(setq str "" val-code -1 count 0)
(setq str "\002" val-code -1 count 0)
(mapc #'(lambda (x)
(if (= val-code x)
(setq count (1+ count))
@ -549,7 +458,7 @@ Property value is a character."
vec)
(if (= count 128)
(if val
(set-char-table-range table (cons start limit) val))
(set-char-table-range table (cons start limit) val-code))
(if (= val-code 0)
(set-char-table-range table (cons start limit) str)
(if (> count 2)
@ -559,34 +468,29 @@ Property value is a character."
(setq str (concat str (string val-code)))))
(set-char-table-range table (cons start limit) str))))))
(setq val-list (nreverse (cdr val-list)))
(set-char-table-extra-slot table 0 prop)
(set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list)))
table))
(defun unidata-gen-table-symbol (prop)
(defun unidata-gen-table-symbol (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x) (and (> (length x) 0)
(intern x)))
0)))
(byte-compile 'unidata-get-symbol)
(byte-compile 'unidata-put-symbol)
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-symbol))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-symbol))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 1)
table))
(defun unidata-gen-table-integer (prop)
(defun unidata-gen-table-integer (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x) (and (> (length x) 0)
(string-to-number x)))
t)))
(byte-compile 'unidata-get-integer)
(byte-compile 'unidata-put-integer)
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-integer))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-integer))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 1)
table))
(defun unidata-gen-table-numeric (prop)
(defun unidata-gen-table-numeric (prop default-value val-list)
(let ((table (unidata-gen-table prop
#'(lambda (x)
(if (string-match "/" x)
@ -595,11 +499,9 @@ Property value is a character."
(substring x (match-end 0))))
(if (> (length x) 0)
(string-to-number x))))
t)))
(byte-compile 'unidata-get-numeric)
(byte-compile 'unidata-put-numeric)
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-numeric))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-numeric))
default-value val-list)))
(set-char-table-extra-slot table 1 0)
(set-char-table-extra-slot table 2 2)
table))
@ -892,7 +794,6 @@ Property value is a character."
word-table
block-list block-word-table block-end
tail elt range val idx slot)
(set-char-table-range table (cons 0 (max-char)) 0)
(setq tail unidata-list)
(setq block-end -1)
(while tail
@ -1025,7 +926,7 @@ Property value is a character."
idx (1+ i)))))
(nreverse (cons (intern (substring str idx)) l))))))
(defun unidata-gen-table-name (prop)
(defun unidata-gen-table-name (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-name))
(word-tables (char-table-extra-slot table 4)))
(byte-compile 'unidata-get-name)
@ -1064,7 +965,7 @@ Property value is a character."
(nreverse l)))))
(defun unidata-gen-table-decomposition (prop)
(defun unidata-gen-table-decomposition (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition))
(word-tables (char-table-extra-slot table 4)))
(byte-compile 'unidata-get-decomposition)
@ -1080,7 +981,8 @@ Property value is a character."
(defun unidata-describe-general-category (val)
(cdr (assq val
'((Lu . "Letter, Uppercase")
'((nil . "Uknown")
(Lu . "Letter, Uppercase")
(Ll . "Letter, Lowercase")
(Lt . "Letter, Titlecase")
(Lm . "Letter, Modifier")
@ -1171,6 +1073,19 @@ Property value is a character."
(string ?'))))
val " "))
(defun unidata-gen-mirroring-list ()
(let ((head (list nil))
tail)
(with-temp-buffer
(insert-file-contents (expand-file-name "BidiMirroring.txt" unidata-dir))
(goto-char (point-min))
(setq tail head)
(while (re-search-forward "^\\([0-9A-F]+\\);\\s +\\([0-9A-F]+\\)" nil t)
(let ((char (string-to-number (match-string 1) 16))
(mirror (match-string 2)))
(setq tail (setcdr tail (list (list char mirror)))))))
(cdr head)))
;; Verify if we can retrieve correct values from the generated
;; char-tables.
@ -1212,13 +1127,21 @@ Property value is a character."
;; The entry function. It generates files described in the header
;; comment of this file.
(defun unidata-gen-files (&optional unidata-text-file)
(or unidata-text-file
(setq unidata-text-file (car command-line-args-left)
(defun unidata-gen-files (&optional data-dir unidata-text-file)
(or data-dir
(setq data-dir (car command-line-args-left)
command-line-args-left (cdr command-line-args-left)
unidata-text-file (car command-line-args-left)
command-line-args-left (cdr command-line-args-left)))
(unidata-setup-list unidata-text-file)
(let ((coding-system-for-write 'utf-8-unix)
(charprop-file "charprop.el"))
(charprop-file "charprop.el")
(unidata-dir data-dir))
(dolist (elt unidata-prop-alist)
(let* ((prop (car elt))
(file (unidata-prop-file prop)))
(if (file-exists-p file)
(delete-file file))))
(unidata-setup-list unidata-text-file)
(with-temp-file charprop-file
(insert ";; Automatically generated by unidata-gen.el.\n")
(dolist (elt unidata-prop-alist)
@ -1227,31 +1150,41 @@ Property value is a character."
(file (unidata-prop-file prop))
(docstring (unidata-prop-docstring prop))
(describer (unidata-prop-describer prop))
(default-value (unidata-prop-default prop))
(val-list (unidata-prop-val-list prop))
table)
;; Filename in this comment line is extracted by sed in
;; Makefile.
(insert (format ";; FILE: %s\n" file))
(insert (format "(define-char-code-property '%S %S\n %S)\n"
prop file docstring))
(with-temp-file file
(with-temp-buffer
(message "Generating %s..." file)
(setq table (funcall generator prop))
(when (file-exists-p file)
(insert-file-contents file)
(goto-char (point-max))
(search-backward ";; Local Variables:"))
(setq table (funcall generator prop default-value val-list))
(when describer
(unless (subrp (symbol-function describer))
(byte-compile describer)
(setq describer (symbol-function describer)))
(set-char-table-extra-slot table 3 describer))
(insert ";; Copyright (C) 1991-2009 Unicode, Inc.
;; This file was generated from the Unicode data file at
;; http://www.unicode.org/Public/UNIDATA/UnicodeData.txt.
;; See lisp/international/README for the copyright and permission notice.\n"
(format "(define-char-code-property '%S %S %S)\n"
prop table docstring)
";; Local Variables:\n"
";; coding: utf-8\n"
";; no-byte-compile: t\n"
";; End:\n\n"
(format ";; %s ends here\n" file)))))
(if (bobp)
(insert ";; Copyright (C) 1991-2009 Unicode, Inc.
;; This file was generated from the Unicode data files at
;; http://www.unicode.org/Public/UNIDATA/.
;; See lisp/international/README for the copyright and permission notice.\n"))
(insert (format "(define-char-code-property '%S %S %S)\n"
prop table docstring))
(if (eobp)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
";; no-byte-compile: t\n"
";; End:\n\n"
(format ";; %s ends here\n" file)))
(write-file file)
(message "Generating %s...done" file))))
(message "Writing %s..." charprop-file)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"

6
autogen/config.in
View file

@ -1038,9 +1038,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* If using the C implementation of alloca, define if you know the
direction of stack growth for your system; otherwise it will be
automatically deduced at runtime.
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
#undef STACK_DIRECTION
/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */

2
autogen/configure vendored
View file

@ -4478,7 +4478,7 @@ case "${canonical}" in
## Silicon Graphics machines
## Iris 4D
mips-sgi-irix6.5 )
machine=iris4d opsys=irix6-5
opsys=irix6-5
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).

6
configure.in
View file

@ -231,8 +231,8 @@ AC_ARG_ENABLE(asserts,
USE_XASSERTS=no)
AC_ARG_ENABLE(maintainer-mode,
[AS_HELP_STRING([--enable-maintainer-mode],
[enable make rules and dependencies not useful (and sometimes
[AS_HELP_STRING([--disable-maintainer-mode],
[disable make rules and dependencies not useful (and sometimes
confusing) to the casual installer])],
USE_MAINTAINER_MODE=$enableval,
USE_MAINTAINER_MODE=yes)
@ -536,7 +536,7 @@ case "${canonical}" in
## Silicon Graphics machines
## Iris 4D
mips-sgi-irix6.5 )
machine=iris4d opsys=irix6-5
opsys=irix6-5
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).

13
doc/lispref/ChangeLog
View file

@ -1,3 +1,16 @@
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* text.texi (Special Properties): Clarify the format of `face'
(bug#1375).
* commands.texi (Interactive Call): Add a `call-interactively'
example (bug#1010).
2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
* functions.texi (Calling Functions): Link to the "Interactive
Call" node (bug#1001).
2011-07-06 Chong Yidong <cyd@stupidchicken.com>
* customize.texi (Composite Types): Move alist and plist to here

33
doc/lispref/commands.texi
View file

@ -597,13 +597,32 @@ realistic example of using @code{commandp}.
@defun call-interactively command &optional record-flag keys
This function calls the interactively callable function @var{command},
reading arguments according to its interactive calling specifications.
It returns whatever @var{command} returns. An error is signaled if
@var{command} is not a function or if it cannot be called
interactively (i.e., is not a command). Note that keyboard macros
(strings and vectors) are not accepted, even though they are
considered commands, because they are not functions. If @var{command}
is a symbol, then @code{call-interactively} uses its function definition.
providing arguments according to its interactive calling specifications.
It returns whatever @var{command} returns.
If, for instance, you have a function with the following signature:
@example
(defun foo (begin end)
(interactive "r")
...)
@end example
then saying
@example
(call-interactively 'foo)
@end example
will call @code{foo} with the region (@code{point} and @code{mark}) as
the arguments.
An error is signaled if @var{command} is not a function or if it
cannot be called interactively (i.e., is not a command). Note that
keyboard macros (strings and vectors) are not accepted, even though
they are considered commands, because they are not functions. If
@var{command} is a symbol, then @code{call-interactively} uses its
function definition.
@cindex record command history
If @var{record-flag} is non-@code{nil}, then this command and its

6
doc/lispref/functions.texi
View file

@ -790,6 +790,12 @@ This function returns @var{arg} and has no side effects.
This function ignores any arguments and returns @code{nil}.
@end defun
Emacs Lisp functions can also be user-visible @dfn{commands}. A
command is a function that has an @dfn{interactive} specification.
You may want to call these functions as if they were called
interactively. See @ref{Interactive Call} for details on how to do
that.
@node Mapping Functions
@section Mapping Functions
@cindex mapping functions

7
doc/lispref/text.texi
View file

@ -2978,8 +2978,7 @@ character.
You can use the property @code{face} to control the font and color of
text. @xref{Faces}, for more information.
In the simplest case, the value is a face name. It can also be a list;
then each element can be any of these possibilities;
@code{face} can be the following:
@itemize @bullet
@item
@ -2994,8 +2993,8 @@ time you want to specify a particular attribute for certain text.
@xref{Face Attributes}.
@end itemize
It works to use the latter two forms directly as the value
of the @code{face} property.
@code{face} can also be a list, where each element uses one of the
forms listed above.
Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by
dynamically updating the @code{face} property of characters based on

5
doc/misc/ChangeLog
View file

@ -1,3 +1,8 @@
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* ediff.texi (Major Entry Points): Remove mention of `require',
since that's not pertinent in the installed Emacs (bug#9016).
2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Expiring Mail): Document gnus-auto-expirable-marks.

12
doc/misc/ediff.texi
View file

@ -334,18 +334,6 @@ Brings up Ediff session registry. This feature enables you to quickly find
and restart active Ediff sessions.
@end table
@noindent
If you want Ediff to be loaded from the very beginning of your Emacs
session, you should put this line in your @file{~/.emacs} file:
@example
(require 'ediff)
@end example
@noindent
Otherwise, Ediff will be loaded automatically when you use one of the
above functions, either directly or through the menus.
When the above functions are invoked, the user is prompted for all the
necessary information---typically the files or buffers to compare, merge, or
patch. Ediff tries to be smart about these prompts. For instance, in

20
etc/ChangeLog
View file

@ -1,3 +1,23 @@
2011-07-07 Tassilo Horn <tassilo@member.fsf.org>
* themes/tsdh-light-theme.el:
* themes/tsdh-dark-theme.el: Make `gnus-button' face inherit from
`button', `gnus-header-name' boxed, and define `rcirc-my-nick'
face.
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* NEWS: Clarify `smtpmail-auth-credentials' non-existence.
Mention the `send-mail-function' default change.
2011-07-07 Chong Yidong <cyd@stupidchicken.com>
* themes/dichromacy-theme.el:
* themes/tango-theme.el:
* themes/tango-dark-theme.el:
* themes/wheatgrass-theme.el: Don't define button face separately;
it inherits from link now.
2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
* NEWS: Clarify that `smtpmail-starttls-credentials' doesn't exist.

38
etc/NEWS
View file

@ -117,23 +117,45 @@ with minibuffer-local-must-match-map.
** auto-mode-case-fold is now enabled by default.
** Mail changes
The default of `send-mail-function' has changed from
`sendmail-send-it' (on GNU/Linux and other Unix-like systems) or
`mailclient-send-it' (on Windows) to `sendmail-query-once'. This new
default will ask the user (once) whether to use the internal smtpmail
package to send email, or to use the old, external defaults.
** smtpmail changes
** smtpmail has been largely rewritten to upgrade to STARTTLS if
*** smtpmail has been largely rewritten to upgrade to STARTTLS if
possible, and uses the auth-source framework for getting credentials.
The rewrite should be largely compatible with previous versions of
smtpmail, but there are two major incompatibilities:
** `smtpmail-auth-credentials' no longer exists. That variable could
be either ~/.authinfo (in which case you're fine -- you won't see any
*** `smtpmail-auth-credentials' no longer exists. That variable used
to be be either ~/.authinfo (in which case you won't see any
difference), but if it were a direct list of user names and passwords,
you will be prompted for the user name and the password instead, and
they will then be saved to ~/.authinfo.
it will be ignored, and you will be prompted for the user name and the
password instead. They will then be saved to ~/.authinfo.
** Similarly, `smtpmail-starttls-credentials' no longer exists. If
you had thet set, then then you need to put
If you wish to copy over all the credentials from
`smtpmail-auth-credentials' to your ~/.authinfo file manually, instead
of letting smtpmail prompt you for these values, that's also possible.
machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert"
If you had, for instance,
(setq smtpmail-auth-credentials
'(("mail.example.org" 25 "jim" "s!cret")))
then the equivalent line in ~/.authinfo would be
machine mail.example.org port 25 login jim password s!cret
*** Similarly, `smtpmail-starttls-credentials' no longer exists. If
you had that set, then then you need to put
machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert
"~/.my_smtp_tls.cert"
in your ~/.authinfo file instead.

1
etc/themes/dichromacy-theme.el
View file

@ -72,7 +72,6 @@ Ansi-Color faces are included.")
`(font-lock-warning-face ((,class (:weight bold :slant italic
:foreground ,vermillion))))
;; Button and link faces
`(button ((,class (:underline t :foreground ,blue))))
`(link ((,class (:underline t :foreground ,blue))))
`(link-visited ((,class (:underline t :foreground ,redpurple))))
;; Gnus faces

1
etc/themes/tango-dark-theme.el
View file

@ -86,7 +86,6 @@ Semantic, and Ansi-Color faces are included.")
`(font-lock-variable-name-face ((,class (:foreground ,orange-1))))
`(font-lock-warning-face ((,class (:foreground ,red-0))))
;; Button and link faces
`(button ((,class (:underline t :foreground ,blue-1))))
`(link ((,class (:underline t :foreground ,blue-1))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces

1
etc/themes/tango-theme.el
View file

@ -77,7 +77,6 @@ Semantic, and Ansi-Color faces are included.")
`(font-lock-variable-name-face ((,class (:foreground ,orange-4))))
`(font-lock-warning-face ((,class (:foreground ,red-2))))
;; Button and link faces
`(button ((,class (:underline t :foreground ,blue-3))))
`(link ((,class (:underline t :foreground ,blue-3))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces

3
etc/themes/tsdh-dark-theme.el
View file

@ -33,6 +33,8 @@ Used and created by Tassilo Horn.")
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "dark red"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
'(gnus-button ((t (:inherit button))))
'(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold))))
'(header-line ((t (:inherit mode-line :inverse-video t))))
'(hl-line ((t (:background "grey28"))))
'(message-header-subject ((t (:foreground "SkyBlue"))))
@ -53,6 +55,7 @@ Used and created by Tassilo Horn.")
'(outline-6 ((t (:inherit font-lock-constant-face :weight bold))))
'(outline-7 ((t (:inherit font-lock-builtin-face :weight bold))))
'(outline-8 ((t (:inherit font-lock-string-face :weight bold))))
'(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold))))
'(region ((t (:background "SteelBlue4"))))
'(show-paren-match ((t (:background "DarkGreen"))))
'(show-paren-mismatch ((t (:background "deep pink"))))

3
etc/themes/tsdh-light-theme.el
View file

@ -33,6 +33,8 @@ Used and created by Tassilo Horn.")
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
'(gnus-button ((t (:inherit button))))
'(gnus-header-name ((t (:box (:line-width 1 :style released-button) :weight bold))))
'(header-line ((t (:inherit mode-line :inverse-video t))))
'(hl-line ((t (:background "grey95"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
@ -52,6 +54,7 @@ Used and created by Tassilo Horn.")
'(outline-6 ((t (:inherit font-lock-constant-face :weight bold))))
'(outline-7 ((t (:inherit font-lock-builtin-face :weight bold))))
'(outline-8 ((t (:inherit font-lock-string-face :weight bold))))
'(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold))))
'(region ((t (:background "lightgoldenrod1"))))
'(show-paren-match ((t (:background "LightCyan2"))))
'(show-paren-mismatch ((t (:background "deep pink"))))

1
etc/themes/wheatgrass-theme.el
View file

@ -47,7 +47,6 @@ of green, brown, and blue.")
`(font-lock-variable-name-face ((,class (:foreground "yellow green"))))
`(font-lock-warning-face ((,class (:foreground "salmon1"))))
;; Button and link faces
`(button ((,class (:underline t :foreground "cyan"))))
`(link ((,class (:underline t :foreground "cyan"))))
`(link-visited ((,class (:underline t :foreground "dark cyan"))))
;; Gnus faces

128
lisp/ChangeLog
View file

@ -1,3 +1,131 @@
2011-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail/sendmail.el (sendmail-query-once): If we aren't allowed to
save customizations (with "emacs -Q"), just set the variable
instead of erroring out.
* mail/smtpmail.el (smtpmail-query-smtp-server): Ditto.
2011-07-08 Juri Linkov <juri@jurta.org>
* arc-mode.el (archive-zip-expunge, archive-zip-update)
(archive-zip-update-case): Use 7z if found by `executable-find'.
The order of searching the available programs is the same as in
`archive-zip-extract' (bug#8968).
2011-07-07 Chong Yidong <cyd@stupidchicken.com>
* menu-bar.el (menu-bar-line-wrapping-menu): Revert last change.
(menu-bar-options-menu): Tweak descriptions.
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* menu-bar.el (menu-bar-line-wrapping-menu): Make all the Options
menu items into verb phrases (bug#1421). Also refill to fit under
80 columns.
2011-07-07 Chong Yidong <cyd@stupidchicken.com>
* info.el (info, Info-read-node-name-2, Info-read-node-name-1)
(Info-read-node-name): Doc fix (Bug#1084).
* thingatpt.el (forward-thing, bounds-of-thing-at-point)
(thing-at-point, beginning-of-thing, end-of-thing, in-string-p)
(end-of-sexp, beginning-of-sexp)
(thing-at-point-bounds-of-list-at-point, forward-whitespace)
(forward-symbol, forward-same-syntax, word-at-point)
(sentence-at-point): Doc fix (Bug#1144).
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* info.el (Info-mode-map): Remove S-TAB binding, since [backtab]
should cover it (bug#1281).
* cus-edit.el (custom-show): Marked as obsolete.
* net/network-stream.el (network-stream-open-starttls): If gnutls
negotiation fails, then possibly try again with a non-encrypted
connection (bug#9017).
* mail/smtpmail.el (smtpmail-stream-type): Note that `plain' can
be used.
2011-07-07 Richard Stallman <rms@gnu.org>
* mail/rmail.el (rmail-next-error-move): Use `compilation-message'
property, and handle its changed format.
Look for the correct line number.
Use file's line contents (but not past first =) to find
correct line in message.
2011-07-07 Kenichi Handa <handa@m17n.org>
* international/characters.el (build-unicode-category-table):
Delete it.
(unicode-category-table): Set it by
unicode-prroperty-table-internal.
* international/mule-cmds.el (char-code-property-alist): Moved to
to src/chartab.c.
(get-char-code-property): Call unicode-property-table-internal to
load a file. Call get-unicode-property-internal where necessary.
(put-char-code-property): Call unicode-property-table-internal to
load a file. Call put-unicode-property-internal where necessary.
put-unicode-property-internal where necessary.
(char-code-property-description): Call
unicode-property-table-internal to load a file.
* international/charprop.el:
* international/uni-bidi.el:
* international/uni-category.el:
* international/uni-combining.el:
* international/uni-comment.el:
* international/uni-decimal.el:
* international/uni-decomposition.el:
* international/uni-digit.el:
* international/uni-lowercase.el:
* international/uni-mirrored.el:
* international/uni-name.el:
* international/uni-numeric.el:
* international/uni-old-name.el:
* international/uni-titlecase.el:
* international/uni-uppercase.el: Regenerate.
* loadup.el: Load international/charprop.el before
international/characters.
2011-07-07 Chong Yidong <cyd@stupidchicken.com>
* window.el (next-buffer, previous-buffer): Signal an error if
called from a minibuffer window.
* bindings.el: Revert 2011-07-04 change.
2011-07-06 Richard Stallman <rms@gnu.org>
* mail/rmailmm.el (rmail-mime-process): Use markers for buf positions.
(rmail-mime-insert-bulk, rmail-mime-insert-text):
Treat markers like ints.
(rmail-mime-entity): Doc fix.
2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail/smtpmail.el (smtpmail-default-smtp-server): Made into a
defcustom again for backwards compatibility.
* simple.el (shell-command-on-region): Fill.
* dired-aux.el (dired-kill-line): Add a doc string.
* dabbrev.el (dabbrev-abbrev-char-regexp): Note that nil defaults
to "\\sw\\|\\s_" (bug#358).
* dired.el (dired-mode): Clarify "unmark or unflag" (bug#8770).
(dired-unmark-backward): Ditto.
(dired-flag-backup-files): Ditto.
* dired-x.el (dired-mark-sexp): Ditto.
2011-07-06 Richard Stallman <rms@gnu.org>
* mail/rmailmm.el: Give entity a new slot, TRUNCATED.

48
lisp/arc-mode.el
View file

@ -216,10 +216,10 @@ Archive and member name will be added."
;; Zip archive configuration
(defcustom archive-zip-extract
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
((executable-find "7z") '("7z" "x" "-so"))
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
((executable-find "7z") '("7z" "x" "-so"))
((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
(t '("unzip" "-qq" "-c")))
(t '("unzip" "-qq" "-c")))
"Program and its options to run in order to extract a zip file member.
Extraction should happen to standard output. Archive and member name will
be added."
@ -235,44 +235,44 @@ be added."
;; names.
(defcustom archive-zip-expunge
(if (and (not (executable-find "zip"))
(executable-find "pkzip"))
'("pkzip" "-d")
'("zip" "-d" "-q"))
(cond ((executable-find "zip") '("zip" "-d" "-q"))
((executable-find "7z") '("7z" "d"))
((executable-find "pkzip") '("pkzip" "-d"))
(t '("zip" "-d" "-q")))
"Program and its options to run in order to delete zip file members.
Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
(string :format "%v")))
(repeat :tag "Options"
:inline t
(string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-update
(if (and (not (executable-find "zip"))
(executable-find "pkzip"))
'("pkzip" "-u" "-P")
'("zip" "-q"))
(cond ((executable-find "zip") '("zip" "-q"))
((executable-find "7z") '("7z" "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q")))
"Program and its options to run in order to update a zip file member.
Options should ensure that specified directory will be put into the zip
file. Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
(string :format "%v")))
(repeat :tag "Options"
:inline t
(string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-update-case
(if (and (not (executable-find "zip"))
(executable-find "pkzip"))
'("pkzip" "-u" "-P")
'("zip" "-q" "-k"))
(cond ((executable-find "zip") '("zip" "-q" "-k"))
((executable-find "7z") '("7z" "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q" "-k")))
"Program and its options to run in order to update a case fiddled zip member.
Options should ensure that specified directory will be put into the zip file.
Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
(string :format "%v")))
(repeat :tag "Options"
:inline t
(string :format "%v")))
:group 'archive-zip)
(defcustom archive-zip-case-fiddle t

2
lisp/bindings.el
View file

@ -807,8 +807,6 @@ if `inhibit-field-text-motion' is non-nil."
(define-key map [up] 'previous-history-element)
(define-key map "\es" 'next-matching-history-element)
(define-key map "\er" 'previous-matching-history-element)
(define-key map [remap next-buffer] 'ignore)
(define-key map [remap previous-buffer] 'ignore)
;; Override the global binding (which calls indent-relative via
;; indent-for-tab-command). The alignment that indent-relative tries to
;; do doesn't make much sense here since the prompt messes it up.

2
lisp/cus-edit.el
View file

@ -1829,6 +1829,7 @@ item in another window.\n\n"))
;; We want simple widgets to be displayed by default, but complex
;; widgets to be hidden.
;; This widget type is obsolete as of Emacs 24.1.
(widget-put (get 'item 'widget-type) :custom-show t)
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
@ -2257,6 +2258,7 @@ and `face'."
(setq widget nil)))))
(widget-setup))
(make-obsolete 'custom-show "this widget type is no longer supported." "24.1")
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
(let ((show (widget-get widget :custom-show)))

3
lisp/dabbrev.el
View file

@ -206,7 +206,8 @@ starting with or containing `no-'. If you set this variable to
expanding `yes-or-no-' signals an error because `-' is not part of a word;
but expanding `yes-or-no' looks for a word starting with `no'.
The recommended value is \"\\\\sw\\\\|\\\\s_\"."
The recommended value is nil, which will make dabbrev default to
using \"\\\\sw\\\\|\\\\s_\"."
:type '(choice (const nil)
regexp)
:group 'dabbrev)

3
lisp/dired-aux.el
View file

@ -699,6 +699,9 @@ can be produced by `dired-get-marked-files', for example."
;; Commands that delete or redisplay part of the dired buffer.
(defun dired-kill-line (&optional arg)
"Kill the current line (not the files).
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills backward.)"
(interactive "P")
(setq arg (prefix-numeric-value arg))
(let (buffer-read-only file)

2
lisp/dired-x.el
View file

@ -1406,7 +1406,7 @@ Considers buffers closer to the car of `buffer-list' to be more recent."
(defun dired-mark-sexp (predicate &optional unflag-p)
"Mark files for which PREDICATE returns non-nil.
With a prefix arg, unflag those files instead.
With a prefix arg, unmark or unflag those files instead.
PREDICATE is a lisp expression that can refer to the following symbols:

21
lisp/dired.el
View file

@ -1812,7 +1812,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands.
Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
to see why something went wrong.
Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
Type \\[dired-unmark-backward] to back up one line and unflag.
Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'.
Type \\[dired-find-file] to Find the current line's file
(or dired it in another buffer, if it is a directory).
@ -3028,8 +3028,9 @@ If on a subdir headerline, mark all its files except `.' and `..'."
(dired-mark arg)))
(defun dired-unmark-backward (arg)
"In Dired, move up lines and remove deletion flag there.
Optional prefix ARG says how many lines to unflag; default is one line."
"In Dired, move up lines and remove marks or deletion flags there.
Optional prefix ARG says how many lines to unmark/unflag; default
is one line."
(interactive "p")
(dired-unmark (- arg)))
@ -3123,14 +3124,14 @@ The match is against the non-directory part of the filename. Use `^'
(defun dired-mark-symlinks (unflag-p)
"Mark all symbolic links.
With prefix argument, unflag all those files."
With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-sym) "symbolic link")))
(defun dired-mark-directories (unflag-p)
"Mark all directory file lines except `.' and `..'.
With prefix argument, unflag all those files."
With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (and (looking-at dired-re-dir)
@ -3139,7 +3140,7 @@ With prefix argument, unflag all those files."
(defun dired-mark-executables (unflag-p)
"Mark all executable files.
With prefix argument, unflag all those files."
With prefix argument, unmark or unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-exe) "executable file")))
@ -3149,7 +3150,7 @@ With prefix argument, unflag all those files."
(defun dired-flag-auto-save-files (&optional unflag-p)
"Flag for deletion files whose names suggest they are auto save files.
A prefix argument says to unflag those files instead."
A prefix argument says to unmark or unflag those files instead."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
(dired-mark-if
@ -3189,7 +3190,7 @@ A prefix argument says to unflag those files instead."
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
With prefix argument, unflag these files."
With prefix argument, unmark or unflag these files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@ -3642,7 +3643,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "d7b197829c8d456cc5bc6c5fdab7c4b0")
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "198ca311b49f0b6354f915502bba4ab6")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
@ -4103,7 +4104,7 @@ instead.
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
;;;;;; "dired-x" "dired-x.el" "cdeb2935dc1d33819b12981ba5272073")
;;;;;; "dired-x" "dired-x.el" "90459fb5998296fc67986945701b2bfc")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\

28
lisp/gnus/ChangeLog
View file

@ -1,3 +1,28 @@
2011-07-08 Daiki Ueno <ueno@unixuser.org>
* plstore.el: Revert the editing feature since it is not urgent.
(plstore-mode, plstore-mode-toggle-display, plstore-mode-original)
(plstore-mode-decoded): Remove.
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-msg.el (gnus-bug): Don't insert user variables. It usually
isn't very interesting any more, and it leaks potentially secret data.
(gnus-debug): Removed.
* gnus-art.el (gnus-ignored-headers): Removed obsolete and non-working
use of :custom-show.
2011-07-07 Daiki Ueno <ueno@unixuser.org>
* plstore.el: Add documentation.
(plstore-mode): New mode to edit plstore file.
(plstore-mode-toggle-display, plstore-mode-original)
(plstore-mode-decoded): New command.
(plstore--encode, plstore--decode, plstore--write-contents-functions)
(plstore--insert-buffer, plstore--make): New function.
(plstore-open, plstore-save): Simplify by using them.
2011-07-06 Glenn Morris <rgm@gnu.org>
* gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Silence compiler.
@ -34,6 +59,9 @@
2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-read-ephemeral-bug-group): Allow fetching several
bug reports at once.
* nnimap.el (nnimap-request-scan): Say that splitting has finished.
2011-07-04 Katsumi Yamaoka <yamaoka@jpl.org>

3
lisp/gnus/gnus-art.el
View file

@ -163,8 +163,7 @@
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
:type '(choice :custom-show nil
regexp
:type '(choice regexp
(repeat regexp))
:group 'gnus-article-hiding)

73
lisp/gnus/gnus-msg.el
View file

@ -1464,26 +1464,13 @@ If YANK is non-nil, include the original article."
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(insert (format "Package: %s\n" gnus-bug-package))
(insert (format "Version: %s\n" (gnus-continuum-version)))
(insert "\n")
(message-goto-body)
(insert "\n\n\n\n\n")
(insert (gnus-version) "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
(let (text)
(with-current-buffer (gnus-get-buffer-create " *gnus environment info*")
(erase-buffer)
(gnus-debug)
(setq text (buffer-string)))
(insert "<#part type=application/emacs-lisp "
"disposition=inline description=\"User settings\">\n"
text
"\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
@ -1503,62 +1490,6 @@ If YANK is non-nil, include the original article."
(with-current-buffer buffer
(message-yank-buffer gnus-article-buffer))))
(defun gnus-debug ()
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
(let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
;; Go through all the files looking for non-default values for variables.
(with-current-buffer (gnus-get-buffer-create " *gnus bug info*")
(while files
(erase-buffer)
(when (and (setq file (locate-library (pop files)))
(file-exists-p file))
(insert-file-contents file)
(goto-char (point-min))
(if (not (re-search-forward "^;;* *Internal variables" nil t))
(gnus-message 4 "Malformed sources in file %s" file)
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(ignore-errors
(and (or (eq (car expr) 'defvar)
(eq (car expr) 'defcustom))
(stringp (nth 3 expr))
(not (memq (nth 1 expr) gnus-debug-exclude-variables))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(symbol-value (nth 1 expr)))))
(push (nth 1 expr) olist)))))))
(kill-buffer (current-buffer)))
(when (setq olist (nreverse olist))
(insert "------------------ Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
(ignore-errors
(gnus-pp
`(setq ,(car olist)
,(if (or (consp (setq sym (symbol-value (car olist))))
(and (symbolp sym)
(not (or (eq sym nil)
(eq sym t)))))
(list 'quote (symbol-value (car olist)))
(symbol-value (car olist))))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
;; Remove any control chars - they seem to cause trouble for some
;; mailers. (Byte-compiled output from the stuff above.)
(goto-char point)
(while (re-search-forward (mm-string-to-multibyte
"[\000-\010\013-\037\200-\237]") nil t)
(replace-match (format "\\%03o" (string-to-char (match-string 0)))
t t))))
;;; Treatment of rejected articles.
;;; Bounced mail.

137
lisp/gnus/plstore.el
View file

@ -1,4 +1,4 @@
;;; plstore.el --- searchable, partially encrypted, persistent plist store -*- lexical-binding: t -*-
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@ -21,24 +21,51 @@
;;; Commentary
;; Plist based data store providing search and partial encryption.
;;
;; Creating:
;;
;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
;; ;; Both `:host' and `:port' are public property.
;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
;; ;; No encryption will be needed.
;; (plstore-save store)
;; ;; :user property is secret
;;
;; ;; `:user' is marked as secret.
;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
;; (plstore-put store "baz" '(:host "baz.example.org") '(:user "test"))
;; (plstore-save store) ;<= will ask passphrase via GPG
;; ;; `:password' is marked as secret.
;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test"))
;; ;; Those secret properties are encrypted together.
;; (plstore-save store)
;;
;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
;; (plstore-close store)
;;
;; Searching:
;;
;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
;;
;; ;; As the entry "foo" associated with "foo.example.org" has no
;; ;; secret properties, no need to decryption.
;; (plstore-find store '(:host ("foo.example.org")))
;; (plstore-find store '(:host ("bar.example.org"))) ;<= will ask passphrase via GPG
;;
;; ;; As the entry "bar" associated with "bar.example.org" has a
;; ;; secret property `:user', Emacs tries to decrypt the secret (and
;; ;; thus you will need to input passphrase).
;; (plstore-find store '(:host ("bar.example.org")))
;;
;; ;; While the entry "baz" associated with "baz.example.org" has also
;; ;; a secret property `:password', it is encrypted together with
;; ;; `:user' of "bar", so no need to decrypt the secret.
;; (plstore-find store '(:host ("bar.example.org")))
;;
;; (plstore-close store)
;;
;; Editing:
;;
;; Currently not supported but in the future plstore will provide a
;; major mode to edit PLSTORE files.
;;; Code:
@ -123,8 +150,8 @@ May either be a string or a list of strings.")
(defun plstore--get-merged-alist (this)
(aref this 4))
(defun plstore--set-file (this file)
(aset this 0 file))
(defun plstore--set-buffer (this buffer)
(aset this 0 buffer))
(defun plstore--set-alist (this plist)
(aset this 1 plist))
@ -141,6 +168,10 @@ May either be a string or a list of strings.")
(defun plstore-get-file (this)
(buffer-file-name (plstore--get-buffer this)))
(defun plstore--make (&optional buffer alist encrypted-data secret-alist
merged-alist)
(vector buffer alist encrypted-data secret-alist merged-alist))
(defun plstore--init-from-buffer (plstore)
(goto-char (point-min))
(when (looking-at ";;; public entries")
@ -156,16 +187,21 @@ May either be a string or a list of strings.")
;;;###autoload
(defun plstore-open (file)
"Create a plstore instance associated with FILE."
(with-current-buffer (find-file-noselect file)
;; make the buffer invisible from user
(rename-buffer (format " plstore %s" (buffer-file-name)))
(let ((store (vector
(current-buffer)
nil ;plist (plist)
nil ;encrypted data (string)
nil ;secret plist (plist)
nil ;merged plist (plist)
)))
(let* ((filename (file-truename file))
(buffer (or (find-buffer-visiting filename)
(generate-new-buffer (format " plstore %s" filename))))
(store (plstore--make buffer)))
(with-current-buffer buffer
;; In the future plstore will provide a major mode called
;; `plstore-mode' to edit PLSTORE files.
(if (eq major-mode 'plstore-mode)
(error "%s is opened for editing; kill the buffer first" file))
(erase-buffer)
(condition-case nil
(insert-file-contents-literally file)
(error))
(setq buffer-file-name (file-truename file))
(set-buffer-modified-p nil)
(plstore--init-from-buffer store)
store)))
@ -356,42 +392,45 @@ SECRET-KEYS is a plist containing secret data."
(delq entry (plstore--get-merged-alist plstore))))))
(defvar pp-escape-newlines)
(defun plstore--insert-buffer (plstore)
(insert ";;; public entries -*- mode: plstore -*- \n"
(pp-to-string (plstore--get-alist plstore)))
(if (plstore--get-secret-alist plstore)
(let ((context (epg-make-context 'OpenPGP))
(pp-escape-newlines nil)
(recipients
(cond
((listp plstore-encrypt-to) plstore-encrypt-to)
((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
cipher)
(epg-context-set-armor context t)
(epg-context-set-passphrase-callback
context
(cons #'plstore-passphrase-callback-function
plstore))
(setq cipher (epg-encrypt-string
context
(pp-to-string
(plstore--get-secret-alist plstore))
(if (or (eq plstore-select-keys t)
(and (null plstore-select-keys)
(not (local-variable-p 'plstore-encrypt-to
(current-buffer)))))
(epa-select-keys
context
"Select recipents for encryption.
If no one is selected, symmetric encryption will be performed. "
recipients)
(if plstore-encrypt-to
(epg-list-keys context recipients)))))
(goto-char (point-max))
(insert ";;; secret entries\n" (pp-to-string cipher)))))
(defun plstore-save (plstore)
"Save the contents of PLSTORE associated with a FILE."
(with-current-buffer (plstore--get-buffer plstore)
(erase-buffer)
(insert ";;; public entries -*- mode: emacs-lisp -*- \n"
(pp-to-string (plstore--get-alist plstore)))
(if (plstore--get-secret-alist plstore)
(let ((context (epg-make-context 'OpenPGP))
(pp-escape-newlines nil)
(recipients
(cond
((listp plstore-encrypt-to) plstore-encrypt-to)
((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
cipher)
(epg-context-set-armor context t)
(epg-context-set-passphrase-callback
context
(cons #'plstore-passphrase-callback-function
plstore))
(setq cipher (epg-encrypt-string
context
(pp-to-string
(plstore--get-secret-alist plstore))
(if (or (eq plstore-select-keys t)
(and (null plstore-select-keys)
(not (local-variable-p 'plstore-encrypt-to
(current-buffer)))))
(epa-select-keys
context
"Select recipents for encryption.
If no one is selected, symmetric encryption will be performed. "
recipients)
(if plstore-encrypt-to
(epg-list-keys context recipients)))))
(goto-char (point-max))
(insert ";;; secret entries\n" (pp-to-string cipher))))
(plstore--insert-buffer plstore)
(save-buffer)))
(provide 'plstore)

21
lisp/info.el
View file

@ -621,7 +621,7 @@ in `Info-file-supports-index-cookies-list'."
Optional argument FILE-OR-NODE specifies the file to examine;
the default is the top-level directory of Info.
Called from a program, FILE-OR-NODE may specify an Info node of the form
`(FILENAME)NODENAME'.
\"(FILENAME)NODENAME\".
Optional argument BUFFER specifies the Info buffer name;
the default buffer name is *info*. If BUFFER exists,
just switch to BUFFER. Otherwise, create a new buffer
@ -1572,7 +1572,12 @@ If FORK is a string, it is the name to use for the new buffer."
(defvar Info-read-node-completion-table)
(defun Info-read-node-name-2 (dirs suffixes string pred action)
"Virtual completion table for file names input in Info node names."
"Internal function used to complete Info node names.
Return a completion table for Info files---the FILENAME part of a
node named \"(FILENAME)NODENAME\". DIRS is a list of Info
directories to search if FILENAME is not absolute; SUFFIXES is a
list of valid filename suffixes for Info files. See
`try-completion' for a description of the remaining arguments."
(setq suffixes (remove "" suffixes))
(when (file-name-absolute-p string)
(setq dirs (list (file-name-directory string))))
@ -1602,10 +1607,9 @@ If FORK is a string, it is the name to use for the new buffer."
(push (if string-dir (concat string-dir file) file) names)))))
(complete-with-action action names string pred)))
;; This function is used as the "completion table" while reading a node name.
;; It does completion using the alist in Info-read-node-completion-table
;; unless STRING starts with an open-paren.
(defun Info-read-node-name-1 (string predicate code)
"Internal function used by `Info-read-node-name'.
See `completing-read' for a description of arguments and usage."
(cond
;; First complete embedded file names.
((string-match "\\`([^)]*\\'" string)
@ -1618,7 +1622,6 @@ If FORK is a string, it is the name to use for the new buffer."
(substring string 1)
predicate
code))
;; If a file name was given, then any node is fair game.
((string-match "\\`(" string)
(cond
@ -1630,9 +1633,10 @@ If FORK is a string, it is the name to use for the new buffer."
code Info-read-node-completion-table string predicate))))
;; Arrange to highlight the proper letters in the completion list buffer.
(defun Info-read-node-name (prompt)
"Read an Info node name with completion, prompting with PROMPT.
A node name can have the form \"NODENAME\", referring to a node
in the current Info file, or \"(FILENAME)NODENAME\"."
(let* ((completion-ignore-case t)
(Info-read-node-completion-table (Info-build-node-completions))
(nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
@ -3645,7 +3649,6 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "\C-m" 'Info-follow-nearest-node)
(define-key map "\t" 'Info-next-reference)
(define-key map "\e\t" 'Info-prev-reference)
(define-key map [(shift tab)] 'Info-prev-reference)
(define-key map [backtab] 'Info-prev-reference)
(define-key map "1" 'Info-nth-menu-item)
(define-key map "2" 'Info-nth-menu-item)

18
lisp/international/characters.el
View file

@ -1206,22 +1206,8 @@ Setup char-width-table appropriate for non-CJK language environment."
;;; Setting unicode-category-table.
;; This macro is to build unicode-category-table at compile time so
;; that C code can access the table efficiently.
(defmacro build-unicode-category-table ()
(let ((table (make-char-table 'unicode-category-table nil)))
(dotimes (i #x110000)
(if (or (< i #xD800)
(and (>= i #xF900) (< i #x30000))
(and (>= i #xE0000) (< i #xE0200)))
(aset table i (get-char-code-property i 'general-category))))
(set-char-table-range table '(#xE000 . #xF8FF) 'Co)
(set-char-table-range table '(#xF0000 . #xFFFFD) 'Co)
(set-char-table-range table '(#x100000 . #x10FFFD) 'Co)
(optimize-char-table table 'eq)
table))
(setq unicode-category-table (build-unicode-category-table))
(setq unicode-category-table
(unicode-property-table-internal 'general-category))
(map-char-table #'(lambda (key val)
(if (and val
(or (and (/= (aref (symbol-name val) 0) ?M)

13
lisp/international/charprop.el
View file

@ -1,8 +1,4 @@
;; Copyright (C) 1991-2010 Unicode, Inc.
;; This file was generated from the Unicode data file at
;; http://www.unicode.org/Public/UNIDATA/UnicodeData.txt.
;; See lisp/international/README for the copyright and permission notice.
;; Automatically generated by unidata-gen.el.
;; FILE: uni-name.el
(define-char-code-property 'name "uni-name.el"
"Unicode character name.
@ -45,7 +41,7 @@ Property value is an integer or a floating point.")
;; FILE: uni-mirrored.el
(define-char-code-property 'mirrored "uni-mirrored.el"
"Unicode bidi mirrored flag.
Property value is a symbol `Y' or `N'.")
Property value is a symbol `Y' or `N'. See also the property `mirroring'.")
;; FILE: uni-old-name.el
(define-char-code-property 'old-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
@ -66,6 +62,11 @@ Property value is a character.")
(define-char-code-property 'titlecase "uni-titlecase.el"
"Unicode simple titlecase mapping.
Property value is a character.")
;; FILE: uni-mirrored.el
(define-char-code-property 'mirroring "uni-mirrored.el"
"Unicode bidi-mirroring characters.
Property value is a character that has the corresponding mirroring image,
or nil for non-mirrored character.")
;; Local Variables:
;; coding: utf-8
;; no-byte-compile: t

47
lisp/international/mule-cmds.el
View file

@ -2709,16 +2709,6 @@ See also `locale-charset-language-names', `locale-language-names',
;;; Character property
;; Each element has the form (PROP . TABLE).
;; PROP is a symbol representing a character property.
;; TABLE is a char-table containing the property value for each character.
;; TABLE may be a name of file to load to build a char-table.
;; Don't modify this variable directly but use `define-char-code-property'.
(defvar char-code-property-alist nil
"Alist of character property name vs char-table containing property values.
Internal use only.")
(put 'char-code-property-table 'char-table-extra-slots 5)
(defun define-char-code-property (name table &optional docstring)
@ -2770,32 +2760,23 @@ See also the documentation of `get-char-code-property' and
(defun get-char-code-property (char propname)
"Return the value of CHAR's PROPNAME property."
(let ((slot (assq propname char-code-property-alist)))
(if slot
(let (table value func)
(if (stringp (cdr slot))
(load (cdr slot) nil t))
(setq table (cdr slot)
value (aref table char)
func (char-table-extra-slot table 1))
(let ((table (unicode-property-table-internal propname)))
(if table
(let ((func (char-table-extra-slot table 1)))
(if (functionp func)
(setq value (funcall func char value table)))
value)
(funcall func char (aref table char) table)
(get-unicode-property-internal table char)))
(plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
"Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
(let ((slot (assq propname char-code-property-alist)))
(if slot
(let (table func)
(if (stringp (cdr slot))
(load (cdr slot) nil t))
(setq table (cdr slot)
func (char-table-extra-slot table 2))
(let ((table (unicode-property-table-internal propname)))
(if table
(let ((func (char-table-extra-slot table 2)))
(if (functionp func)
(funcall func char value table)
(aset table char value)))
(put-unicode-property-internal table char value)))
(let* ((plist (aref char-code-property-table char))
(x (plist-put plist propname value)))
(or (eq x plist)
@ -2805,13 +2786,9 @@ It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
(defun char-code-property-description (prop value)
"Return a description string of character property PROP's value VALUE.
If there's no description string for VALUE, return nil."
(let ((slot (assq prop char-code-property-alist)))
(if slot
(let (table func)
(if (stringp (cdr slot))
(load (cdr slot) nil t))
(setq table (cdr slot)
func (char-table-extra-slot table 3))
(let ((table (unicode-property-table-internal prop)))
(if table
(let ((func (char-table-extra-slot table 3)))
(if (functionp func)
(funcall func value))))))

BIN
lisp/international/uni-bidi.el
View file

Binary file not shown.

BIN
lisp/international/uni-category.el
View file

Binary file not shown.

BIN
lisp/international/uni-combining.el
View file

Binary file not shown.

BIN
lisp/international/uni-comment.el
View file

Binary file not shown.

BIN
lisp/international/uni-decimal.el
View file

Binary file not shown.

BIN
lisp/international/uni-decomposition.el
View file

Binary file not shown.

BIN
lisp/international/uni-digit.el
View file

Binary file not shown.

BIN
lisp/international/uni-lowercase.el
View file

Binary file not shown.

BIN
lisp/international/uni-mirrored.el
View file

Binary file not shown.

BIN
lisp/international/uni-name.el
View file

Binary file not shown.

BIN
lisp/international/uni-numeric.el
View file

Binary file not shown.

BIN
lisp/international/uni-old-name.el
View file

Binary file not shown.

BIN
lisp/international/uni-titlecase.el
View file

Binary file not shown.

BIN
lisp/international/uni-uppercase.el
View file

Binary file not shown.

4
lisp/loadup.el
View file

@ -123,11 +123,11 @@
;; multilingual text.
(load "international/mule-cmds")
(load "case-table")
(load "international/characters")
(load "composite")
;; This file doesn't exist when building a development version of Emacs
;; from the repository. It is generated just after temacs is built.
(load "international/charprop.el" t)
(load "international/characters")
(load "composite")
;; Load language-specific files.
(load "language/chinese")

44
lisp/mail/rmail.el
View file

@ -3025,9 +3025,13 @@ or forward if N is negative."
MSG-POS is a marker pointing at the error message in the grep buffer.
BAD-MARKER is a marker that ought to point at where to move to,
but probably is garbage."
(let* ((message (car (get-text-property msg-pos 'message (marker-buffer msg-pos))))
(column (car message))
(linenum (cadr message))
(let* ((message-loc (compilation--message->loc
(get-text-property msg-pos 'compilation-message
(marker-buffer msg-pos))))
(column (car message-loc))
(linenum (cadr message-loc))
line-text
pos
msgnum msgbeg msgend
header-field
@ -3041,10 +3045,18 @@ but probably is garbage."
(save-excursion
;; Find the line that the error message points at.
(goto-char (point-min))
(forward-line linenum)
(forward-line (1- linenum))
(setq pos (point))
;; Find which message that's in,
;; Find the text at the start of the line,
;; before the first = sign.
;; This text has a good chance of being also in the
;; decoded message.
(save-excursion
(skip-chars-forward "^=\n")
(setq line-text (buffer-substring pos (point))))
;; Find which message this position is in,
;; and the limits of that message.
(setq msgnum (rmail-what-message pos))
(setq msgbeg (rmail-msgbeg msgnum))
@ -3071,11 +3083,23 @@ but probably is garbage."
(rmail-show-message msgnum)
;; Move to the right position within the displayed message.
;; Or at least try. The decoded message's lines may not
;; correspond to the lines in the inbox file.
(goto-char (point-min))
(if header-field
(re-search-forward (concat "^" (regexp-quote header-field)) nil t)
(search-forward "\n\n" nil t))
(forward-line line-number-within)
(forward-char column)))
(progn
(re-search-forward (concat "^" (regexp-quote header-field)) nil t)
(forward-line line-number-within))
(search-forward "\n\n" nil t)
(if (re-search-forward (concat "^" (regexp-quote line-text)) nil t)
(goto-char (match-beginning 0))))
(if (eobp)
;; If the decoded message doesn't have enough lines,
;; go to the beginning rather than the end.
(goto-char (point-min))
;; Otherwise, go to the right column.
(if column
(forward-char column)))))
(defun rmail-what-message (&optional pos)
"Return message number POS (or point) is in."
@ -4379,7 +4403,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "30ab95e291380f184dff5fa6cde75520")
;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "a7d3e7205efa4e20ca9038c9b260ce83")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\

23
lisp/mail/rmailmm.el
View file

@ -193,8 +193,8 @@ has these values:
raw: displayed by the raw MIME data (for the header and body only)
HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
END specify the region of the header or body lines in RMAIL's
data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
END are markers that specify the region of the header or body lines
in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
header or body is, by default, displayed by the decoded
presentation form.
@ -547,7 +547,7 @@ HEADER is a header component of a MIME-entity object (see
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
(or (integerp (aref body 0))
(or (integerp (aref body 0)) (markerp (aref body 0))
(let ((data (buffer-string)))
(aset body 0 data)
(delete-region (point-min) (point-max))))
@ -704,7 +704,7 @@ directly."
(segment (rmail-mime-entity-segment (point) entity))
beg data size)
(if (integerp (aref body 0))
(if (or (integerp (aref body 0)) (markerp (aref body 0)))
(setq data entity
size (car bulk-data))
(if (stringp (aref body 0))
@ -1129,9 +1129,10 @@ modified."
(if parse-tag
(let* ((is-inline (string= (car content-disposition) "inline"))
(header (vector (point-min) end nil))
(hdr-end (copy-marker end))
(header (vector (point-min-marker) hdr-end nil))
(tagline (vector parse-tag (cons nil nil) t))
(body (vector end (point-max) is-inline))
(body (vector hdr-end (point-max-marker) is-inline))
(new (vector (aref header 2) (aref tagline 2) (aref body 2)))
children handler entity)
(cond ((string-match "multipart/.*" (car content-type))
@ -1180,11 +1181,11 @@ modified."
;; Hide headers and handle the part.
(put-text-property (point-min) (point-max) 'rmail-mime-entity
(rmail-mime-entity
content-type content-disposition
content-transfer-encoding
(vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
(vector nil nil 'raw) (vector "" (cons nil nil) nil)
(vector nil nil 'raw) nil nil))
content-type content-disposition
content-transfer-encoding
(vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
(vector nil nil 'raw) (vector "" (cons nil nil) nil)
(vector nil nil 'raw) nil nil))
(save-restriction
(cond ((string= (car content-type) "message/rfc822")
(narrow-to-region end (point-max)))

68
lisp/mail/sendmail.el
View file

@ -168,44 +168,48 @@ This is used by the default mail-sending commands. See also
(defvar sendmail-query-once-function 'query
"Either a function to send email, or the symbol `query'.")
(autoload 'custom-file "cus-edit")
;;;###autoload
(defun sendmail-query-once ()
"Send an email via `sendmail-query-once-function'.
If `sendmail-query-once-function' is `query', ask the user what
function to use, and then save that choice."
(when (equal sendmail-query-once-function 'query)
(let ((default
(cond
((or (and window-system (eq system-type 'darwin))
(eq system-type 'windows-nt))
'mailclient-send-it)
((and sendmail-program
(executable-find sendmail-program))
'sendmail-send-it))))
(customize-save-variable
'sendmail-query-once-function
(if (or (not default)
;; We have detected no OS-level mail senders, or we
;; have already configured smtpmail, so we use the
;; internal SMTP service.
(and (boundp 'smtpmail-smtp-server)
smtpmail-smtp-server))
'smtpmail-send-it
;; Query the user.
(unwind-protect
(progn
(pop-to-buffer "*Mail Help*")
(erase-buffer)
(insert "Sending mail from Emacs hasn't been set up yet.\n\n"
"Type `y' to configure outgoing SMTP, or `n' to use\n"
"the default mail sender on your system.\n\n"
"To change this again at a later date, customize the\n"
"`send-mail-function' variable.\n")
(goto-char (point-min))
(if (y-or-n-p "Configure outgoing SMTP in Emacs? ")
'smtpmail-send-it
default))
(kill-buffer (current-buffer)))))))
(let* ((default
(cond
((or (and window-system (eq system-type 'darwin))
(eq system-type 'windows-nt))
'mailclient-send-it)
((and sendmail-program
(executable-find sendmail-program))
'sendmail-send-it)))
(function
(if (or (not default)
;; We have detected no OS-level mail senders, or we
;; have already configured smtpmail, so we use the
;; internal SMTP service.
(and (boundp 'smtpmail-smtp-server)
smtpmail-smtp-server))
'smtpmail-send-it
;; Query the user.
(unwind-protect
(progn
(pop-to-buffer "*Mail Help*")
(erase-buffer)
(insert "Sending mail from Emacs hasn't been set up yet.\n\n"
"Type `y' to configure outgoing SMTP, or `n' to use\n"
"the default mail sender on your system.\n\n"
"To change this again at a later date, customize the\n"
"`send-mail-function' variable.\n")
(goto-char (point-min))
(if (y-or-n-p "Configure outgoing SMTP in Emacs? ")
'smtpmail-send-it
default))
(kill-buffer (current-buffer))))))
(if (ignore-errors (custom-file))
(customize-save-variable 'sendmail-query-once-function function)
(setq sendmail-query-once-function function))))
(funcall sendmail-query-once-function))
;;;###autoload(custom-initialize-delay 'send-mail-function nil)

27
lisp/mail/smtpmail.el
View file

@ -71,9 +71,11 @@
:group 'mail)
(defvar smtpmail-default-smtp-server nil
(defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library.")
This only has effect if you specify it before loading the smtpmail library."
:type '(choice (const nil) string)
:group 'smtpmail)
(defcustom smtpmail-smtp-server
(or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
@ -96,13 +98,14 @@ don't define this value."
(defcustom smtpmail-stream-type nil
"Connection type SMTP connections.
This may be either nil (plain connection) or `starttls' (use the
starttls mechanism to turn on TLS security after opening the
stream)."
This may be either nil (possibly upgraded to STARTTLS if
possible), or `starttls' (refuse to send if STARTTLS isn't
available), or `plain' (never use STARTTLS).."
:version "24.1"
:group 'smtpmail
:type '(choice (const :tag "Plain" nil)
(const starttls)))
:type '(choice (const :tag "Possibly upgrade to STARTTLS" nil)
(const :tag "Always use STARTTLS" starttls)
(const :tag "Never use STARTTLS" plain)))
(defcustom smtpmail-sendto-domain nil
"Local domain name without a host name.
@ -584,6 +587,8 @@ The list is in preference order.")
(defun smtpmail-response-text (response)
(mapconcat 'identity (cdr response) "\n"))
(autoload 'custom-file "cus-edit")
(defun smtpmail-query-smtp-server ()
(let ((server (read-string "Outgoing SMTP mail server: "))
(ports '(587 "smtp"))
@ -595,8 +600,12 @@ The list is in preference order.")
(setq port (pop ports)))
(when (setq stream (ignore-errors
(open-network-stream "smtp" nil server port)))
(customize-save-variable 'smtpmail-smtp-server server)
(customize-save-variable 'smtpmail-smtp-service port)
(if (ignore-errors (custom-file))
(progn
(customize-save-variable 'smtpmail-smtp-server server)
(customize-save-variable 'smtpmail-smtp-service port))
(setq smtpmail-smtp-server server
smtpmail-smtp-service port))
(delete-process stream)))
(unless smtpmail-smtp-server
(error "Couldn't contact an SMTP server"))))

129
lisp/menu-bar.el
View file

@ -1135,17 +1135,18 @@ mail status in mode line"))
(let ((menu (make-sparse-keymap "Line Wrapping")))
(define-key menu [word-wrap]
`(menu-item ,(purecopy "Word Wrap (Visual Line mode)")
(lambda ()
(interactive)
(unless visual-line-mode
(visual-line-mode 1))
(message ,(purecopy "Visual-Line mode enabled")))
:help ,(purecopy "Wrap long lines at word boundaries")
:button (:radio . (and (null truncate-lines)
(not (truncated-partial-width-window-p))
word-wrap))
:visible (menu-bar-menu-frame-live-and-visible-p)))
`(menu-item
,(purecopy "Word Wrap (Visual Line mode)")
(lambda ()
(interactive)
(unless visual-line-mode
(visual-line-mode 1))
(message ,(purecopy "Visual-Line mode enabled")))
:help ,(purecopy "Wrap long lines at word boundaries")
:button (:radio . (and (null truncate-lines)
(not (truncated-partial-width-window-p))
word-wrap))
:visible (menu-bar-menu-frame-live-and-visible-p)))
(define-key menu [truncate]
`(menu-item ,(purecopy "Truncate Long Lines")
@ -1238,78 +1239,88 @@ mail status in mode line"))
menu-bar-separator)
(define-key menu [blink-cursor-mode]
(menu-bar-make-mm-toggle blink-cursor-mode
"Blinking Cursor"
"Whether the cursor blinks (Blink Cursor mode)"))
(menu-bar-make-mm-toggle
blink-cursor-mode
"Blink Cursor"
"Whether the cursor blinks (Blink Cursor mode)"))
(define-key menu [cursor-separator]
menu-bar-separator)
(define-key menu [save-place]
(menu-bar-make-toggle toggle-save-place-globally save-place
"Save Place in Files between Sessions"
"Saving place in files %s"
"Visit files of previous session when restarting Emacs"
(require 'saveplace)
;; Do it by name, to avoid a free-variable
;; warning during byte compilation.
(set-default
'save-place (not (symbol-value 'save-place)))))
(menu-bar-make-toggle
toggle-save-place-globally save-place
"Save Place in Files between Sessions"
"Saving place in files %s"
"Visit files of previous session when restarting Emacs"
(require 'saveplace)
;; Do it by name, to avoid a free-variable
;; warning during byte compilation.
(set-default
'save-place (not (symbol-value 'save-place)))))
(define-key menu [uniquify]
(menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
"Uniquify buffer names by adding parent directory names"
(require 'uniquify)
(setq uniquify-buffer-name-style
(if (not uniquify-buffer-name-style)
'forward))))
(menu-bar-make-toggle
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
"Uniquify buffer names by adding parent directory names"
(require 'uniquify)
(setq uniquify-buffer-name-style
(if (not uniquify-buffer-name-style)
'forward))))
(define-key menu [edit-options-separator]
menu-bar-separator)
(define-key menu [cua-mode]
(menu-bar-make-mm-toggle cua-mode
"C-x/C-c/C-v Cut and Paste (CUA)"
"Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
(menu-bar-make-mm-toggle
cua-mode
"Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
"Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
(define-key menu [cua-emulation-mode]
(menu-bar-make-mm-toggle cua-mode
"Shift movement mark region (CUA)"
"Use shifted movement keys to set and extend the region"
(:visible (and (boundp 'cua-enable-cua-keys)
(not cua-enable-cua-keys)))))
(menu-bar-make-mm-toggle
cua-mode
"Shift movement mark region (CUA)"
"Use shifted movement keys to set and extend the region"
(:visible (and (boundp 'cua-enable-cua-keys)
(not cua-enable-cua-keys)))))
(define-key menu [case-fold-search]
(menu-bar-make-toggle toggle-case-fold-search case-fold-search
"Case-Insensitive Search"
"Case-Insensitive Search %s"
"Ignore letter-case in search commands"))
(menu-bar-make-toggle
toggle-case-fold-search case-fold-search
"Ignore Case for Search"
"Case-Insensitive Search %s"
"Ignore letter-case in search commands"))
(define-key menu [auto-fill-mode]
`(menu-item ,(purecopy "Auto Fill in Text Modes")
menu-bar-text-mode-auto-fill
:help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
:button (:toggle . (if (listp text-mode-hook)
(member 'turn-on-auto-fill text-mode-hook)
(eq 'turn-on-auto-fill text-mode-hook)))))
`(menu-item
,(purecopy "Auto Fill in Text Modes")
menu-bar-text-mode-auto-fill
:help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
:button (:toggle . (if (listp text-mode-hook)
(member 'turn-on-auto-fill text-mode-hook)
(eq 'turn-on-auto-fill text-mode-hook)))))
(define-key menu [line-wrapping]
`(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu))
`(menu-item ,(purecopy "Line Wrapping in this Buffer")
,menu-bar-line-wrapping-menu))
(define-key menu [highlight-separator]
menu-bar-separator)
(define-key menu [highlight-paren-mode]
(menu-bar-make-mm-toggle show-paren-mode
"Paren Match Highlighting"
"Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
(menu-bar-make-mm-toggle
show-paren-mode
"Highlight Matching Parentheses"
"Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
(define-key menu [transient-mark-mode]
(menu-bar-make-mm-toggle transient-mark-mode
"Active Region Highlighting"
"Make text in active region stand out in color (Transient Mark mode)"
(:enable (not cua-mode))))
(menu-bar-make-mm-toggle
transient-mark-mode
"Highlight Active Region"
"Make text in active region stand out in color (Transient Mark mode)"
(:enable (not cua-mode))))
menu))

12
lisp/net/network-stream.el
View file

@ -263,8 +263,16 @@ functionality.
;; The server said it was OK to begin STARTTLS negotiations.
(if builtin-starttls
(let ((cert (network-stream-certificate host service parameters)))
(gnutls-negotiate :process stream :hostname host
:keylist (and cert (list cert))))
(condition-case nil
(gnutls-negotiate :process stream :hostname host
:keylist (and cert (list cert)))
;; If we get a gnutls-specific error (for instance if
;; the certificate the server gives us is completely
;; syntactically invalid), then close the connection
;; and possibly (further down) try to create a
;; non-encrypted connection.
(gnutls-error
(delete-process stream))))
(unless (starttls-negotiate stream)
(delete-process stream)))
(if (memq (process-status stream) '(open run))

3
lisp/simple.el
View file

@ -2533,7 +2533,8 @@ specifies the value of ERROR-BUFFER."
(< 0 (nth 7 (file-attributes error-file))))
(format "some error output%s"
(if shell-command-default-error-buffer
(format " to the \"%s\" buffer" shell-command-default-error-buffer)
(format " to the \"%s\" buffer"
shell-command-default-error-buffer)
""))
"no output")))
(cond ((null exit-status)

62
lisp/thingatpt.el
View file

@ -55,7 +55,11 @@
;;;###autoload
(defun forward-thing (thing &optional n)
"Move forward to the end of the Nth next THING."
"Move forward to the end of the Nth next THING.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`line', and `page'."
(let ((forward-op (or (get thing 'forward-op)
(intern-soft (format "forward-%s" thing)))))
(if (functionp forward-op)
@ -67,15 +71,16 @@
;;;###autoload
(defun bounds-of-thing-at-point (thing)
"Determine the start and end buffer locations for the THING at point.
THING is a symbol which specifies the kind of syntactic entity you want.
Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
`email', `word', `sentence', `whitespace', `line', `page' and others.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`line', and `page'.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING.
See the file `thingatpt.el' for documentation on how to define a
valid THING.
The value is a cons cell (START . END) giving the start and end positions
of the textual entity that was found."
Return a cons cell (START . END) giving the start and end
positions of the thing found."
(if (get thing 'bounds-of-thing-at-point)
(funcall (get thing 'bounds-of-thing-at-point))
(let ((orig (point)))
@ -125,9 +130,10 @@ of the textual entity that was found."
;;;###autoload
(defun thing-at-point (thing)
"Return the THING at point.
THING is a symbol which specifies the kind of syntactic entity you want.
Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
`email', `word', `sentence', `whitespace', `line', `page' and others.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`line', and `page'.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
@ -140,11 +146,15 @@ a symbol as a valid THING."
;; Go to beginning/end
(defun beginning-of-thing (thing)
"Move point to the beginning of THING.
The bounds of THING are determined by `bounds-of-thing-at-point'."
(let ((bounds (bounds-of-thing-at-point thing)))
(or bounds (error "No %s here" thing))
(goto-char (car bounds))))
(defun end-of-thing (thing)
"Move point to the end of THING.
The bounds of THING are determined by `bounds-of-thing-at-point'."
(let ((bounds (bounds-of-thing-at-point thing)))
(or bounds (error "No %s here" thing))
(goto-char (cdr bounds))))
@ -162,12 +172,16 @@ a symbol as a valid THING."
;; Sexps
(defun in-string-p ()
"Return non-nil if point is in a string.
\[This is an internal function.]"
(let ((orig (point)))
(save-excursion
(beginning-of-defun)
(nth 3 (parse-partial-sexp (point) orig)))))
(defun end-of-sexp ()
"Move point to the end of the current sexp.
\[This is an internal function.]"
(let ((char-syntax (char-syntax (char-after))))
(if (or (eq char-syntax ?\))
(and (eq char-syntax ?\") (in-string-p)))
@ -177,6 +191,8 @@ a symbol as a valid THING."
(put 'sexp 'end-op 'end-of-sexp)
(defun beginning-of-sexp ()
"Move point to the beginning of the current sexp.
\[This is an internal function.]"
(let ((char-syntax (char-syntax (char-before))))
(if (or (eq char-syntax ?\()
(and (eq char-syntax ?\") (in-string-p)))
@ -190,6 +206,8 @@ a symbol as a valid THING."
(put 'list 'bounds-of-thing-at-point 'thing-at-point-bounds-of-list-at-point)
(defun thing-at-point-bounds-of-list-at-point ()
"Return the bounds of the list at point.
\[Internal function used by `bounds-of-thing-at-point'.]"
(save-excursion
(let ((opoint (point))
(beg (condition-case nil
@ -397,6 +415,11 @@ with angle brackets.")
;; Whitespace
(defun forward-whitespace (arg)
"Move point to the end of the next sequence of whitespace chars.
Each such sequence may be a single newline, or a sequence of
consecutive space and/or tab characters.
With prefix argument ARG, do it ARG times if positive, or move
backwards ARG times if negative."
(interactive "p")
(if (natnump arg)
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
@ -414,6 +437,11 @@ with angle brackets.")
;; Symbols
(defun forward-symbol (arg)
"Move point to the next position that is the end of a symbol.
A symbol is any sequence of characters that are in either the
word constituent or symbol constituent syntax class.
With prefix argument ARG, do it ARG times if positive, or move
backwards ARG times if negative."
(interactive "p")
(if (natnump arg)
(re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
@ -425,6 +453,9 @@ with angle brackets.")
;; Syntax blocks
(defun forward-same-syntax (&optional arg)
"Move point past all characters with the same syntax class.
With prefix argument ARG, do it ARG times if positive, or move
backwards ARG times if negative."
(interactive "p")
(while (< arg 0)
(skip-syntax-backward
@ -436,8 +467,13 @@ with angle brackets.")
;; Aliases
(defun word-at-point () (thing-at-point 'word))
(defun sentence-at-point () (thing-at-point 'sentence))
(defun word-at-point ()
"Return the word at point. See `thing-at-point'."
(thing-at-point 'word))
(defun sentence-at-point ()
"Return the sentence at point. See `thing-at-point'."
(thing-at-point 'sentence))
(defun read-from-whole-string (str)
"Read a Lisp expression from STR.

4
lisp/window.el
View file

@ -2819,11 +2819,15 @@ displayed there."
(defun next-buffer ()
"In selected window switch to next buffer."
(interactive)
(if (window-minibuffer-p)
(error "Cannot switch buffers in minibuffer window"))
(switch-to-next-buffer))
(defun previous-buffer ()
"In selected window switch to previous buffer."
(interactive)
(if (window-minibuffer-p)
(error "Cannot switch buffers in minibuffer window"))
(switch-to-prev-buffer))
(defun delete-windows-on (&optional buffer-or-name frame)

107
src/ChangeLog
View file

@ -1,4 +1,4 @@
2011-07-06 Paul Eggert <eggert@cs.ucla.edu>
2011-07-08 Paul Eggert <eggert@cs.ucla.edu>
Use pthread_sigmask, not sigprocmask (Bug#9010).
* callproc.c (Fcall_process):
@ -7,6 +7,111 @@
sigprocmask is portable only for single-threaded applications, and
Emacs can be multi-threaded when it uses GTK.
2011-07-08 Jan Djärv <jan.h.d@swipnet.se>
* nsgui.h: Fix compiler warning about gnulib redefining verify.
* nsselect.m (ns_get_local_selection): Change to extern (Bug#8842).
* nsmenu.m (ns_update_menubar): Remove useless setDelegate call
on svcsMenu (Bug#8842).
* nsfns.m (Fx_open_connection): Remove NSStringPboardType from
ns_return_types.
(Fns_list_services): Just return Qnil on 10.6, code not working there.
* nsterm.m (QUTF8_STRING): Declare.
(initFrameFromEmacs): Call registerServicesMenuSendTypes.
(validRequestorForSendType): Return type is (id).
Change indexOfObjectIdenticalTo to indexOfObject.
Check if we have local selection before returning self (Bug#8842).
(writeSelectionToPasteboard): Put local selection into paste board
if we have a local selection (Bug#8842).
(syms_of_nsterm): DEFSYM QUTF8_STRING.
* nsterm.h (MAC_OS_X_VERSION_10_6): Define here instead of nsterm.m.
(ns_get_local_selection): Declare.
2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* keymap.c (describe_map_tree): Don't insert a double newline at
the end of the buffer (bug#1169) and return whether we inserted
something.
* callint.c (Fcall_interactively): Change "reading args" to
"providing args" to try to clarify what it does (bug#1010).
2011-07-07 Kenichi Handa <handa@m17n.org>
* composite.c (composition_compute_stop_pos): Ignore a static
composition starting before CHARPOS (Bug#8915).
* xdisp.c (handle_composition_prop): Likewise.
2011-07-07 Eli Zaretskii <eliz@gnu.org>
* term.c (produce_glyphs) <xassert>: Allow IT_GLYPHLESS in it->what.
(Bug#9015)
2011-07-07 Kenichi Handa <handa@m17n.org>
* character.h (unicode_category_t): New enum type.
* chartab.c (uniprop_decoder_t, uniprop_encoder_t): New types.
(Qchar_code_property_table): New variable.
(UNIPROP_TABLE_P, UNIPROP_GET_DECODER)
(UNIPROP_COMPRESSED_FORM_P): New macros.
(char_table_ascii): Uncompress the compressed values.
(sub_char_table_ref): New arg is_uniprop. Callers changed.
Uncompress the compressed values.
(sub_char_table_ref_and_range): Likewise.
(char_table_ref_and_range): Uncompress the compressed values.
(sub_char_table_set): New arg is_uniprop. Callers changed.
Uncompress the compressed values.
(sub_char_table_set_range): Args changed. Callers changed.
(char_table_set_range): Adjuted for the above change.
(map_sub_char_table): Delete args default_val and parent. Add arg
top. Give decoded values to a Lisp function.
(map_char_table): Adjusted for the above change. Give decoded
values to a Lisp function. Gcpro more variables.
(uniprop_table_uncompress)
(uniprop_decode_value_run_length): New functions.
(uniprop_decoder, uniprop_decoder_count): New variables.
(uniprop_get_decoder, uniprop_encode_value_character)
(uniprop_encode_value_run_length, uniprop_encode_value_numeric):
New functions.
(uniprop_encoder, uniprop_encoder_count): New variables.
(uniprop_get_encoder, uniprop_table)
(Funicode_property_table_internal, Fget_unicode_property_internal)
(Fput_unicode_property_internal): New functions.
(syms_of_chartab): DEFSYM Qchar_code_property_table, defsubr
Sunicode_property_table_internal, Sget_unicode_property_internal,
and Sput_unicode_property_internal. Defvar_lisp
char-code-property-alist.
* composite.c (CHAR_COMPOSABLE_P): Adjusted for the change of
Vunicode_category_table.
* font.c (font_range): Adjusted for the change of
Vunicode_category_table.
2011-07-07 Dan Nicolaescu <dann@ics.uci.edu>
* m/iris4d.h: Remove file, move contents ...
* s/irix6-5.h: ... here.
2011-07-06 Paul Eggert <eggert@cs.ucla.edu>
Remove unportable assumption about struct layout (Bug#8884).
* alloc.c (mark_buffer):
* buffer.c (reset_buffer_local_variables, Fbuffer_local_variables)
(clone_per_buffer_values): Don't assume that
sizeof (struct buffer) is a multiple of sizeof (Lisp_Object).
This isn't true in general, and it's particularly not true
if Emacs is configured with --with-wide-int.
* buffer.h (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER):
New macros, used in the buffer.c change.
2011-07-05 Jan Djärv <jan.h.d@swipnet.se>
* xsettings.c: Use both GConf and GSettings if both are available.

3
src/alloc.c
View file

@ -5619,7 +5619,8 @@ mark_buffer (Lisp_Object buf)
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr <= &PER_BUFFER_VALUE (buffer,
PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
ptr++)
mark_object (*ptr);

12
src/buffer.c
View file

@ -471,8 +471,8 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to)
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
offset < sizeof *to;
for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
offset += sizeof (Lisp_Object))
{
Lisp_Object obj;
@ -830,8 +830,8 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too)
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
offset < sizeof *b;
for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
offset += sizeof (Lisp_Object))
{
int idx = PER_BUFFER_IDX (offset);
@ -1055,8 +1055,8 @@ No argument or nil as argument means use current buffer as BUFFER. */)
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
offset < sizeof (struct buffer);
for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
/* sizeof EMACS_INT == sizeof Lisp_Object */
offset += (sizeof (EMACS_INT)))
{

4
src/buffer.h
View file

@ -612,6 +612,7 @@ struct buffer
/* Everything from here down must be a Lisp_Object. */
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
#define FIRST_FIELD_PER_BUFFER undo_list
/* Changes in the buffer are recorded here for undo.
t means don't record anything.
@ -846,6 +847,9 @@ struct buffer
t means to use hollow box cursor.
See `cursor-type' for other values. */
Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
/* This must be the last field in the above list. */
#define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows
};

2
src/callint.c
View file

@ -234,7 +234,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
}
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
doc: /* Call FUNCTION, reading args according to its interactive calling specs.
doc: /* Call FUNCTION, providing args according to its interactive calling specs.
Return the value FUNCTION returns.
The function contains a specification of how to do the argument reading.
In the case of user-defined functions, this is specified by placing a call

39
src/character.h
View file

@ -597,6 +597,45 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
: (c) <= 0xDFFF ? 2 \
: 0)
/* Data type for Unicode general category.
The order of members must be in sync with the 8th element of the
member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for
Unicode character property `general-category'. */
typedef enum {
UNICODE_CATEGORY_UNKNOWN = 0,
UNICODE_CATEGORY_Lu,
UNICODE_CATEGORY_Ll,
UNICODE_CATEGORY_Lt,
UNICODE_CATEGORY_Lm,
UNICODE_CATEGORY_Lo,
UNICODE_CATEGORY_Mn,
UNICODE_CATEGORY_Mc,
UNICODE_CATEGORY_Me,
UNICODE_CATEGORY_Nd,
UNICODE_CATEGORY_Nl,
UNICODE_CATEGORY_No,
UNICODE_CATEGORY_Pc,
UNICODE_CATEGORY_Pd,
UNICODE_CATEGORY_Ps,
UNICODE_CATEGORY_Pe,
UNICODE_CATEGORY_Pi,
UNICODE_CATEGORY_Pf,
UNICODE_CATEGORY_Po,
UNICODE_CATEGORY_Sm,
UNICODE_CATEGORY_Sc,
UNICODE_CATEGORY_Sk,
UNICODE_CATEGORY_So,
UNICODE_CATEGORY_Zs,
UNICODE_CATEGORY_Zl,
UNICODE_CATEGORY_Zp,
UNICODE_CATEGORY_Cc,
UNICODE_CATEGORY_Cf,
UNICODE_CATEGORY_Cs,
UNICODE_CATEGORY_Co,
UNICODE_CATEGORY_Cn
} unicode_category_t;
extern int char_resolve_modifier_mask (int);
extern int char_string (unsigned, unsigned char *);

577
src/chartab.c
View file

@ -53,7 +53,38 @@ static const int chartab_bits[4] =
#define CHARTAB_IDX(c, depth, min_char) \
(((c) - (min_char)) >> chartab_bits[(depth)])
/* Preamble for uniprop (Unicode character property) tables. See the
comment of "Unicode character property tables". */
/* Purpose of uniprop tables. */
static Lisp_Object Qchar_code_property_table;
/* Types of decoder and encoder functions for uniprop values. */
typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object);
typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object);
static Lisp_Object uniprop_table_uncompress (Lisp_Object, int);
static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
/* 1 iff TABLE is a uniprop table. */
#define UNIPROP_TABLE_P(TABLE) \
(EQ (XCHAR_TABLE (TABLE)->purpose, Qchar_code_property_table) \
&& CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (TABLE)) == 5)
/* Return a decoder for values in the uniprop table TABLE. */
#define UNIPROP_GET_DECODER(TABLE) \
(UNIPROP_TABLE_P (TABLE) ? uniprop_get_decoder (TABLE) : NULL)
/* Nonzero iff OBJ is a string representing uniprop values of 128
succeeding characters (the bottom level of a char-table) by a
compressed format. We are sure that no property value has a string
starting with '\001' nor '\002'. */
#define UNIPROP_COMPRESSED_FORM_P(OBJ) \
(STRINGP (OBJ) && SCHARS (OBJ) > 0 \
&& ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2))))
DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
doc: /* Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
@ -107,7 +138,7 @@ make_sub_char_table (int depth, int min_char, Lisp_Object defalt)
static Lisp_Object
char_table_ascii (Lisp_Object table)
{
Lisp_Object sub;
Lisp_Object sub, val;
sub = XCHAR_TABLE (table)->contents[0];
if (! SUB_CHAR_TABLE_P (sub))
@ -115,7 +146,10 @@ char_table_ascii (Lisp_Object table)
sub = XSUB_CHAR_TABLE (sub)->contents[0];
if (! SUB_CHAR_TABLE_P (sub))
return sub;
return XSUB_CHAR_TABLE (sub)->contents[0];
val = XSUB_CHAR_TABLE (sub)->contents[0];
if (UNIPROP_TABLE_P (table) && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (sub, 0);
return val;
}
static Lisp_Object
@ -169,16 +203,19 @@ copy_char_table (Lisp_Object table)
}
static Lisp_Object
sub_char_table_ref (Lisp_Object table, int c)
sub_char_table_ref (Lisp_Object table, int c, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
int min_char = XINT (tbl->min_char);
Lisp_Object val;
int idx = CHARTAB_IDX (c, depth, min_char);
val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
val = tbl->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref (val, c);
val = sub_char_table_ref (val, c, is_uniprop);
return val;
}
@ -198,7 +235,7 @@ char_table_ref (Lisp_Object table, int c)
{
val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref (val, c);
val = sub_char_table_ref (val, c, UNIPROP_TABLE_P (table));
}
if (NILP (val))
{
@ -210,7 +247,8 @@ char_table_ref (Lisp_Object table, int c)
}
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp_Object defalt)
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
Lisp_Object defalt, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
@ -219,8 +257,10 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
Lisp_Object val;
val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, defalt);
val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop);
else if (NILP (val))
val = defalt;
@ -232,8 +272,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
c = min_char + idx * chartab_chars[depth] - 1;
idx--;
this_val = tbl->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
is_uniprop);
else if (NILP (this_val))
this_val = defalt;
@ -251,8 +294,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp
chartab_idx++;
this_val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt);
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
is_uniprop);
else if (NILP (this_val))
this_val = defalt;
if (! EQ (this_val, val))
@ -277,17 +323,20 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
int is_uniprop = UNIPROP_TABLE_P (table);
val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
*to = MAX_CHAR;
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt);
val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt,
is_uniprop);
else if (NILP (val))
val = tbl->defalt;
idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
@ -296,9 +345,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
c = idx * chartab_chars[0] - 1;
idx--;
this_val = tbl->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt);
tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
@ -315,9 +366,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
chartab_idx++;
c = chartab_idx * chartab_chars[0];
this_val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt);
tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
if (! EQ (this_val, val))
@ -332,7 +385,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
static void
sub_char_table_set (Lisp_Object table, int c, Lisp_Object val)
sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
@ -347,11 +400,17 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val)
sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (depth + 1,
min_char + i * chartab_chars[depth], sub);
tbl->contents[i] = sub;
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub))
sub = uniprop_table_uncompress (table, i);
else
{
sub = make_sub_char_table (depth + 1,
min_char + i * chartab_chars[depth],
sub);
tbl->contents[i] = sub;
}
}
sub_char_table_set (sub, c, val);
sub_char_table_set (sub, c, val, is_uniprop);
}
}
@ -376,7 +435,7 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
tbl->contents[i] = sub;
}
sub_char_table_set (sub, c, val);
sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table));
if (ASCII_CHAR_P (c))
tbl->ascii = char_table_ascii (table);
}
@ -384,30 +443,40 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val)
}
static void
sub_char_table_set_range (Lisp_Object *table, int depth, int min_char, int from, int to, Lisp_Object val)
sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
int is_uniprop)
{
int max_char = min_char + chartab_chars[depth] - 1;
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
int min_char = XINT ((tbl)->min_char);
int chars_in_block = chartab_chars[depth];
int i, c, lim = chartab_size[depth];
if (depth == 3 || (from <= min_char && to >= max_char))
*table = val;
else
if (from < min_char)
from = min_char;
i = CHARTAB_IDX (from, depth, min_char);
c = min_char + chars_in_block * i;
for (; i < lim; i++, c += chars_in_block)
{
int i;
unsigned j;
depth++;
if (! SUB_CHAR_TABLE_P (*table))
*table = make_sub_char_table (depth, min_char, *table);
if (from < min_char)
from = min_char;
if (to > max_char)
to = max_char;
i = CHARTAB_IDX (from, depth, min_char);
j = CHARTAB_IDX (to, depth, min_char);
min_char += chartab_chars[depth] * i;
for (j++; i < j; i++, min_char += chartab_chars[depth])
sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
depth, min_char, from, to, val);
if (c > to)
break;
if (from <= c && c + chars_in_block - 1 <= to)
tbl->contents[i] = val;
else
{
Lisp_Object sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub))
sub = uniprop_table_uncompress (table, i);
else
{
sub = make_sub_char_table (depth + 1, c, sub);
tbl->contents[i] = sub;
}
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
}
}
@ -417,16 +486,33 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
Lisp_Object *contents = tbl->contents;
int i;
if (from == to)
char_table_set (table, from, val);
else
{
unsigned lim = to / chartab_chars[0] + 1;
for (i = CHARTAB_IDX (from, 0, 0); i < lim; i++)
sub_char_table_set_range (contents + i, 0, i * chartab_chars[0],
from, to, val);
int is_uniprop = UNIPROP_TABLE_P (table);
int lim = CHARTAB_IDX (to, 0, 0);
int i, c;
for (i = CHARTAB_IDX (from, 0, 0), c = 0; i <= lim;
i++, c += chartab_chars[0])
{
if (c > to)
break;
if (from <= c && c + chartab_chars[0] - 1 <= to)
tbl->contents[i] = val;
else
{
Lisp_Object sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
tbl->contents[i] = sub;
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
}
if (ASCII_CHAR_P (from))
tbl->ascii = char_table_ascii (table);
}
@ -504,6 +590,8 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
(Lisp_Object char_table, Lisp_Object n, Lisp_Object value)
{
CHECK_CHAR_TABLE (char_table);
if (EQ (XCHAR_TABLE (char_table)->purpose, Qchar_code_property_table))
error ("Can't change extra-slot of char-code-property-table");
CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
@ -532,8 +620,9 @@ a cons of character codes (for characters in the range), or a character code. *
CHECK_CHARACTER_CAR (range);
CHECK_CHARACTER_CDR (range);
val = char_table_ref_and_range (char_table, XFASTINT (XCAR (range)),
&from, &to);
from = XFASTINT (XCAR (range));
to = XFASTINT (XCDR (range));
val = char_table_ref_and_range (char_table, from, &from, &to);
/* Not yet implemented. */
}
else
@ -655,8 +744,7 @@ equivalent and can be merged. It defaults to `equal'. */)
/* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table),
calling it for each character or group of characters that share a
value. RANGE is a cons (FROM . TO) specifying the range of target
characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the
default value of the char-table, PARENT is the parent of the
characters, VAL is a value of FROM in TABLE, TOP is the top
char-table.
ARG is passed to C_FUNCTION when that is called.
@ -669,7 +757,7 @@ equivalent and can be merged. It defaults to `equal'. */)
static Lisp_Object
map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
Lisp_Object function, Lisp_Object table, Lisp_Object arg, Lisp_Object val,
Lisp_Object range, Lisp_Object default_val, Lisp_Object parent)
Lisp_Object range, Lisp_Object top)
{
/* Pointer to the elements of TABLE. */
Lisp_Object *contents;
@ -681,6 +769,8 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
int chars_in_block;
int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int i, c;
int is_uniprop = UNIPROP_TABLE_P (top);
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top);
if (SUB_CHAR_TABLE_P (table))
{
@ -710,28 +800,33 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
for (c = min_char + chars_in_block * i; c <= max_char;
i++, c += chars_in_block)
{
Lisp_Object this = contents[i];
Lisp_Object this = (SUB_CHAR_TABLE_P (table)
? XSUB_CHAR_TABLE (table)->contents[i]
: XCHAR_TABLE (table)->contents[i]);
int nextc = c + chars_in_block;
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this))
this = uniprop_table_uncompress (table, i);
if (SUB_CHAR_TABLE_P (this))
{
if (to >= nextc)
XSETCDR (range, make_number (nextc - 1));
val = map_sub_char_table (c_function, function, this, arg,
val, range, default_val, parent);
val, range, top);
}
else
{
if (NILP (this))
this = default_val;
this = XCHAR_TABLE (top)->defalt;
if (!EQ (val, this))
{
int different_value = 1;
if (NILP (val))
{
if (! NILP (parent))
if (! NILP (XCHAR_TABLE (top)->parent))
{
Lisp_Object parent = XCHAR_TABLE (top)->parent;
Lisp_Object temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT
@ -742,8 +837,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
XSETCDR (range, make_number (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
XCHAR_TABLE (parent)->defalt,
XCHAR_TABLE (parent)->parent);
parent);
if (EQ (val, this))
different_value = 0;
}
@ -756,14 +850,22 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
if (c_function)
(*c_function) (arg, XCAR (range), val);
else
call2 (function, XCAR (range), val);
{
if (decoder)
val = decoder (top, val);
call2 (function, XCAR (range), val);
}
}
else
{
if (c_function)
(*c_function) (arg, range, val);
else
call2 (function, range, val);
{
if (decoder)
val = decoder (top, val);
call2 (function, range, val);
}
}
}
val = this;
@ -783,35 +885,39 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
ARG is passed to C_FUNCTION when that is called. */
void
map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object function, Lisp_Object table, Lisp_Object arg)
map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
Lisp_Object function, Lisp_Object table, Lisp_Object arg)
{
Lisp_Object range, val;
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object range, val, parent;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table);
range = Fcons (make_number (0), make_number (MAX_CHAR));
GCPRO3 (table, arg, range);
parent = XCHAR_TABLE (table)->parent;
GCPRO4 (table, arg, range, parent);
val = XCHAR_TABLE (table)->ascii;
if (SUB_CHAR_TABLE_P (val))
val = XSUB_CHAR_TABLE (val)->contents[0];
val = map_sub_char_table (c_function, function, table, arg, val, range,
XCHAR_TABLE (table)->defalt,
XCHAR_TABLE (table)->parent);
table);
/* If VAL is nil and TABLE has a parent, we must consult the parent
recursively. */
while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent))
{
Lisp_Object parent = XCHAR_TABLE (table)->parent;
Lisp_Object temp = XCHAR_TABLE (parent)->parent;
Lisp_Object temp;
int from = XINT (XCAR (range));
parent = XCHAR_TABLE (table)->parent;
temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT without checking the
parent of PARENT. */
XCHAR_TABLE (parent)->parent = Qnil;
val = CHAR_TABLE_REF (parent, from);
XCHAR_TABLE (parent)->parent = temp;
val = map_sub_char_table (c_function, function, parent, arg, val, range,
XCHAR_TABLE (parent)->defalt,
XCHAR_TABLE (parent)->parent);
parent);
table = parent;
}
@ -822,14 +928,22 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp
if (c_function)
(*c_function) (arg, XCAR (range), val);
else
call2 (function, XCAR (range), val);
{
if (decoder)
val = decoder (table, val);
call2 (function, XCAR (range), val);
}
}
else
{
if (c_function)
(*c_function) (arg, range, val);
else
call2 (function, range, val);
{
if (decoder)
val = decoder (table, val);
call2 (function, range, val);
}
}
}
@ -983,10 +1097,316 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
UNGCPRO;
}
/* Unicode character property tables.
This section provides a convenient and efficient way to get a
Unicode character property from C code (from Lisp, you must use
get-char-code-property).
The typical usage is to get a char-table for a specific property at
a proper initialization time as this:
Lisp_Object bidi_class_table = uniprop_table (intern ("bidi-class"));
and get a property value for character CH as this:
Lisp_Object bidi_class = CHAR_TABLE_REF (CH, bidi_class_table);
In this case, what you actually get is an index number to the
vector of property values (symbols nil, L, R, etc).
A table for Unicode character property has these characteristics:
o The purpose is `char-code-property-table', which implies that the
table has 5 extra slots.
o The second extra slot is a Lisp function, an index (integer) to
the array uniprop_decoder[], or nil. If it is a Lisp function, we
can't use such a table from C (at the moment). If it is nil, it
means that we don't have to decode values.
o The third extra slot is a Lisp function, an index (integer) to
the array uniprop_enncoder[], or nil. If it is a Lisp function, we
can't use such a table from C (at the moment). If it is nil, it
means that we don't have to encode values. */
/* Uncompress the IDXth element of sub-char-table TABLE. */
static Lisp_Object
uniprop_table_uncompress (Lisp_Object table, int idx)
{
Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[idx];
int min_char = (XINT (XSUB_CHAR_TABLE (table)->min_char)
+ chartab_chars[2] * idx);
Lisp_Object sub = make_sub_char_table (3, min_char, Qnil);
struct Lisp_Sub_Char_Table *subtbl = XSUB_CHAR_TABLE (sub);
const unsigned char *p, *pend;
int i;
XSUB_CHAR_TABLE (table)->contents[idx] = sub;
p = SDATA (val), pend = p + SBYTES (val);
if (*p == 1)
{
/* SIMPLE TABLE */
p++;
idx = STRING_CHAR_ADVANCE (p);
while (p < pend && idx < chartab_chars[2])
{
int v = STRING_CHAR_ADVANCE (p);
subtbl->contents[idx++] = v > 0 ? make_number (v) : Qnil;
}
}
else if (*p == 2)
{
/* RUN-LENGTH TABLE */
p++;
for (idx = 0; p < pend; )
{
int v = STRING_CHAR_ADVANCE (p);
int count = 1;
int len;
if (p < pend)
{
count = STRING_CHAR_AND_LENGTH (p, len);
if (count < 128)
count = 1;
else
{
count -= 128;
p += len;
}
}
while (count-- > 0)
subtbl->contents[idx++] = make_number (v);
}
}
/* It seems that we don't need this function because C code won't need
to get a property that is compressed in this form. */
#if 0
else if (*p == 0)
{
/* WORD-LIST TABLE */
}
#endif
return sub;
}
/* Decode VALUE as an elemnet of char-table TABLE. */
static Lisp_Object
uniprop_decode_value_run_length (Lisp_Object table, Lisp_Object value)
{
if (VECTORP (XCHAR_TABLE (table)->extras[4]))
{
Lisp_Object valvec = XCHAR_TABLE (table)->extras[4];
if (XINT (value) >= 0 && XINT (value) < ASIZE (valvec))
value = AREF (valvec, XINT (value));
}
return value;
}
static uniprop_decoder_t uniprop_decoder [] =
{ uniprop_decode_value_run_length };
static int uniprop_decoder_count
= (sizeof uniprop_decoder) / sizeof (uniprop_decoder[0]);
/* Return the decoder of char-table TABLE or nil if none. */
static uniprop_decoder_t
uniprop_get_decoder (Lisp_Object table)
{
int i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[1]))
return NULL;
i = XINT (XCHAR_TABLE (table)->extras[1]);
if (i < 0 || i >= uniprop_decoder_count)
return NULL;
return uniprop_decoder[i];
}
/* Encode VALUE as an element of char-table TABLE which contains
characters as elements. */
static Lisp_Object
uniprop_encode_value_character (Lisp_Object table, Lisp_Object value)
{
if (! NILP (value) && ! CHARACTERP (value))
wrong_type_argument (Qintegerp, value);
return value;
}
/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH
compression. */
static Lisp_Object
uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value)
{
Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents;
int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]);
for (i = 0; i < size; i++)
if (EQ (value, value_table[i]))
break;
if (i == size)
wrong_type_argument (build_string ("Unicode property value"), value);
return make_number (i);
}
/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH
compression and contains numbers as elements . */
static Lisp_Object
uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value)
{
Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents;
int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]);
CHECK_NUMBER (value);
for (i = 0; i < size; i++)
if (EQ (value, value_table[i]))
break;
value = make_number (i);
if (i == size)
{
Lisp_Object args[2];
args[0] = XCHAR_TABLE (table)->extras[4];
args[1] = Fmake_vector (make_number (1), value);
XCHAR_TABLE (table)->extras[4] = Fvconcat (2, args);
}
return make_number (i);
}
static uniprop_encoder_t uniprop_encoder[] =
{ uniprop_encode_value_character,
uniprop_encode_value_run_length,
uniprop_encode_value_numeric };
static int uniprop_encoder_count
= (sizeof uniprop_encoder) / sizeof (uniprop_encoder[0]);
/* Return the encoder of char-table TABLE or nil if none. */
static uniprop_decoder_t
uniprop_get_encoder (Lisp_Object table)
{
int i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[2]))
return NULL;
i = XINT (XCHAR_TABLE (table)->extras[2]);
if (i < 0 || i >= uniprop_encoder_count)
return NULL;
return uniprop_encoder[i];
}
/* Return a char-table for Unicode character property PROP. This
function may load a Lisp file and thus may cause
garbage-collection. */
Lisp_Object
uniprop_table (Lisp_Object prop)
{
Lisp_Object val, table, result;
val = Fassq (prop, Vchar_code_property_alist);
if (! CONSP (val))
return Qnil;
table = XCDR (val);
if (STRINGP (table))
{
struct gcpro gcpro1;
GCPRO1 (val);
result = Fload (concat2 (build_string ("international/"), table),
Qt, Qt, Qt, Qt);
UNGCPRO;
if (NILP (result))
return Qnil;
table = XCDR (val);
}
if (! CHAR_TABLE_P (table)
|| ! UNIPROP_TABLE_P (table))
return Qnil;
val = XCHAR_TABLE (table)->extras[1];
if (INTEGERP (val)
? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count)
: ! NILP (val))
return Qnil;
/* Prepare ASCII values in advance for CHAR_TABLE_REF. */
XCHAR_TABLE (table)->ascii = char_table_ascii (table);
return table;
}
DEFUN ("unicode-property-table-internal", Funicode_property_table_internal,
Sunicode_property_table_internal, 1, 1, 0,
doc: /* Return a char-table for Unicode character property PROP.
Use `get-unicode-property-internal' and
`put-unicode-property-internal' instead of `aref' and `aset' to get
and put an element value. */)
(Lisp_Object prop)
{
Lisp_Object table = uniprop_table (prop);
if (CHAR_TABLE_P (table))
return table;
return Fcdr (Fassq (prop, Vchar_code_property_alist));
}
DEFUN ("get-unicode-property-internal", Fget_unicode_property_internal,
Sget_unicode_property_internal, 2, 2, 0,
doc: /* Return an element of CHAR-TABLE for character CH.
CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
(Lisp_Object char_table, Lisp_Object ch)
{
Lisp_Object val;
uniprop_decoder_t decoder;
CHECK_CHAR_TABLE (char_table);
CHECK_CHARACTER (ch);
if (! UNIPROP_TABLE_P (char_table))
error ("Invalid Unicode property table");
val = CHAR_TABLE_REF (char_table, XINT (ch));
decoder = uniprop_get_decoder (char_table);
return (decoder ? decoder (char_table, val) : val);
}
DEFUN ("put-unicode-property-internal", Fput_unicode_property_internal,
Sput_unicode_property_internal, 3, 3, 0,
doc: /* Set an element of CHAR-TABLE for character CH to VALUE.
CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
(Lisp_Object char_table, Lisp_Object ch, Lisp_Object value)
{
uniprop_encoder_t encoder;
CHECK_CHAR_TABLE (char_table);
CHECK_CHARACTER (ch);
if (! UNIPROP_TABLE_P (char_table))
error ("Invalid Unicode property table");
encoder = uniprop_get_encoder (char_table);
if (encoder)
value = encoder (char_table, value);
CHAR_TABLE_SET (char_table, XINT (ch), value);
return Qnil;
}
void
syms_of_chartab (void)
{
DEFSYM (Qchar_code_property_table, "char-code-property-table");
defsubr (&Smake_char_table);
defsubr (&Schar_table_parent);
defsubr (&Schar_table_subtype);
@ -998,4 +1418,19 @@ syms_of_chartab (void)
defsubr (&Sset_char_table_default);
defsubr (&Soptimize_char_table);
defsubr (&Smap_char_table);
defsubr (&Sunicode_property_table_internal);
defsubr (&Sget_unicode_property_internal);
defsubr (&Sput_unicode_property_internal);
/* Each element has the form (PROP . TABLE).
PROP is a symbol representing a character property.
TABLE is a char-table containing the property value for each character.
TABLE may be a name of file to load to build a char-table.
This variable should be modified only through
`define-char-code-property'. */
DEFVAR_LISP ("char-code-property-alist", Vchar_code_property_alist,
doc: /* Alist of character property name vs char-table containing property values.
Internal use only. */);
Vchar_code_property_alist = Qnil;
}

6
src/composite.c
View file

@ -976,9 +976,8 @@ static int _work_char;
((C) > ' ' \
&& ((C) == 0x200C || (C) == 0x200D \
|| (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
(SYMBOLP (_work_val) \
&& (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
&& _work_char != 'Z'))))
(INTEGERP (_work_val) \
&& (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
BYTEPOS) where character composition may happen. If BYTEPOS is
@ -1027,6 +1026,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
/* FIXME: Bidi is not yet handled well in static composition. */
if (charpos < endpos
&& find_composition (charpos, endpos, &start, &end, &prop, string)
&& start >= charpos
&& COMPOSITION_VALID_P (start, end, prop))
{
cmp_it->stop_pos = endpos = start;

6
src/dispextern.h
View file

@ -1773,7 +1773,11 @@ extern int face_change_count;
/* Data type for describing the bidirectional character types. The
first 7 must be at the beginning, because they are the only values
valid in the `bidi_type' member of `struct glyph'; we only reserve
3 bits for it, so we cannot use there values larger than 7. */
3 bits for it, so we cannot use there values larger than 7.
The order of members must be in sync with the 8th element of the
member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for
Unicode character property `bidi-class'. */
typedef enum {
UNKNOWN_BT = 0,
STRONG_L, /* strong left-to-right */

5
src/font.c
View file

@ -3739,8 +3739,9 @@ font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face
else
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (EQ (category, QCf)
|| CHAR_VARIATION_SELECTOR_P (c))
if (INTEGERP (category)
&& (XINT (category) == UNICODE_CATEGORY_Cf
|| CHAR_VARIATION_SELECTOR_P (c)))
continue;
if (NILP (font_object))
{

10
src/keymap.c
View file

@ -2951,9 +2951,11 @@ You type Translation\n\
to look through.
If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
don't omit it; instead, mention it but say it is shadowed. */
don't omit it; instead, mention it but say it is shadowed.
void
Return whether something was inserted or not. */
int
describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
Lisp_Object prefix, const char *title, int nomenu, int transl,
int always_title, int mention_shadow)
@ -3063,10 +3065,8 @@ key binding\n\
skip: ;
}
if (something)
insert_string ("\n");
UNGCPRO;
return something;
}
static int previous_description_column;

4
src/keymap.h
View file

@ -36,8 +36,8 @@ EXFUN (Fcurrent_active_maps, 2);
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, int, int, int);
extern Lisp_Object get_keymap (Lisp_Object, int, int);
EXFUN (Fset_keymap_parent, 2);
extern void describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
const char *, int, int, int, int);
extern int describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
const char *, int, int, int, int);
extern int current_minor_maps (Lisp_Object **, Lisp_Object **);
extern void initial_define_key (Lisp_Object, int, const char *);
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);

26
src/m/iris4d.h
View file

@ -1,26 +0,0 @@
/* machine description file for Iris-4D machines. Use with s/irix*.h.
Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which
were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for
the value field of a LISP_OBJECT). */
#define DATA_START 0x10000000
#define DATA_SEG_BITS 0x10000000

9
src/nsfns.m
View file

@ -1728,8 +1728,8 @@ and GNUstep implementations ("distributor-specific release
/* Register our external input/output types, used for determining
applicable services and also drag/drop eligibility. */
ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
ns_return_types = [[NSArray arrayWithObjects: nil] retain];
ns_drag_types = [[NSArray arrayWithObjects:
NSStringPboardType,
NSTabularTextPboardType,
@ -1876,6 +1876,10 @@ and GNUstep implementations ("distributor-specific release
doc: /* List available Nextstep services by querying NSApp. */)
(void)
{
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
/* You can't get services like this in 10.6+. */
return Qnil;
#else
Lisp_Object ret = Qnil;
NSMenu *svcs;
id delegate;
@ -1919,6 +1923,7 @@ and GNUstep implementations ("distributor-specific release
ret = interpret_services_menu (svcs, Qnil, ret);
return ret;
#endif
}

5
src/nsgui.h
View file

@ -30,6 +30,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef init_process
#endif /* NS_IMPL_COCOA */
#undef verify
#import <AppKit/AppKit.h>
#ifdef NS_IMPL_COCOA
@ -44,6 +46,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif /* __OBJC__ */
#undef verify
#undef _GL_VERIFY_H
#include <verify.h>
/* menu-related */
#define free_widget_value(wv) xfree (wv)

1
src/nsmenu.m
View file

@ -457,7 +457,6 @@
{
/* but we need to make sure it will update on demand */
[svcsMenu setFrame: f];
[svcsMenu setDelegate: svcsMenu];
}
else
#endif

2
src/nsselect.m
View file

@ -175,7 +175,7 @@ Updated by Christian Limpach (chris@nice.ch)
}
static Lisp_Object
Lisp_Object
ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type)
{

8
src/nsterm.h
View file

@ -25,6 +25,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_NS
#ifdef NS_IMPL_COCOA
#ifndef MAC_OS_X_VERSION_10_6
#define MAC_OS_X_VERSION_10_6 1060
#endif
#endif
#ifdef __OBJC__
/* ==========================================================================
@ -700,6 +706,8 @@ extern void check_ns (void);
extern Lisp_Object ns_map_event_to_object ();
extern Lisp_Object ns_string_from_pasteboard ();
extern void ns_string_to_pasteboard ();
extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type);
extern void nxatoms_of_nsselect ();
extern int ns_lisp_to_cursor_type ();
extern Lisp_Object ns_cursor_type_to_lisp (int arg);

46
src/nsterm.m
View file

@ -134,11 +134,12 @@ Updated by Christian Limpach (chris@nice.ch)
0x1B, 0x1B /* escape */
};
static Lisp_Object Qmodifier_value;
Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone;
extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft;
static Lisp_Object QUTF8_STRING;
/* On OS X picks up the default NSGlobalDomain AppleAntiAliasingThreshold,
the maximum font size to NOT antialias. On GNUstep there is currently
no way to control this behavior. */
@ -5364,6 +5365,9 @@ - (BOOL)isOpaque
[self allocateGState];
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: ns_return_types];
ns_window_num++;
return self;
}
@ -5735,13 +5739,17 @@ -(BOOL)performDragOperation: (id <NSDraggingInfo>) sender
}
- validRequestorForSendType: (NSString *)typeSent
returnType: (NSString *)typeReturned
- (id) validRequestorForSendType: (NSString *)typeSent
returnType: (NSString *)typeReturned
{
NSTRACE (validRequestorForSendType);
if ([ns_send_types indexOfObjectIdenticalTo: typeSent] != NSNotFound &&
[ns_return_types indexOfObjectIdenticalTo: typeSent] != NSNotFound)
return self;
if (typeSent != nil && [ns_send_types indexOfObject: typeSent] != NSNotFound
&& (typeReturned == nil
|| [ns_return_types indexOfObject: typeSent] != NSNotFound))
{
if (! NILP (ns_get_local_selection (QPRIMARY, QUTF8_STRING)))
return self;
}
return [super validRequestorForSendType: typeSent
returnType: typeReturned];
@ -5765,8 +5773,28 @@ - (BOOL) readSelectionFromPasteboard: (NSPasteboard *)pb
- (BOOL) writeSelectionToPasteboard: (NSPasteboard *)pb types: (NSArray *)types
{
/* supposed to write for as many of types as we are able */
return NO;
NSArray *typesDeclared;
Lisp_Object val;
/* We only support NSStringPboardType */
if ([types containsObject:NSStringPboardType] == NO) {
return NO;
}
val = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
if (CONSP (val) && SYMBOLP (XCAR (val)))
{
val = XCDR (val);
if (CONSP (val) && NILP (XCDR (val)))
val = XCAR (val);
}
if (! STRINGP (val))
return NO;
typesDeclared = [NSArray arrayWithObject:NSStringPboardType];
[pb declareTypes:typesDeclared owner:nil];
ns_string_to_pasteboard (pb, val);
return YES;
}
@ -6390,6 +6418,8 @@ Convert an X font name (XLFD) to an NS font name.
DEFSYM (Qsuper, "super");
DEFSYM (Qcontrol, "control");
DEFSYM (Qnone, "none");
DEFSYM (QUTF8_STRING, "UTF8_STRING");
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier));
Fput (Qmeta, Qmodifier_value, make_number (meta_modifier));

7
src/s/irix6-5.h
View file

@ -96,3 +96,10 @@ char *_getpty();
/* Tested on Irix 6.5. SCM worked on earlier versions. */
#define GC_SETJMP_WORKS 1
#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which
were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for
the value field of a LISP_OBJECT). */
#define DATA_START 0x10000000
#define DATA_SEG_BITS 0x10000000

3
src/term.c
View file

@ -1546,7 +1546,8 @@ produce_glyphs (struct it *it)
/* Nothing but characters are supported on terminal frames. */
xassert (it->what == IT_CHARACTER
|| it->what == IT_COMPOSITION
|| it->what == IT_STRETCH);
|| it->what == IT_STRETCH
|| it->what == IT_GLYPHLESS);
if (it->what == IT_STRETCH)
{

5
src/xdisp.c
View file

@ -4583,6 +4583,11 @@ handle_composition_prop (struct it *it)
&& COMPOSITION_VALID_P (start, end, prop)
&& (STRINGP (it->string) || (PT <= start || PT >= end)))
{
if (start < pos)
/* As we can't handle this situation (perhaps font-lock added
a new composition), we just return here hoping that next
redisplay will detect this composition much earlier. */
return HANDLED_NORMALLY;
if (start != pos)
{
if (STRINGP (it->string))