diff --git a/ChangeLog b/ChangeLog index 62847460778..6aaebbc80e9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,4 @@ -2011-07-06 Paul Eggert +2011-07-08 Paul Eggert 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 + + * configure.in (maintainer-mode): Reflect default in help string. + +2011-07-07 Dan Nicolaescu + + * configure.in: Remove reference to iris4d.h. + 2011-07-05 Jan Djärv * configure.in (HAVE_GCONF): Allow both HAVE_GCONF and HAVE_GSETTINGS. diff --git a/admin/ChangeLog b/admin/ChangeLog index 7aaeb1d5ee2..dbbe38ce617 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,43 @@ +2011-07-07 Juanma Barranquero + + * 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 + + * 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 * 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 diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 04f2f1d4380..e1fe247631f 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -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 $< > $@ diff --git a/admin/unidata/makefile.w32-in b/admin/unidata/makefile.w32-in index 1f9f276a35c..6a877e0c1d0 100644 --- a/admin/unidata/makefile.w32-in +++ b/admin/unidata/makefile.w32-in @@ -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) diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 9f898668526..ab1dcd134ac 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -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" diff --git a/autogen/config.in b/autogen/config.in index 8fa108844b8..051c0ea26ea 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -1038,9 +1038,9 @@ along with GNU Emacs. If not, see . */ /* 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 do not work properly. */ diff --git a/autogen/configure b/autogen/configure index 9b9e915f759..7e45acbdb83 100755 --- a/autogen/configure +++ b/autogen/configure @@ -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). diff --git a/configure.in b/configure.in index 2c258174d46..5014a793a85 100644 --- a/configure.in +++ b/configure.in @@ -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). diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 0924bbcecc8..7e8dac0cb27 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,16 @@ +2011-07-07 Lars Magne Ingebrigtsen + + * 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 + + * functions.texi (Calling Functions): Link to the "Interactive + Call" node (bug#1001). + 2011-07-06 Chong Yidong * customize.texi (Composite Types): Move alist and plist to here diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index eb42ddb11a4..dccc2fa571c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -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 diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 519957f8921..f3b2375b61d 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -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 diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 7d2c3831a5a..2d487352243 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -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 diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index ff5831caa12..a977b9d2f7f 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2011-07-07 Lars Magne Ingebrigtsen + + * 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 * gnus.texi (Expiring Mail): Document gnus-auto-expirable-marks. diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 3ba0796e636..20c2ed90873 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -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 diff --git a/etc/ChangeLog b/etc/ChangeLog index 5e80b5029ff..f7ecbb5d777 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,23 @@ +2011-07-07 Tassilo Horn + + * 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 + + * NEWS: Clarify `smtpmail-auth-credentials' non-existence. + Mention the `send-mail-function' default change. + +2011-07-07 Chong Yidong + + * 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 * NEWS: Clarify that `smtpmail-starttls-credentials' doesn't exist. diff --git a/etc/NEWS b/etc/NEWS index 66b173751bf..8a06c9f2bc6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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. diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index 0105080ab08..31f27d9fb8a 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -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 diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index b5621d10320..403370c90cb 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -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 diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index c58e0036353..9d0f0aca94a 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -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 diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index aaa43435ddf..82732765885 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -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")))) diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index e7a2bafb03e..f62cea4eb47 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -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")))) diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el index 3a08bb63d96..9f8772c4d6e 100644 --- a/etc/themes/wheatgrass-theme.el +++ b/etc/themes/wheatgrass-theme.el @@ -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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6625790370e..35337de3fa4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,131 @@ +2011-07-08 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * menu-bar.el (menu-bar-line-wrapping-menu): Revert last change. + (menu-bar-options-menu): Tweak descriptions. + +2011-07-07 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 * mail/rmailmm.el: Give entity a new slot, TRUNCATED. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 70f43aebaff..ea875b9989d 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -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 diff --git a/lisp/bindings.el b/lisp/bindings.el index 2f035608528..99d9aa36e35 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -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. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 693b36040ea..820bcfeacba 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -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))) diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 00e2ec802e2..540b93faad8 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -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) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 9e3e3460fa2..5ab4146383b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -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) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index ca89d07ea7f..8395a8b905f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -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: diff --git a/lisp/dired.el b/lisp/dired.el index 477baa24da1..8369d4897be 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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" "\ diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6b3e10691d0..a0f2d5809a6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,28 @@ +2011-07-08 Daiki Ueno + + * 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 + + * 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 + + * 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 * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Silence compiler. @@ -34,6 +59,9 @@ 2011-07-04 Lars Magne Ingebrigtsen + * 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 diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7e2d213d20c..7255be416eb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index bad474b4057..9d3ec25c03a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -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. diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el index 8d973a9b0ae..5f9a61aa843 100644 --- a/lisp/gnus/plstore.el +++ b/lisp/gnus/plstore.el @@ -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 @@ -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) diff --git a/lisp/info.el b/lisp/info.el index 047a1b340a0..29daac566d1 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -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) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 455cbe697d6..a9657c17b9f 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -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) diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el index 5c3efcc9d07..919666010b1 100644 --- a/lisp/international/charprop.el +++ b/lisp/international/charprop.el @@ -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 diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index b3f17bb3fcf..e75a22d6415 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -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)))))) diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el index 9e571ef9d0d..e7682c6d8ff 100644 Binary files a/lisp/international/uni-bidi.el and b/lisp/international/uni-bidi.el differ diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el index 80538f7b416..a4455decc52 100644 Binary files a/lisp/international/uni-category.el and b/lisp/international/uni-category.el differ diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el index 2ee74d8b818..227b9d0af79 100644 Binary files a/lisp/international/uni-combining.el and b/lisp/international/uni-combining.el differ diff --git a/lisp/international/uni-comment.el b/lisp/international/uni-comment.el index dcc717977c7..c9743064bd4 100644 Binary files a/lisp/international/uni-comment.el and b/lisp/international/uni-comment.el differ diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el index 22207a224b0..2c424ffb5de 100644 Binary files a/lisp/international/uni-decimal.el and b/lisp/international/uni-decimal.el differ diff --git a/lisp/international/uni-decomposition.el b/lisp/international/uni-decomposition.el index f35bcebfed8..b0bf07bbe85 100644 Binary files a/lisp/international/uni-decomposition.el and b/lisp/international/uni-decomposition.el differ diff --git a/lisp/international/uni-digit.el b/lisp/international/uni-digit.el index 692dea1edc8..fc52fd8c28c 100644 Binary files a/lisp/international/uni-digit.el and b/lisp/international/uni-digit.el differ diff --git a/lisp/international/uni-lowercase.el b/lisp/international/uni-lowercase.el index 7cc601159f0..41890018204 100644 Binary files a/lisp/international/uni-lowercase.el and b/lisp/international/uni-lowercase.el differ diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el index 5129a93396d..006cf575591 100644 Binary files a/lisp/international/uni-mirrored.el and b/lisp/international/uni-mirrored.el differ diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el index 5b9e8323d21..7fac18b278d 100644 Binary files a/lisp/international/uni-name.el and b/lisp/international/uni-name.el differ diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el index 278ad683fe4..d16e8c00870 100644 Binary files a/lisp/international/uni-numeric.el and b/lisp/international/uni-numeric.el differ diff --git a/lisp/international/uni-old-name.el b/lisp/international/uni-old-name.el index 2e283492408..4e704e5cdd0 100644 Binary files a/lisp/international/uni-old-name.el and b/lisp/international/uni-old-name.el differ diff --git a/lisp/international/uni-titlecase.el b/lisp/international/uni-titlecase.el index 729a469d103..b8098c81876 100644 Binary files a/lisp/international/uni-titlecase.el and b/lisp/international/uni-titlecase.el differ diff --git a/lisp/international/uni-uppercase.el b/lisp/international/uni-uppercase.el index 0714b14794f..899276eb725 100644 Binary files a/lisp/international/uni-uppercase.el and b/lisp/international/uni-uppercase.el differ diff --git a/lisp/loadup.el b/lisp/loadup.el index 4c677523689..792827dd913 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -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") diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 02f78635e26..c43ec9e5611 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -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" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 6f1bce03ee9..597068562b5 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -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))) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 6480d6a393f..b14c7e50137 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -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) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 3fd2d9ddf21..57356f3315b 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -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")))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 437bd523841..caae40ed8c5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -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)) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 038794e117d..bb09d8945c9 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -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)) diff --git a/lisp/simple.el b/lisp/simple.el index 6c078830a18..2c792a2c78e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index a7ff23949fe..ff63ca34035 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -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. diff --git a/lisp/window.el b/lisp/window.el index 2b98630a51e..2c4bf0dcb23 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -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) diff --git a/src/ChangeLog b/src/ChangeLog index 41dd4c0e9c1..ccafc9c5963 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,4 +1,4 @@ -2011-07-06 Paul Eggert +2011-07-08 Paul Eggert 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 + + * 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 + + * 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 + + * 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 + + * term.c (produce_glyphs) : Allow IT_GLYPHLESS in it->what. + (Bug#9015) + +2011-07-07 Kenichi Handa + + * 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 + + * m/iris4d.h: Remove file, move contents ... + * s/irix6-5.h: ... here. + +2011-07-06 Paul Eggert + + 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 * xsettings.c: Use both GConf and GSettings if both are available. diff --git a/src/alloc.c b/src/alloc.c index 43befd722bb..f679787e95c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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); diff --git a/src/buffer.c b/src/buffer.c index 2339416eb36..e2f34d629e9 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -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))) { diff --git a/src/buffer.h b/src/buffer.h index 4643e0d9d0e..06864dd5789 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -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 }; diff --git a/src/callint.c b/src/callint.c index 1371b403e4b..26b161a25b3 100644 --- a/src/callint.c +++ b/src/callint.c @@ -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 diff --git a/src/character.h b/src/character.h index 3bc21ac0f2b..063b5147dc9 100644 --- a/src/character.h +++ b/src/character.h @@ -597,6 +597,45 @@ along with GNU Emacs. If not, see . */ : (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 *); diff --git a/src/chartab.c b/src/chartab.c index ed5b238646e..e900a3ae71f 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -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; } diff --git a/src/composite.c b/src/composite.c index de9775d18f5..cf1e053f027 100644 --- a/src/composite.c +++ b/src/composite.c @@ -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; diff --git a/src/dispextern.h b/src/dispextern.h index 57fa09d3bfc..c0a67690a5c 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -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 */ diff --git a/src/font.c b/src/font.c index 14390335f3c..5aff20b1346 100644 --- a/src/font.c +++ b/src/font.c @@ -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)) { diff --git a/src/keymap.c b/src/keymap.c index be31f72eec6..d33af68be48 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -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; diff --git a/src/keymap.h b/src/keymap.h index 2b9d58b39dc..2c826b64e1f 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -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 *); diff --git a/src/m/iris4d.h b/src/m/iris4d.h deleted file mode 100644 index 881f71f846f..00000000000 --- a/src/m/iris4d.h +++ /dev/null @@ -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 . */ - - -/* 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 - diff --git a/src/nsfns.m b/src/nsfns.m index cdf350066be..d124f61a4f2 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -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 } diff --git a/src/nsgui.h b/src/nsgui.h index a6955630941..999dc27e310 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -30,6 +30,8 @@ along with GNU Emacs. If not, see . */ #undef init_process #endif /* NS_IMPL_COCOA */ +#undef verify + #import #ifdef NS_IMPL_COCOA @@ -44,6 +46,9 @@ along with GNU Emacs. If not, see . */ #endif /* __OBJC__ */ +#undef verify +#undef _GL_VERIFY_H +#include /* menu-related */ #define free_widget_value(wv) xfree (wv) diff --git a/src/nsmenu.m b/src/nsmenu.m index 2a2f952e751..0d25b82d5b5 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -457,7 +457,6 @@ { /* but we need to make sure it will update on demand */ [svcsMenu setFrame: f]; - [svcsMenu setDelegate: svcsMenu]; } else #endif diff --git a/src/nsselect.m b/src/nsselect.m index 950fb1f1f14..aeb2a3e3a99 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -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) { diff --git a/src/nsterm.h b/src/nsterm.h index 7459087c988..b442973f0d9 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -25,6 +25,12 @@ along with GNU Emacs. If not, see . */ #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); diff --git a/src/nsterm.m b/src/nsterm.m index 52e0dc6c2a8..ac95409ee7e 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -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 ) 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)); diff --git a/src/s/irix6-5.h b/src/s/irix6-5.h index d283571d8fb..26eb7dcde77 100644 --- a/src/s/irix6-5.h +++ b/src/s/irix6-5.h @@ -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 diff --git a/src/term.c b/src/term.c index 9205719b5f4..be23e547514 100644 --- a/src/term.c +++ b/src/term.c @@ -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) { diff --git a/src/xdisp.c b/src/xdisp.c index a99f06a4e45..774bc22699a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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))