Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 104500. ------------------------------------------------------------ revno: 104500 committer: Roland Winkler branch nick: trunk timestamp: Sun 2011-06-05 00:46:43 -0500 message: lisp/textmodes/bibtex.el: new command bibtex-search-entries diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-05 04:47:45 +0000 +++ etc/NEWS 2011-06-05 05:46:43 +0000 @@ -438,6 +438,8 @@ ** BibTeX mode +*** New command `bibtex-search-entries' bound to C-c C-a. + *** New `bibtex-entry-format' option `sort-fields', disabled by default. *** New variable `bibtex-search-entry-globally'. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-05 04:58:39 +0000 +++ lisp/ChangeLog 2011-06-05 05:46:43 +0000 @@ -1,5 +1,11 @@ 2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-search-buffer): New variable. + (bibtex-search-entries): New command bound to C-c C-a. + (bibtex-display-entries): New function. + +2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-generate-url-list): Fix docstring. (bibtex-insert-kill): After yanking insert newline if necessary. (bibtex-initialize): Call bibtex-string-files-init only once. === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2011-06-05 04:58:39 +0000 +++ lisp/textmodes/bibtex.el 2011-06-05 05:46:43 +0000 @@ -968,6 +968,11 @@ :group 'bibtex :type 'boolean) +(defcustom bibtex-search-buffer "*BibTeX Search*" + "Buffer for BibTeX search results." + :group 'bibtex + :type 'string) + ;; `bibtex-font-lock-keywords' is a user option, too. But since the ;; patterns used to define this variable are defined in a later ;; section of this file, it is defined later. @@ -1025,6 +1030,7 @@ (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry) (define-key km "\C-c\C-rw" 'widen) (define-key km "\C-c\C-l" 'bibtex-url) + (define-key km "\C-c\C-a" 'bibtex-search-entries) (define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT) (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings) (define-key km "\C-c\C-ei" 'bibtex-InCollection) @@ -1102,6 +1108,8 @@ ["View Cite Locations (RefTeX)" reftex-view-crossref-from-bibtex (fboundp 'reftex-view-crossref-from-bibtex)]) ("Operating on Buffer or Region" + ["Search Entries" bibtex-search-entries t] + "--" ["Validate Entries" bibtex-validate t] ["Sort Entries" bibtex-sort-buffer t] ["Reformat Entries" bibtex-reformat t] @@ -4789,6 +4797,118 @@ (message "No URL known.")) url))) +;; We could combine multiple seach results with set operations +;; AND, OR, MINUS, and NOT. Would this be useful? +;; How complicated are searches in real life? +;; We could also have other searches such as "publication year newer than...". +(defun bibtex-search-entries (field regexp &optional global display) + "Search BibTeX entries for FIELD matching REGEXP. +REGEXP may be a regexp to search for. +If REGEXP is a function, it is called for each entry with two args, +the buffer positions of beginning and end of entry. Then an entry +is accepted if this function returns non-nil. +If FIELD is an empty string perform search for REGEXP in whole entry. +With GLOBAL non-nil, search in `bibtex-files'. Otherwise the search +is limited to the current buffer. +If DISPLAY is non-nil, display search results in `bibtex-search-buffer'. +When called interactively, DISPLAY is t. +Also, GLOBAL is t if `bibtex-search-entry-globally' is non-nil. +A prefix arg negates the value of `bibtex-search-entry-globally'. +Return alist with elements (KEY FILE ENTRY), +where FILE is the BibTeX file of ENTRY." + (interactive + (list (completing-read + "Field: " + (delete-dups + (apply 'append + bibtex-user-optional-fields + (mapcar (lambda (x) + (append (mapcar 'car (nth 0 (nth 1 x))) + (mapcar 'car (nth 1 (nth 1 x))))) + bibtex-entry-field-alist))) nil t) + (read-string "Regexp: ") + (if bibtex-search-entry-globally + (not current-prefix-arg) + current-prefix-arg) + t)) + (let ((funp (functionp regexp)) + entries text file) + ;; If REGEXP is a function, the value of FIELD is ignored anyway. + ;; Yet to ensure the code below does not fail, we make FIELD + ;; a non-empty string. + (if (and funp (string= "" field)) (setq field "unrestricted")) + (dolist (buffer (if (and global bibtex-files) + (bibtex-initialize t) + (list (current-buffer)))) + (with-current-buffer buffer + (setq file (if buffer-file-name + (file-name-nondirectory buffer-file-name) + (buffer-name buffer))) + (save-excursion + (goto-char (point-min)) + (if (string= "" field) + ;; Unrestricted search. + (while (re-search-forward regexp nil t) + (let ((beg (bibtex-beginning-of-entry)) + (end (bibtex-end-of-entry)) + key) + (if (and (<= beg (match-beginning 0)) + (<= (match-end 0) end) + (save-excursion + (goto-char beg) + (and (looking-at bibtex-entry-head) + (setq key (bibtex-key-in-head))))) + (add-to-list 'entries + (list key file + (buffer-substring-no-properties + beg end)))))) + ;; The following is slow. But it works reliably even in more + ;; complicated cases with BibTeX string constants and crossrefed + ;; entries. If you prefer speed over reliability, perform an + ;; unrestricted search. + (bibtex-map-entries + (lambda (key beg end) + (if (cond (funp (funcall regexp beg end)) + ((and (setq text (bibtex-text-in-field field t)) + (string-match regexp text)))) + (add-to-list 'entries + (list key file + (buffer-substring-no-properties + beg end)))))))))) + (if display + (if entries + (bibtex-display-entries entries) + (message "No BibTeX entries %smatching `%s'" + (if (string= "" field) "" + (format "with field `%s' " field)) + regexp))) + entries)) + +(defun bibtex-display-entries (entries &optional append) + "Display BibTeX ENTRIES in `bibtex-search-buffer'. +ENTRIES is an alist with elements (KEY FILE ENTRY), +where FILE is the BibTeX file of ENTRY. +If APPEND is non-nil, append ENTRIES to those already displayed." + (pop-to-buffer (get-buffer-create bibtex-search-buffer)) + ;; It would be nice if this buffer was editable, though editing + ;; can be meaningful only for individual existing entries + ;; (unlike reordering or creating new entries). + ;; Fancy workaround: Editing commands in the virtual buffer could + ;; jump to the real entry in the real buffer. + (let (buffer-read-only) + (if append (goto-char (point-max)) (erase-buffer)) + (dolist (entry (sort entries (lambda (x y) (string< (car x) (car y))))) + (insert "% " (nth 1 entry) "\n" (nth 2 entry) "\n\n"))) + ;; `bibtex-sort-buffer' fails with the file names associated with + ;; each entry. Prior to sorting we could make the file name + ;; a BibTeX field of each entry (using `bibtex-make-field'). + ;; Or we could make it a text property that we unfold afterwards. + ;; (bibtex-sort-buffer) + (bibtex-mode) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (goto-char (point-min))) + ;; Make BibTeX a Feature ------------------------------------------------------------ revno: 104499 committer: Roland Winkler branch nick: trunk timestamp: Sat 2011-06-04 23:58:39 -0500 message: lisp/textmodes/bibtex.el: various small bug fixes diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-05 04:47:45 +0000 +++ lisp/ChangeLog 2011-06-05 04:58:39 +0000 @@ -1,5 +1,14 @@ 2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-generate-url-list): Fix docstring. + (bibtex-insert-kill): After yanking insert newline if necessary. + (bibtex-initialize): Call bibtex-string-files-init only once. + (bibtex-mode): Do not call easy-menu-add. + (bibtex-validate-globally): Use save-excursion in bibtex buffers. + (bibtex-yank): Set arg properly if nil. + +2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-search-entry-globally): New variable. (bibtex-search-entry): Use it. === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2011-06-05 04:47:45 +0000 +++ lisp/textmodes/bibtex.el 2011-06-05 04:58:39 +0000 @@ -923,7 +923,7 @@ (((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\") \"http://link.aps.org/abstract/%s/v%s/p%s\" - (\"journal\" \".*\" downcase) + (\"journal\" \".*\" upcase) (\"volume\" \".*\" 0) (\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))" :group 'bibtex @@ -1892,6 +1892,9 @@ (push-mark) (insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring)) + ;; If we copied an entry from a buffer containing only this one entry, + ;; it can be missing the second "\n". + (unless (looking-back "\n\n") (insert "\n")) (unless (functionp bibtex-reference-keys) ;; update `bibtex-reference-keys' (save-excursion @@ -2723,12 +2726,14 @@ ((and (not current) (memq (current-buffer) buffer-list)) (setq buffer-list (delq (current-buffer) buffer-list)))) ;; parse keys - (dolist (buffer buffer-list) - (with-current-buffer buffer - (if (or force (functionp bibtex-reference-keys)) - (bibtex-parse-keys)) - (unless (functionp bibtex-strings) - (bibtex-parse-strings (bibtex-string-files-init))))) + (let (string-init) + (dolist (buffer buffer-list) + (with-current-buffer buffer + (if (or force (functionp bibtex-reference-keys)) + (bibtex-parse-keys)) + (when (or force (functionp bibtex-strings)) + (unless string-init (setq string-init (bibtex-string-files-init))) + (bibtex-parse-strings string-init))))) ;; select BibTeX buffer (if select (if buffer-list @@ -3043,10 +3048,7 @@ bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) - imenu-case-fold-search t) - ;; XEmacs needs `easy-menu-add', Emacs does not care - (easy-menu-add bibtex-edit-menu) - (easy-menu-add bibtex-entry-menu)) + imenu-case-fold-search t)) (defun bibtex-field-list (entry-type) "Return list of allowed fields for entry ENTRY-TYPE. @@ -3873,20 +3875,21 @@ ;; Check for duplicate keys within BibTeX buffer (dolist (buffer buffer-list) (with-current-buffer buffer - (let (entry-type key key-list) - (goto-char (point-min)) - (while (re-search-forward bibtex-entry-head nil t) - (setq entry-type (bibtex-type-in-head) - key (bibtex-key-in-head)) - (if (or (and strings (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) - (if (member key key-list) - (push (format "%s:%d: Duplicate key `%s'\n" - (buffer-file-name) - (bibtex-current-line) key) - error-list) - (push key key-list)))) - (push (cons buffer key-list) buffer-key-list)))) + (save-excursion + (let (entry-type key key-list) + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (setq entry-type (bibtex-type-in-head) + key (bibtex-key-in-head)) + (if (or (and strings (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (if (member key key-list) + (push (format "%s:%d: Duplicate key `%s'\n" + (buffer-file-name) + (bibtex-current-line) key) + error-list) + (push key key-list)))) + (push (cons buffer key-list) buffer-key-list))))) ;; Check for duplicate keys among BibTeX buffers (while (setq current-buf (pop buffer-list)) @@ -4148,6 +4151,7 @@ With argument N, reinsert the Nth most recently killed BibTeX item. See also the command \\[bibtex-yank-pop]." (interactive "*p") + (unless n (setq n 1)) (bibtex-insert-kill (1- n) t) (setq this-command 'bibtex-yank)) ------------------------------------------------------------ revno: 104498 committer: Roland Winkler branch nick: trunk timestamp: Sat 2011-06-04 23:47:45 -0500 message: lisp/textmodes/bibtex.el (bibtex-search-entry-globally): New variable diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-05 04:39:40 +0000 +++ etc/NEWS 2011-06-05 04:47:45 +0000 @@ -440,6 +440,8 @@ *** New `bibtex-entry-format' option `sort-fields', disabled by default. +*** New variable `bibtex-search-entry-globally'. + ** latex-electric-env-pair-mode keeps \begin..\end matched on the fly. ** FIXME: xdg-open for browse-url and reportbug, 2010/08. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-05 04:39:40 +0000 +++ lisp/ChangeLog 2011-06-05 04:47:45 +0000 @@ -1,5 +1,11 @@ 2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-search-entry-globally): New + variable. + (bibtex-search-entry): Use it. + +2011-06-05 Roland Winkler + * textmodes/bibtex.el (bibtex-entry-format): New option sort-fields. (bibtex-format-entry, bibtex-reformat): Honor this option. === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2011-06-05 04:39:40 +0000 +++ lisp/textmodes/bibtex.el 2011-06-05 04:47:45 +0000 @@ -597,7 +597,8 @@ List elements can be absolute file names or file names relative to the directories specified in `bibtex-file-path'. If an element is a directory, check all BibTeX files in this directory. If an element is the symbol -`bibtex-file-path', check all BibTeX files in `bibtex-file-path'." +`bibtex-file-path', check all BibTeX files in `bibtex-file-path'. +See also `bibtex-search-entry-globally'." :group 'bibtex :type '(repeat (choice (const :tag "bibtex-file-path" bibtex-file-path) directory file))) @@ -605,6 +606,12 @@ (defvar bibtex-file-path (getenv "BIBINPUTS") "*Colon separated list of paths to search for `bibtex-files'.") +(defcustom bibtex-search-entry-globally nil + "If non-nil, interactive calls of `bibtex-search-entry' search globally. +A global search includes all files in `bibtex-files'." + :group 'bibtex + :type 'boolean) + (defcustom bibtex-help-message t "If non-nil print help messages in the echo area on entering a new field." :group 'bibtex @@ -3585,10 +3592,15 @@ where the search starts. If it is nil, start search at beginning of buffer. If DISPLAY is non-nil, display the buffer containing KEY. Otherwise, use `set-buffer'. -When called interactively, GLOBAL is t if there is a prefix arg or the current -mode is not `bibtex-mode', START is nil, and DISPLAY is t." +When called interactively, START is nil, DISPLAY is t. +Also, GLOBAL is t if the current mode is not `bibtex-mode' +or `bibtex-search-entry-globally' is non-nil. +A prefix arg negates the value of `bibtex-search-entry-globally'." (interactive - (let ((global (or current-prefix-arg (not (eq major-mode 'bibtex-mode))))) + (let ((global (or (not (eq major-mode 'bibtex-mode)) + (if bibtex-search-entry-globally + (not current-prefix-arg) + current-prefix-arg)))) (list (bibtex-read-key "Find key: " nil global) global nil t))) (if (and global bibtex-files) (let ((buffer-list (bibtex-initialize t)) ------------------------------------------------------------ revno: 104497 committer: Roland Winkler branch nick: trunk timestamp: Sat 2011-06-04 23:39:40 -0500 message: lisp/textmodes/bibtex.el (bibtex-entry-format): new option sort-fields diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-04 21:02:42 +0000 +++ etc/NEWS 2011-06-05 04:39:40 +0000 @@ -436,6 +436,10 @@ ** Modula-2 mode provides auto-indentation. +** BibTeX mode + +*** New `bibtex-entry-format' option `sort-fields', disabled by default. + ** latex-electric-env-pair-mode keeps \begin..\end matched on the fly. ** FIXME: xdg-open for browse-url and reportbug, 2010/08. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-05 00:18:46 +0000 +++ lisp/ChangeLog 2011-06-05 04:39:40 +0000 @@ -1,3 +1,10 @@ +2011-06-05 Roland Winkler + + * textmodes/bibtex.el (bibtex-entry-format): New option + sort-fields. + (bibtex-format-entry, bibtex-reformat): Honor this option. + (bibtex-parse-entry): Return fields in proper order. + 2011-06-05 Juanma Barranquero * doc-view.el (doc-view-remove-if): Move computation of result out === modified file 'lisp/textmodes/bibtex.el' --- lisp/textmodes/bibtex.el 2011-05-24 02:45:50 +0000 +++ lisp/textmodes/bibtex.el 2011-06-05 04:39:40 +0000 @@ -126,6 +126,8 @@ `bibtex-field-braces-alist'. strings Replace parts of field entries by string constants according to `bibtex-field-strings-alist'. +sort-fields Sort fields to match the field order in + `bibtex-entry-field-alist'. The value t means do all of the above formatting actions. The value nil means do no formatting at all." @@ -144,7 +146,8 @@ (const delimiters) (const unify-case) (const braces) - (const strings)))) + (const strings) + (const sort-fields)))) (put 'bibtex-entry-format 'safe-local-variable (lambda (x) (or (eq x t) @@ -153,7 +156,8 @@ (unless (memq (pop x) '(opts-or-alts required-fields numerical-fields page-dashes whitespace inherit-booktitle realign - last-comma delimiters unify-case braces strings)) + last-comma delimiters unify-case braces strings + sort-fields)) (setq OK nil))) (unless (null x) (setq OK nil)) OK)))) @@ -1906,7 +1910,7 @@ '(realign opts-or-alts required-fields numerical-fields page-dashes whitespace inherit-booktitle last-comma delimiters unify-case braces - strings) + strings sort-fields) bibtex-entry-format)) (left-delim-re (regexp-quote (bibtex-field-left-delimiter))) bounds crossref-key req-field-list default-field-list field-list @@ -1962,7 +1966,21 @@ ;; default list of fields that may appear in this entry default-field-list (append (nth 0 (nth 1 entry-list)) (nth 1 (nth 1 entry-list)) - bibtex-user-optional-fields))) + bibtex-user-optional-fields)) + + (when (memq 'sort-fields format) + (goto-char (point-min)) + (let ((beg-fields (save-excursion (bibtex-beginning-first-field))) + (fields-alist (bibtex-parse-entry)) + bibtex-help-message elt) + (delete-region beg-fields (point)) + (dolist (field default-field-list) + (when (setq elt (assoc-string (car field) fields-alist t)) + (setq fields-alist (delete elt fields-alist)) + (bibtex-make-field (list (car elt) "" (cdr elt)) nil nil t))) + (dolist (field fields-alist) + (unless (member (car field) '("=key=" "=type=")) + (bibtex-make-field (list (car field) "" (cdr field)) nil nil t)))))) ;; process all fields (bibtex-beginning-first-field (point-min)) @@ -3139,7 +3157,7 @@ (bibtex-text-in-field-bounds bounds content)) alist) (goto-char (bibtex-end-of-field bounds)))) - alist)) + (nreverse alist))) (defun bibtex-autofill-entry () "Try to fill fields of current BibTeX entry based on neighboring entries. @@ -4397,14 +4415,15 @@ ("Force delimiters? " . 'delimiters) ("Unify case of entry types and field names? " . 'unify-case) ("Enclose parts of field entries by braces? " . 'braces) - ("Replace parts of field entries by string constants? " . 'strings)))))) + ("Replace parts of field entries by string constants? " . 'strings) + ("Sort fields? " . 'sort-fields)))))) ;; Do not include required-fields because `bibtex-reformat' ;; cannot handle the error messages of `bibtex-format-entry'. ;; Use `bibtex-validate' to check for required fields. ((eq t bibtex-entry-format) '(realign opts-or-alts numerical-fields delimiters last-comma page-dashes unify-case inherit-booktitle - whitespace braces strings)) + whitespace braces strings sort-fields)) (t (cons 'realign (remove 'required-fields bibtex-entry-format))))) (reformat-reference-keys ------------------------------------------------------------ revno: 104496 committer: Juanma Barranquero branch nick: trunk timestamp: Sun 2011-06-05 02:18:46 +0200 message: lisp/doc-view.el: Silence compiler warning. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-04 22:46:26 +0000 +++ lisp/ChangeLog 2011-06-05 00:18:46 +0000 @@ -1,3 +1,8 @@ +2011-06-05 Juanma Barranquero + + * doc-view.el (doc-view-remove-if): Move computation of result out + of `dolist' to silence misleading lexical-binding warning. + 2011-06-04 Chong Yidong * emacs-lisp/timer.el (timer-activate): Remove unused arg. === modified file 'lisp/doc-view.el' --- lisp/doc-view.el 2011-05-10 02:31:42 +0000 +++ lisp/doc-view.el 2011-06-05 00:18:46 +0000 @@ -614,9 +614,10 @@ (defun doc-view-remove-if (predicate list) "Return LIST with all items removed that satisfy PREDICATE." (let (new-list) - (dolist (item list (nreverse new-list)) + (dolist (item list) (when (not (funcall predicate item)) - (setq new-list (cons item new-list)))))) + (setq new-list (cons item new-list)))) + (nreverse new-list))) ;;;###autoload (defun doc-view-mode-p (type) ------------------------------------------------------------ revno: 104495 committer: Juanma Barranquero branch nick: trunk timestamp: Sun 2011-06-05 02:14:08 +0200 message: src/xdisp.c (single_display_spec_intangible_p): Remove declaration. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-04 22:08:32 +0000 +++ src/ChangeLog 2011-06-05 00:14:08 +0000 @@ -1,3 +1,7 @@ +2011-06-05 Juanma Barranquero + + * xdisp.c (single_display_spec_intangible_p): Remove declaration. + 2011-06-04 Chong Yidong * xselect.c (x_clipboard_manager_save): Remove redundant arg. === modified file 'src/xdisp.c' --- src/xdisp.c 2011-06-04 07:41:44 +0000 +++ src/xdisp.c 2011-06-05 00:14:08 +0000 @@ -779,7 +779,6 @@ static int store_mode_line_noprop (const char *, int, int); static void handle_stop (struct it *); static void handle_stop_backwards (struct it *, EMACS_INT); -static int single_display_spec_intangible_p (Lisp_Object); static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); static void ensure_echo_area_buffers (void); static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object); ------------------------------------------------------------ revno: 104494 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-06-04 18:46:26 -0400 message: Doc fixes for timer.el (Bug#8793). * emacs-lisp/timer.el (timer-activate): Remove unused arg. (timer-activate, timer-activate-when-idle): Doc fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-04 14:11:26 +0000 +++ lisp/ChangeLog 2011-06-04 22:46:26 +0000 @@ -1,3 +1,8 @@ +2011-06-04 Chong Yidong + + * emacs-lisp/timer.el (timer-activate): Remove unused arg. + (timer-activate, timer-activate-when-idle): Doc fix (Bug#8793). + 2011-06-04 Michael Albinus * net/tramp-sh.el (tramp-find-shell): Apply workaround also for === modified file 'lisp/emacs-lisp/timer.el' --- lisp/emacs-lisp/timer.el 2011-01-25 04:08:28 +0000 +++ lisp/emacs-lisp/timer.el 2011-06-04 22:46:26 +0000 @@ -189,35 +189,35 @@ (setcdr reuse-cell timers)) (setq reuse-cell (cons timer timers))) ;; Insert new timer after last which possibly means in front of queue. - (if last - (setcdr last reuse-cell) - (if idle - (setq timer-idle-list reuse-cell) - (setq timer-list reuse-cell))) + (cond (last (setcdr last reuse-cell)) + (idle (setq timer-idle-list reuse-cell)) + (t (setq timer-list reuse-cell))) (setf (timer--triggered timer) triggered-p) (setf (timer--idle-delay timer) idle) nil) (error "Invalid or uninitialized timer"))) -(defun timer-activate (timer &optional triggered-p reuse-cell idle) - "Put TIMER on the list of active timers. - -If TRIGGERED-P is t, that means to make the timer inactive -\(put it on the list, but mark it as already triggered). -To remove from the list, use `cancel-timer'. - -REUSE-CELL, if non-nil, is a cons cell to reuse instead -of allocating a new one." +(defun timer-activate (timer &optional triggered-p reuse-cell) + "Insert TIMER into `timer-list'. +If TRIGGERED-P is t, make TIMER inactive (put it on the list, but +mark it as already triggered). To remove it, use `cancel-timer'. + +REUSE-CELL, if non-nil, is a cons cell to reuse when inserting +TIMER into `timer-list' (usually a cell removed from that list by +`cancel-timer-internal'; using this reduces consing for repeat +timers). If nil, allocate a new cell." (timer--activate timer triggered-p reuse-cell nil)) (defun timer-activate-when-idle (timer &optional dont-wait reuse-cell) - "Arrange to activate TIMER whenever Emacs is next idle. -If optional argument DONT-WAIT is non-nil, then enable the -timer to activate immediately, or at the right time, if Emacs -is already idle. + "Insert TIMER into `timer-idle-list'. +This arranges to activate TIMER whenever Emacs is next idle. +If optional argument DONT-WAIT is non-nil, set TIMER to activate +immediately, or at the right time, if Emacs is already idle. -REUSE-CELL, if non-nil, is a cons cell to reuse instead -of allocating a new one." +REUSE-CELL, if non-nil, is a cons cell to reuse when inserting +TIMER into `timer-idle-list' (usually a cell removed from that +list by `cancel-timer-internal'; using this reduces consing for +repeat timers). If nil, allocate a new cell." (timer--activate timer (not dont-wait) reuse-cell 'idle)) (defalias 'disable-timeout 'cancel-timer) ------------------------------------------------------------ revno: 104493 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-06-04 18:08:32 -0400 message: * src/xselect.c (x_get_foreign_selection): Reduce scope of x_catch_errors (Bug#8790). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-04 21:02:42 +0000 +++ src/ChangeLog 2011-06-04 22:08:32 +0000 @@ -8,6 +8,7 @@ Obey Vx_select_enable_clipboard_manager. Catch errors in x_clipboard_manager_save (Bug#8779). (Vx_select_enable_clipboard_manager): New variable. + (x_get_foreign_selection): Reduce scope of x_catch_errors (Bug#8790). 2011-06-04 Dan Nicolaescu === modified file 'src/xselect.c' --- src/xselect.c 2011-06-04 21:02:42 +0000 +++ src/xselect.c 2011-06-04 22:08:32 +0000 @@ -1207,7 +1207,6 @@ ? symbol_to_x_atom (dpyinfo, XCAR (target_type)) : symbol_to_x_atom (dpyinfo, target_type)); int secs, usecs; - int count = SPECPDL_INDEX (); if (!FRAME_LIVE_P (f)) return Qnil; @@ -1225,20 +1224,15 @@ } BLOCK_INPUT; - - /* The protected block contains wait_reading_process_output, which - can run random lisp code (process handlers) or signal. - Therefore, we put the x_uncatch_errors call in an unwind. */ - record_unwind_protect (x_catch_errors_unwind, Qnil); - x_catch_errors (display); - TRACE2 ("Get selection %s, type %s", XGetAtomName (display, type_atom), XGetAtomName (display, target_property)); + x_catch_errors (display); XConvertSelection (display, selection_atom, type_atom, target_property, requestor_window, requestor_time); - XFlush (display); + x_check_errors (display, "Can't convert selection: %s"); + x_uncatch_errors (); /* Prepare to block until the reply has been read. */ reading_selection_window = requestor_window; @@ -1264,13 +1258,6 @@ reading_selection_reply, NULL, 0); TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply))); - BLOCK_INPUT; - if (x_had_errors_p (display)) - error ("Cannot get selection"); - /* This calls x_uncatch_errors. */ - unbind_to (count, Qnil); - UNBLOCK_INPUT; - if (NILP (XCAR (reading_selection_reply))) error ("Timed out waiting for reply from selection owner"); if (EQ (XCAR (reading_selection_reply), Qlambda)) ------------------------------------------------------------ revno: 104492 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-06-04 17:02:42 -0400 message: Handle errors when saving to clipboard manager (Bug#8779). * src/xselect.c (x_clipboard_manager_save): Remove redundant arg. (x_clipboard_manager_save): Add return value. (x_clipboard_manager_error_1, x_clipboard_manager_error_2): New error handlers. (x_clipboard_manager_save_frame, x_clipboard_manager_save_all): Obey Vx_select_enable_clipboard_manager. Catch errors in x_clipboard_manager_save (Bug#8779). (Vx_select_enable_clipboard_manager): New variable. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-04 12:31:34 +0000 +++ etc/NEWS 2011-06-04 21:02:42 +0000 @@ -400,6 +400,9 @@ *** Support for X clipboard managers has been added. +**** To inhibit use of the clipboard manager, set +`x-select-enable-clipboard-manager' to nil. + ** New command `rectangle-number-lines', bound to `C-x r N', numbers the lines in the current rectangle. With an prefix argument, this prompts for a number to count from and for a format string. === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-04 18:29:18 +0000 +++ src/ChangeLog 2011-06-04 21:02:42 +0000 @@ -1,3 +1,14 @@ +2011-06-04 Chong Yidong + + * xselect.c (x_clipboard_manager_save): Remove redundant arg. + (x_clipboard_manager_save): Add return value. + (x_clipboard_manager_error_1, x_clipboard_manager_error_2): New + error handlers. + (x_clipboard_manager_save_frame, x_clipboard_manager_save_all): + Obey Vx_select_enable_clipboard_manager. Catch errors in + x_clipboard_manager_save (Bug#8779). + (Vx_select_enable_clipboard_manager): New variable. + 2011-06-04 Dan Nicolaescu * emacs.c (main): Warn when starting a GTK emacs in daemon mode. === modified file 'src/xselect.c' --- src/xselect.c 2011-05-29 05:23:24 +0000 +++ src/xselect.c 2011-06-04 21:02:42 +0000 @@ -2108,15 +2108,14 @@ } -/* Send the clipboard manager a SAVE_TARGETS request with a - UTF8_STRING property, as described by - http://www.freedesktop.org/wiki/ClipboardManager */ +/* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING + property (http://www.freedesktop.org/wiki/ClipboardManager). */ -static void -x_clipboard_manager_save (struct x_display_info *dpyinfo, - Lisp_Object frame) +static Lisp_Object +x_clipboard_manager_save (Lisp_Object frame) { struct frame *f = XFRAME (frame); + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Atom data = dpyinfo->Xatom_UTF8_STRING; XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), @@ -2125,6 +2124,31 @@ (unsigned char *) &data, 1); x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS, Qnil, frame); + return Qt; +} + +/* Error handler for x_clipboard_manager_save_frame. */ + +static Lisp_Object +x_clipboard_manager_error_1 (Lisp_Object err) +{ + Lisp_Object args[2]; + args[0] = build_string ("X clipboard manager error: %s\n\ +If the problem persists, set `x-select-enable-clipboard-manager' to nil."); + args[1] = CAR (CDR (err)); + Fmessage (2, args); + return Qnil; +} + +/* Error handler for x_clipboard_manager_save_all. */ + +static Lisp_Object +x_clipboard_manager_error_2 (Lisp_Object err) +{ + fprintf (stderr, "Error saving to X clipboard manager.\n\ +If the problem persists, set `x-select-enable-clipboard-manager' \ +to nil.\n"); + return Qnil; } /* Called from delete_frame: save any clipboard owned by FRAME to the @@ -2136,7 +2160,8 @@ { struct frame *f; - if (FRAMEP (frame) + if (!NILP (Vx_select_enable_clipboard_manager) + && FRAMEP (frame) && (f = XFRAME (frame), FRAME_X_P (f)) && FRAME_LIVE_P (f)) { @@ -2148,7 +2173,8 @@ && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection))))) && XGetSelectionOwner (dpyinfo->display, dpyinfo->Xatom_CLIPBOARD_MANAGER)) - x_clipboard_manager_save (dpyinfo, frame); + internal_condition_case_1 (x_clipboard_manager_save, frame, Qt, + x_clipboard_manager_error_1); } } @@ -2162,6 +2188,10 @@ /* Loop through all X displays, saving owned clipboards. */ struct x_display_info *dpyinfo; Lisp_Object local_selection, local_frame; + + if (NILP (Vx_select_enable_clipboard_manager)) + return; + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo); @@ -2172,7 +2202,8 @@ local_frame = XCAR (XCDR (XCDR (XCDR (local_selection)))); if (FRAME_LIVE_P (XFRAME (local_frame))) - x_clipboard_manager_save (dpyinfo, local_frame); + internal_condition_case_1 (x_clipboard_manager_save, local_frame, + Qt, x_clipboard_manager_error_2); } } @@ -2641,6 +2672,14 @@ it merely informs you that they have happened. */); Vx_sent_selection_functions = Qnil; + DEFVAR_LISP ("x-select-enable-clipboard-manager", + Vx_select_enable_clipboard_manager, + doc: /* Whether to enable X clipboard manager support. +If non-nil, then whenever Emacs is killed or an Emacs frame is deleted +while owning the X clipboard, the clipboard contents are saved to the +clipboard manager if one is present. */); + Vx_select_enable_clipboard_manager = Qt; + DEFVAR_INT ("x-selection-timeout", x_selection_timeout, doc: /* Number of milliseconds to wait for a selection reply. If the selection owner doesn't reply in this time, we give up. ------------------------------------------------------------ revno: 104491 [merge] committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-06-04 11:29:18 -0700 message: Merge from emacs-23; up to r100591. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-04 08:04:48 +0000 +++ src/ChangeLog 2011-06-04 18:29:18 +0000 @@ -1,3 +1,12 @@ +2011-06-04 Dan Nicolaescu + + * emacs.c (main): Warn when starting a GTK emacs in daemon mode. + +2011-06-04 YAMAMOTO Mitsuharu + + * fringe.c (update_window_fringes): Don't update overlay arrow bitmap + in the current matrix if keep_current_p is non-zero. + 2011-06-04 Eli Zaretskii * bidi.c (bidi_level_of_next_char): Fix last change. === modified file 'src/emacs.c' --- src/emacs.c 2011-06-01 21:54:35 +0000 +++ src/emacs.c 2011-06-04 18:29:18 +0000 @@ -1002,6 +1002,11 @@ } #ifndef NS_IMPL_COCOA +#ifdef USE_GTK + fprintf (stderr, "\nWarning: due to a long standing Gtk+ bug\nhttp://bugzilla.gnome.org/show_bug.cgi?id=85715\n\ +Emacs might crash when run in daemon mode and the X11 connection is unexpectedly lost.\n\ +Using an Emacs configured with --with-x-toolkit=lucid does not have this problem.\n"); +#endif f = fork (); #else /* NS_IMPL_COCOA */ /* Under Cocoa we must do fork+exec as CoreFoundation lib fails in === modified file 'src/fringe.c' --- src/fringe.c 2011-05-25 03:45:04 +0000 +++ src/fringe.c 2011-06-04 18:29:18 +0000 @@ -1279,8 +1279,12 @@ if (row->overlay_arrow_bitmap != cur->overlay_arrow_bitmap) { - redraw_p = row->redraw_fringe_bitmaps_p = cur->redraw_fringe_bitmaps_p = 1; - cur->overlay_arrow_bitmap = row->overlay_arrow_bitmap; + redraw_p = row->redraw_fringe_bitmaps_p = 1; + if (!keep_current_p) + { + cur->redraw_fringe_bitmaps_p = 1; + cur->overlay_arrow_bitmap = row->overlay_arrow_bitmap; + } } row->left_fringe_bitmap = left; ------------------------------------------------------------ revno: 104490 committer: Paul Eggert branch nick: trunk timestamp: Sat 2011-06-04 09:51:28 -0700 message: * lib/getopt.c: Merge trivial change from gnulib. diff: === modified file 'lib/getopt.c' --- lib/getopt.c 2011-05-27 16:58:43 +0000 +++ lib/getopt.c 2011-06-04 16:51:28 +0000 @@ -488,7 +488,6 @@ struct option_list *next; } *ambig_list = NULL; int exact = 0; - int ambig = 0; int indfound = -1; int option_index; ------------------------------------------------------------ revno: 104489 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Sat 2011-06-04 17:13:11 +0200 message: Fix mistake in last iswitchb.el bug fix. diff: === modified file 'lisp/iswitchb.el' --- lisp/iswitchb.el 2011-06-04 11:02:37 +0000 +++ lisp/iswitchb.el 2011-06-04 15:13:11 +0000 @@ -1119,7 +1119,7 @@ (interactive) (let ((blist (iswitchb-get-buffers-in-frames 'current))) ;; If the buffer is visible in current frame, return nil - (when (member buffer blist) + (unless (member buffer blist) ;; maybe in other frame or icon (get-buffer-window buffer 0) ; better than 'visible ))) ------------------------------------------------------------ revno: 104488 committer: Michael Albinus branch nick: trunk timestamp: Sat 2011-06-04 16:11:26 +0200 message: * net/tramp-sh.el (tramp-find-shell): Apply workaround also for "SunOS 5.10". diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-04 13:58:37 +0000 +++ lisp/ChangeLog 2011-06-04 14:11:26 +0000 @@ -1,5 +1,10 @@ 2011-06-04 Michael Albinus + * net/tramp-sh.el (tramp-find-shell): Apply workaround also for + "SunOS 5.10". + +2011-06-04 Michael Albinus + * net/tramp.el (tramp-set-completion-function, tramp-parse-rhosts) (tramp-parse-shosts, tramp-parse-sconfig, tramp-parse-shostkeys) (tramp-parse-hosts, tramp-parse-passwd, tramp-parse-netrc) === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2011-06-04 13:58:37 +0000 +++ lisp/net/tramp-sh.el 2011-06-04 14:11:26 +0000 @@ -3641,9 +3641,11 @@ (tramp-send-command vec "echo ~root" t) (cond ((or (string-match "^~root$" (buffer-string)) - ;; The default shell (ksh93) of OpenSolaris is buggy. - (string-equal (tramp-get-connection-property vec "uname" "") - "SunOS 5.11")) + ;; The default shell (ksh93) of OpenSolaris and Solaris + ;; is buggy. We've got reports for "SunOS 5.10" and + ;; "SunOS 5.11" so far. + (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + (tramp-get-connection-property vec "uname" ""))) (setq shell (or (tramp-find-executable vec "bash" (tramp-get-remote-path vec) t t) ------------------------------------------------------------ revno: 104487 committer: Michael Albinus branch nick: trunk timestamp: Sat 2011-06-04 15:58:37 +0200 message: * net/tramp.el (tramp-set-completion-function, tramp-parse-rhosts) (tramp-parse-shosts, tramp-parse-sconfig, tramp-parse-shostkeys) (tramp-parse-hosts, tramp-parse-passwd, tramp-parse-netrc) (tramp-parse-putty): * net/tramp-sh.el (tramp-completion-function-alist-rsh) (tramp-completion-function-alist-ssh) (tramp-completion-function-alist-telnet) (tramp-completion-function-alist-su) (tramp-completion-function-alist-putty): Set `tramp-autoload' cookie. * net/tramp-ftp.el: * net/tramp-sh.el: * net/tramp-smb.el: Set `tramp-autoload' cookie, and eval after load "tramp.el" `tramp-set-completion-function'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-04 12:31:34 +0000 +++ lisp/ChangeLog 2011-06-04 13:58:37 +0000 @@ -1,3 +1,21 @@ +2011-06-04 Michael Albinus + + * net/tramp.el (tramp-set-completion-function, tramp-parse-rhosts) + (tramp-parse-shosts, tramp-parse-sconfig, tramp-parse-shostkeys) + (tramp-parse-hosts, tramp-parse-passwd, tramp-parse-netrc) + (tramp-parse-putty): + * net/tramp-sh.el (tramp-completion-function-alist-rsh) + (tramp-completion-function-alist-ssh) + (tramp-completion-function-alist-telnet) + (tramp-completion-function-alist-su) + (tramp-completion-function-alist-putty): Set `tramp-autoload' + cookie. + + * net/tramp-ftp.el: + * net/tramp-sh.el: + * net/tramp-smb.el: Set `tramp-autoload' cookie, and eval after + load "tramp.el" `tramp-set-completion-function'. + 2011-06-04 Stefan Monnier * shell.el: Require and use pcomplete. === modified file 'lisp/net/tramp-ftp.el' --- lisp/net/tramp-ftp.el 2011-05-23 17:57:17 +0000 +++ lisp/net/tramp-ftp.el 2011-06-04 13:58:37 +0000 @@ -113,9 +113,11 @@ (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))) ;; Add completion function for FTP method. -(tramp-set-completion-function - tramp-ftp-method - '((tramp-parse-netrc "~/.netrc"))) +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-ftp-method + '((tramp-parse-netrc "~/.netrc")))) ;; If there is URL syntax, `substitute-in-file-name' needs special ;; handling. === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2011-06-02 03:48:23 +0000 +++ lisp/net/tramp-sh.el 2011-06-04 13:58:37 +0000 @@ -400,11 +400,13 @@ "\\'") nil ,(user-login-name))) +;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh '((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "~/.rhosts")) "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh '((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") @@ -420,47 +422,60 @@ (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-telnet '((tramp-parse-hosts "/etc/hosts")) "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-su '((tramp-parse-passwd "/etc/passwd")) "Default list of (FUNCTION FILE) pairs to be examined for su methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-putty '((tramp-parse-putty "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions")) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.") -(tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsyncc" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh1_old" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh2_old" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet) -(tramp-set-completion-function "su" tramp-completion-function-alist-su) -(tramp-set-completion-function "sudo" tramp-completion-function-alist-su) -(tramp-set-completion-function "ksu" tramp-completion-function-alist-su) -(tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "plink1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty) -(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh) +;;;###tramp-autoload +(eval-after-load 'tramp + '(progn + (tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "rsyncc" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh1_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh2_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "telnet" tramp-completion-function-alist-telnet) + (tramp-set-completion-function "su" tramp-completion-function-alist-su) + (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) + (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) + (tramp-set-completion-function + "krlogin" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "plink1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "plinkx" tramp-completion-function-alist-putty) + (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))) ;; "getconf PATH" yields: ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin === modified file 'lisp/net/tramp-smb.el' --- lisp/net/tramp-smb.el 2011-06-02 03:48:23 +0000 +++ lisp/net/tramp-smb.el 2011-06-04 13:58:37 +0000 @@ -53,9 +53,11 @@ `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) ;; Add completion function for SMB method. -(tramp-set-completion-function - tramp-smb-method - '((tramp-parse-netrc "~/.netrc"))) +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-smb-method + '((tramp-parse-netrc "~/.netrc")))) (defcustom tramp-smb-program "smbclient" "*Name of SMB client to run." === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2011-06-02 03:48:23 +0000 +++ lisp/net/tramp.el 2011-06-04 13:58:37 +0000 @@ -1500,6 +1500,7 @@ ;;; Config Manipulation Functions: +;;;###tramp-autoload (defun tramp-set-completion-function (method function-list) "Sets the list of completion functions for METHOD. FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). @@ -2366,6 +2367,7 @@ (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +;;;###tramp-autoload (defun tramp-parse-rhosts (filename) "Return a list of (user host) tuples allowed to access. Either user or host may be nil." @@ -2396,6 +2398,7 @@ (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-shosts (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2425,6 +2428,7 @@ (forward-line 1)) result)) +;;;###tramp-autoload (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2454,6 +2458,7 @@ (forward-line 1)) result)) +;;;###tramp-autoload (defun tramp-parse-shostkeys (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2485,6 +2490,7 @@ (setq files (cdr files))) result)) +;;;###tramp-autoload (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2519,6 +2525,7 @@ ;; as default. Unfortunately, we have no information whether any user name ;; has been typed already. So we use `tramp-current-user' as indication, ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'. +;;;###tramp-autoload (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. Host is always \"localhost\"." @@ -2548,6 +2555,7 @@ (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." @@ -2578,6 +2586,7 @@ (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-putty (registry) "Return a list of (user host) tuples allowed to access. User is always nil." ------------------------------------------------------------ revno: 104486 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2011-06-04 09:31:34 -0300 message: * lisp/shell.el: Require and use pcomplete. (shell-dynamic-complete-functions): Add pcomplete-completions-at-point. (shell-completion-vars): Set pcomplete-default-completion-function. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-06-01 15:34:41 +0000 +++ etc/NEWS 2011-06-04 12:31:34 +0000 @@ -85,6 +85,8 @@ error, its exit status is 1. ** Completion +*** shell-mode uses pcomplete rules, with the standard completion UI. + *** Many packages have been changed to use completion-at-point rather than their own completion code. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-04 11:02:37 +0000 +++ lisp/ChangeLog 2011-06-04 12:31:34 +0000 @@ -1,3 +1,9 @@ +2011-06-04 Stefan Monnier + + * shell.el: Require and use pcomplete. + (shell-dynamic-complete-functions): Add pcomplete-completions-at-point. + (shell-completion-vars): Set pcomplete-default-completion-function. + 2011-06-04 Deniz Dogan * iswitchb.el (iswitchb-window-buffer-p): Use `member' instead of === modified file 'lisp/shell.el' --- lisp/shell.el 2011-05-27 01:54:56 +0000 +++ lisp/shell.el 2011-06-04 12:31:34 +0000 @@ -98,6 +98,7 @@ (eval-when-compile (require 'cl)) (require 'comint) +(require 'pcomplete) ;;; Customization and Buffer Variables @@ -186,7 +187,9 @@ shell-environment-variable-completion shell-command-completion shell-c-a-p-replace-by-expanded-directory + pcomplete-completions-at-point shell-filename-completion + ;; Not sure when this one would still be useful. --Stef comint-filename-completion) "List of functions called to perform completion. This variable is used to initialize `comint-dynamic-complete-functions' in the @@ -380,7 +383,6 @@ :group 'shell :type '(choice (const nil) regexp)) -(defvar pcomplete-parse-arguments-function) (defun shell-completion-vars () "Setup completion vars for `shell-mode' and `read-shell-command'." @@ -396,6 +398,9 @@ (set (make-local-variable 'pcomplete-parse-arguments-function) ;; FIXME: This function should be moved to shell.el. #'pcomplete-parse-comint-arguments) + ;; Don't use pcomplete's defaulting mechanism, rely on + ;; shell-dynamic-complete-functions instead. + (set (make-local-variable 'pcomplete-default-completion-function) #'ignore) (setq comint-input-autoexpand shell-input-autoexpand) ;; Not needed in shell-mode because it's inherited from comint-mode, but ;; placed here for read-shell-command. ------------------------------------------------------------ revno: 104485 fixes bug(s): http://debbugs.gnu.org/8799 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Sat 2011-06-04 13:02:37 +0200 message: * lisp/iswitchb.el (iswitchb-window-buffer-p): Use `member' instead of `memq'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-02 18:04:44 +0000 +++ lisp/ChangeLog 2011-06-04 11:02:37 +0000 @@ -1,3 +1,8 @@ +2011-06-04 Deniz Dogan + + * iswitchb.el (iswitchb-window-buffer-p): Use `member' instead of + `memq' (Bug#8799). + 2011-06-02 Stefan Monnier * subr.el (make-progress-reporter): Add "..." by default (bug#8785). === modified file 'lisp/iswitchb.el' --- lisp/iswitchb.el 2011-05-23 17:57:17 +0000 +++ lisp/iswitchb.el 2011-06-04 11:02:37 +0000 @@ -1118,10 +1118,9 @@ If BUFFER is visible in the current frame, return nil." (interactive) (let ((blist (iswitchb-get-buffers-in-frames 'current))) - ;;If the buffer is visible in current frame, return nil - (if (memq buffer blist) - nil - ;; maybe in other frame or icon + ;; If the buffer is visible in current frame, return nil + (when (member buffer blist) + ;; maybe in other frame or icon (get-buffer-window buffer 0) ; better than 'visible ))) ------------------------------------------------------------ revno: 104484 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-06-04 11:04:48 +0300 message: src/bidi.c (bidi_level_of_next_char): Fix last change. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-04 07:41:44 +0000 +++ src/ChangeLog 2011-06-04 08:04:48 +0000 @@ -1,3 +1,7 @@ +2011-06-04 Eli Zaretskii + + * bidi.c (bidi_level_of_next_char): Fix last change. + 2011-06-03 Eli Zaretskii Support bidi reordering of text covered by display properties. === modified file 'src/bidi.c' --- src/bidi.c 2011-06-04 07:41:44 +0000 +++ src/bidi.c 2011-06-04 08:04:48 +0000 @@ -1647,7 +1647,7 @@ && bidi_it->next_for_ws.type == UNKNOWN_BT) { int ch; - int clen = bidi_it->ch_len; + EMACS_INT clen = bidi_it->ch_len; EMACS_INT bpos = bidi_it->bytepos; EMACS_INT cpos = bidi_it->charpos; EMACS_INT disp_pos = bidi_it->disp_pos; ------------------------------------------------------------ revno: 104483 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2011-06-04 09:53:22 +0200 message: * lisp/url/url-future.el (url-future-test): Fix scope of `saver'. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-06-01 17:34:24 +0000 +++ lisp/url/ChangeLog 2011-06-04 07:53:22 +0000 @@ -1,3 +1,7 @@ +2011-06-04 Andreas Schwab + + * url-future.el (url-future-test): Fix scope of `saver'. + 2011-06-01 Glenn Morris * url-queue.el (url-queue-parallel-processes, url-queue-timeout): === modified file 'lisp/url/url-future.el' --- lisp/url/url-future.el 2011-05-31 10:47:22 +0000 +++ lisp/url/url-future.el 2011-06-04 07:53:22 +0000 @@ -96,7 +96,8 @@ (url-future-finish url-future 'cancel))) (ert-deftest url-future-test () - (let* ((text "running future") + (let* (saver + (text "running future") (good (make-url-future :value (lambda () (format text)) :callback (lambda (f) (set 'saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) @@ -104,8 +105,7 @@ (tocancel (make-url-future :value (lambda () (/ 1 0)) :callback (lambda (f) (set 'saver f)) :errorback (lambda (&rest d) - (set 'saver d)))) - saver) + (set 'saver d))))) (should (equal good (url-future-call good))) (should (equal good saver)) (should (equal text (url-future-value good))) ------------------------------------------------------------ revno: 104482 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-06-04 10:41:44 +0300 message: Support bidi reordering of text covered by display properties. src/bidi.c (bidi_copy_it): Use offsetof instead of emulating it. (bidi_fetch_char, bidi_fetch_char_advance): New functions. (bidi_cache_search, bidi_cache_iterator_state) (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak) (bidi_level_of_next_char, bidi_move_to_visually_next): Support character positions inside a run of characters covered by a display string. (bidi_paragraph_init, bidi_resolve_explicit_1) (bidi_level_of_next_char): Call bidi_fetch_char and bidi_fetch_char_advance instead of FETCH_CHAR and FETCH_CHAR_ADVANCE. (bidi_init_it): Initialize new members. (LRE_CHAR, RLE_CHAR, PDF_CHAR, LRO_CHAR, RLO_CHAR): Remove macro definitions. (bidi_explicit_dir_char): Lookup character type in bidi_type_table, instead of using explicit *_CHAR codes. (bidi_resolve_explicit, bidi_resolve_weak): Use FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of bidirectional text is supported only in multibyte buffers. (bidi_init_it): Accept additional argument FRAME_WINDOW_P and use it to initialize the frame_window_p member of struct bidi_it. (bidi_cache_iterator_state, bidi_resolve_explicit_1) (bidi_resolve_explicit, bidi_resolve_weak) (bidi_level_of_next_char, bidi_move_to_visually_next): Abort if bidi_it->nchars is non-positive. (bidi_level_of_next_char): Don't try to lookup the cache for the next/previous character if nothing is cached there yet, or if we were just reseat()'ed to a new position. src/xdisp.c (set_cursor_from_row): Set start and stop points according to the row's direction when priming the loop that looks for the glyph on which to display cursor. (single_display_spec_intangible_p): Function deleted. (display_prop_intangible_p): Reimplement to call handle_display_spec instead of single_display_spec_intangible_p. Accept 3 additional arguments needed by handle_display_spec. This fixes incorrect cursor motion across display property with complex values: lists, `(when COND...)' forms, etc. (single_display_spec_string_p): Support property values that are lists with the argument STRING its top-level element. (display_prop_string_p): Fix the condition for processing a property that is a list to be consistent with handle_display_spec. (handle_display_spec): New function, refactored from the last portion of handle_display_prop. (compute_display_string_pos): Accept additional argument FRAME_WINDOW_P. Call handle_display_spec to determine whether the value of a `display' property is a "replacing spec". (handle_single_display_spec): Accept 2 additional arguments BUFPOS and FRAME_WINDOW_P. If IT is NULL, don't set up the iterator from the display property, but just return a value indicating whether the display property will replace the characters it covers. (Fcurrent_bidi_paragraph_direction): Initialize the nchars and frame_window_p members of struct bidi_it. (compute_display_string_pos, compute_display_string_end): New functions. (push_it): Accept second argument POSITION, where pop_it should jump to continue iteration. (reseat_1): Initialize bidi_it.disp_pos. src/keyboard.c (adjust_point_for_property): Adjust the call to display_prop_intangible_p to its new signature. src/dispextern.h (struct bidi_it): New member frame_window_p. (bidi_init_it): Update prototypes. (display_prop_intangible_p): Update prototype. (compute_display_string_pos, compute_display_string_end): Declare prototypes. (struct bidi_it): New members nchars and disp_pos. ch_len is now EMACS_INT. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-06-02 08:40:41 +0000 +++ src/ChangeLog 2011-06-04 07:41:44 +0000 @@ -1,3 +1,77 @@ +2011-06-03 Eli Zaretskii + + Support bidi reordering of text covered by display properties. + + * bidi.c (bidi_copy_it): Use offsetof instead of emulating it. + (bidi_fetch_char, bidi_fetch_char_advance): New functions. + (bidi_cache_search, bidi_cache_iterator_state) + (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak) + (bidi_level_of_next_char, bidi_move_to_visually_next): Support + character positions inside a run of characters covered by a + display string. + (bidi_paragraph_init, bidi_resolve_explicit_1) + (bidi_level_of_next_char): Call bidi_fetch_char and + bidi_fetch_char_advance instead of FETCH_CHAR and + FETCH_CHAR_ADVANCE. + (bidi_init_it): Initialize new members. + (LRE_CHAR, RLE_CHAR, PDF_CHAR, LRO_CHAR, RLO_CHAR): Remove macro + definitions. + (bidi_explicit_dir_char): Lookup character type in bidi_type_table, + instead of using explicit *_CHAR codes. + (bidi_resolve_explicit, bidi_resolve_weak): Use + FETCH_MULTIBYTE_CHAR instead of FETCH_CHAR, as reordering of + bidirectional text is supported only in multibyte buffers. + (bidi_init_it): Accept additional argument FRAME_WINDOW_P and use + it to initialize the frame_window_p member of struct bidi_it. + (bidi_cache_iterator_state, bidi_resolve_explicit_1) + (bidi_resolve_explicit, bidi_resolve_weak) + (bidi_level_of_next_char, bidi_move_to_visually_next): Abort if + bidi_it->nchars is non-positive. + (bidi_level_of_next_char): Don't try to lookup the cache for the + next/previous character if nothing is cached there yet, or if we + were just reseat()'ed to a new position. + + * xdisp.c (set_cursor_from_row): Set start and stop points + according to the row's direction when priming the loop that looks + for the glyph on which to display cursor. + (single_display_spec_intangible_p): Function deleted. + (display_prop_intangible_p): Reimplement to call + handle_display_spec instead of single_display_spec_intangible_p. + Accept 3 additional arguments needed by handle_display_spec. This + fixes incorrect cursor motion across display property with complex + values: lists, `(when COND...)' forms, etc. + (single_display_spec_string_p): Support property values that are + lists with the argument STRING its top-level element. + (display_prop_string_p): Fix the condition for processing a + property that is a list to be consistent with handle_display_spec. + (handle_display_spec): New function, refactored from the + last portion of handle_display_prop. + (compute_display_string_pos): Accept additional argument + FRAME_WINDOW_P. Call handle_display_spec to determine whether the + value of a `display' property is a "replacing spec". + (handle_single_display_spec): Accept 2 additional arguments BUFPOS + and FRAME_WINDOW_P. If IT is NULL, don't set up the iterator from + the display property, but just return a value indicating whether + the display property will replace the characters it covers. + (Fcurrent_bidi_paragraph_direction): Initialize the nchars and + frame_window_p members of struct bidi_it. + (compute_display_string_pos, compute_display_string_end): New + functions. + (push_it): Accept second argument POSITION, where pop_it should + jump to continue iteration. + (reseat_1): Initialize bidi_it.disp_pos. + + * keyboard.c (adjust_point_for_property): Adjust the call to + display_prop_intangible_p to its new signature. + + * dispextern.h (struct bidi_it): New member frame_window_p. + (bidi_init_it): Update prototypes. + (display_prop_intangible_p): Update prototype. + (compute_display_string_pos, compute_display_string_end): Declare + prototypes. + (struct bidi_it): New members nchars and disp_pos. ch_len is now + EMACS_INT. + 2011-06-02 Paul Eggert Malloc failure behavior now depends on size of allocation. === modified file 'src/bidi.c' --- src/bidi.c 2011-05-28 22:39:39 +0000 +++ src/bidi.c 2011-06-04 07:41:44 +0000 @@ -62,15 +62,8 @@ static Lisp_Object bidi_type_table, bidi_mirror_table; -/* FIXME: Remove these when bidi_explicit_dir_char uses a lookup table. */ #define LRM_CHAR 0x200E #define RLM_CHAR 0x200F -#define LRE_CHAR 0x202A -#define RLE_CHAR 0x202B -#define PDF_CHAR 0x202C -#define LRO_CHAR 0x202D -#define RLO_CHAR 0x202E - #define BIDI_EOB -1 /* Local data structures. (Look in dispextern.h for the rest.) */ @@ -258,7 +251,7 @@ int i; /* Copy everything except the level stack and beyond. */ - memcpy (to, from, ((size_t)&((struct bidi_it *)0)->level_stack[0])); + memcpy (to, from, offsetof (struct bidi_it, level_stack[0])); /* Copy the active part of the level stack. */ to->level_stack[0] = from->level_stack[0]; /* level zero is always in use */ @@ -319,10 +312,17 @@ if (bidi_cache_idx) { if (charpos < bidi_cache[bidi_cache_last_idx].charpos) - dir = -1; - else if (charpos > bidi_cache[bidi_cache_last_idx].charpos) - dir = 1; - if (dir) + { + dir = -1; + i_start = bidi_cache_last_idx - 1; + } + else if (charpos > (bidi_cache[bidi_cache_last_idx].charpos + + bidi_cache[bidi_cache_last_idx].nchars - 1)) + { + dir = 1; + i_start = bidi_cache_last_idx + 1; + } + else if (dir) i_start = bidi_cache_last_idx; else { @@ -334,14 +334,16 @@ { /* Linear search for now; FIXME! */ for (i = i_start; i >= 0; i--) - if (bidi_cache[i].charpos == charpos + if (bidi_cache[i].charpos <= charpos + && charpos < bidi_cache[i].charpos + bidi_cache[i].nchars && (level == -1 || bidi_cache[i].resolved_level <= level)) return i; } else { for (i = i_start; i < bidi_cache_idx; i++) - if (bidi_cache[i].charpos == charpos + if (bidi_cache[i].charpos <= charpos + && charpos < bidi_cache[i].charpos + bidi_cache[i].nchars && (level == -1 || bidi_cache[i].resolved_level <= level)) return i; } @@ -426,12 +428,15 @@ If we are outside the range of cached positions, the cache is useless and must be reset. */ if (idx > 0 && - (bidi_it->charpos > bidi_cache[idx - 1].charpos + 1 + (bidi_it->charpos > (bidi_cache[idx - 1].charpos + + bidi_cache[idx - 1].nchars) || bidi_it->charpos < bidi_cache[0].charpos)) { bidi_cache_reset (); idx = 0; } + if (bidi_it->nchars <= 0) + abort (); bidi_copy_it (&bidi_cache[idx], bidi_it); if (!resolved) bidi_cache[idx].resolved_level = -1; @@ -548,6 +553,7 @@ bidi_it->ignore_bn_limit = 0; /* meaning it's unknown */ } +/* Perform initializations for reordering a new line of bidi text. */ static void bidi_line_init (struct bidi_it *bidi_it) { @@ -565,6 +571,65 @@ bidi_cache_reset (); } +/* Fetch and return the character at BYTEPOS/CHARPOS. If that + character is covered by a display string, treat the entire run of + covered characters as a single character u+FFFC, and return their + combined length in CH_LEN and NCHARS. DISP_POS specifies the + character position of the next display string, or -1 if not yet + computed. When the next character is at or beyond that position, + the function updates DISP_POS with the position of the next display + string. */ +static inline int +bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos, + int frame_window_p, EMACS_INT *ch_len, EMACS_INT *nchars) +{ + int ch; + + /* FIXME: Support strings in addition to buffers. */ + /* If we got past the last known position of display string, compute + the position of the next one. That position could be at BYTEPOS. */ + if (charpos < ZV && charpos > *disp_pos) + *disp_pos = compute_display_string_pos (charpos, frame_window_p); + + /* Fetch the character at BYTEPOS. */ + if (bytepos >= ZV_BYTE) + { + ch = BIDI_EOB; + *ch_len = 1; + *nchars = 1; + *disp_pos = ZV; + } + else if (charpos >= *disp_pos) + { + EMACS_INT disp_end_pos; + + /* We don't expect to find ourselves in the middle of a display + property. Hopefully, it will never be needed. */ + if (charpos > *disp_pos) + abort (); + /* Return the Unicode Object Replacement Character to represent + the entire run of characters covered by the display + string. */ + ch = 0xFFFC; + disp_end_pos = compute_display_string_end (*disp_pos); + *nchars = disp_end_pos - *disp_pos; + *ch_len = CHAR_TO_BYTE (disp_end_pos) - bytepos; + } + else + { + ch = FETCH_MULTIBYTE_CHAR (bytepos); + *nchars = 1; + *ch_len = CHAR_BYTES (ch); + } + + /* If we just entered a run of characters covered by a display + string, compute the position of the next display string. */ + if (charpos + *nchars <= ZV && charpos + *nchars > *disp_pos) + *disp_pos = compute_display_string_pos (charpos + *nchars, frame_window_p); + + return ch; +} + /* Find the beginning of this paragraph by looking back in the buffer. Value is the byte position of the paragraph's beginning. */ static EMACS_INT @@ -576,6 +641,10 @@ while (pos_byte > BEGV_BYTE && fast_looking_at (re, pos, pos_byte, limit, limit_byte, Qnil) < 0) { + /* FIXME: What if the paragraph beginning is covered by a + display string? And what if a display string covering some + of the text over which we scan back includes + paragraph_start_re? */ pos = find_next_newline_no_quit (pos - 1, -1); pos_byte = CHAR_TO_BYTE (pos); } @@ -587,7 +656,7 @@ R2L, just use that. Otherwise, determine the paragraph direction from the first strong directional character of the paragraph. - NO_DEFAULT_P non-nil means don't default to L2R if the paragraph + NO_DEFAULT_P non-zero means don't default to L2R if the paragraph has no strong directional characters and both DIR and bidi_it->paragraph_dir are NEUTRAL_DIR. In that case, search back in the buffer until a paragraph is found with a strong character, @@ -622,8 +691,9 @@ } else if (dir == NEUTRAL_DIR) /* P2 */ { - int ch, ch_len; - EMACS_INT pos; + int ch; + EMACS_INT ch_len, nchars; + EMACS_INT pos, disp_pos = -1; bidi_type_t type; if (!bidi_initialized) @@ -658,12 +728,12 @@ is non-zero. */ do { bytepos = pstartbyte; - ch = FETCH_CHAR (bytepos); - ch_len = CHAR_BYTES (ch); pos = BYTE_TO_CHAR (bytepos); + ch = bidi_fetch_char (bytepos, pos, &disp_pos, bidi_it->frame_window_p, + &ch_len, &nchars); type = bidi_get_type (ch, NEUTRAL_DIR); - for (pos++, bytepos += ch_len; + for (pos += nchars, bytepos += ch_len; /* NOTE: UAX#9 says to search only for L, AL, or R types of characters, and ignore RLE, RLO, LRE, and LRO. However, I'm not sure it makes sense to omit those 4; @@ -683,7 +753,11 @@ type = NEUTRAL_B; break; } - FETCH_CHAR_ADVANCE (ch, pos, bytepos); + /* Fetch next character and advance to get past it. */ + ch = bidi_fetch_char (bytepos, pos, &disp_pos, + bidi_it->frame_window_p, &ch_len, &nchars); + pos += nchars; + bytepos += ch_len; } if (type == STRONG_R || type == STRONG_AL) /* P3 */ bidi_it->paragraph_dir = R2L; @@ -702,6 +776,9 @@ /* Find the beginning of the previous paragraph, if any. */ while (pbyte > BEGV_BYTE && prevpbyte >= pstartbyte) { + /* FXIME: What if p is covered by a display + string? See also a FIXME inside + bidi_find_paragraph_start. */ p--; pbyte = CHAR_TO_BYTE (p); prevpbyte = bidi_find_paragraph_start (p, pbyte); @@ -738,14 +815,17 @@ bidi_it->resolved_level = bidi_it->level_stack[0].level; } -/* Initialize the bidi iterator from buffer position CHARPOS. */ +/* Initialize the bidi iterator from buffer/string position CHARPOS. */ void -bidi_init_it (EMACS_INT charpos, EMACS_INT bytepos, struct bidi_it *bidi_it) +bidi_init_it (EMACS_INT charpos, EMACS_INT bytepos, int frame_window_p, + struct bidi_it *bidi_it) { if (! bidi_initialized) bidi_initialize (); bidi_it->charpos = charpos; bidi_it->bytepos = bytepos; + bidi_it->frame_window_p = frame_window_p; + bidi_it->nchars = -1; /* to be computed in bidi_resolve_explicit_1 */ bidi_it->first_elt = 1; bidi_set_paragraph_end (bidi_it); bidi_it->new_paragraph = 1; @@ -767,6 +847,7 @@ bidi_it->prev_for_neutral.type_after_w1 = bidi_it->prev_for_neutral.orig_type = UNKNOWN_BT; bidi_it->sor = L2R; /* FIXME: should it be user-selectable? */ + bidi_it->disp_pos = -1; /* invalid/unknown */ bidi_cache_shrink (); } @@ -829,12 +910,16 @@ } static inline int -bidi_explicit_dir_char (int c) +bidi_explicit_dir_char (int ch) { - /* FIXME: this should be replaced with a lookup table with suitable - bits set, like standard C ctype macros do. */ - return (c == LRE_CHAR || c == LRO_CHAR - || c == RLE_CHAR || c == RLO_CHAR || c == PDF_CHAR); + bidi_type_t ch_type; + + if (!bidi_initialized) + abort (); + ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch)); + return (ch_type == LRE || ch_type == LRO + || ch_type == RLE || ch_type == RLO + || ch_type == PDF); } /* A helper function for bidi_resolve_explicit. It advances to the @@ -850,7 +935,10 @@ int new_level; bidi_dir_t override; - if (bidi_it->bytepos < BEGV_BYTE /* after reseat to BEGV? */ + /* If reseat()'ed, don't advance, so as to start iteration from the + position where we were reseated. bidi_it->bytepos can be less + than BEGV_BYTE after reseat to BEGV. */ + if (bidi_it->bytepos < BEGV_BYTE || bidi_it->first_elt) { bidi_it->first_elt = 0; @@ -860,7 +948,11 @@ } else if (bidi_it->bytepos < ZV_BYTE) /* don't move at ZV */ { - bidi_it->charpos++; + /* Advance to the next character, skipping characters covered by + display strings (nchars > 1). */ + if (bidi_it->nchars <= 0) + abort (); + bidi_it->charpos += bidi_it->nchars; if (bidi_it->ch_len == 0) abort (); bidi_it->bytepos += bidi_it->ch_len; @@ -870,17 +962,21 @@ override = bidi_it->level_stack[bidi_it->stack_idx].override; new_level = current_level; - /* in case it is a unibyte character (not yet implemented) */ - /* _fetch_multibyte_char_len = 1; */ if (bidi_it->bytepos >= ZV_BYTE) { curchar = BIDI_EOB; bidi_it->ch_len = 1; + bidi_it->nchars = 1; + bidi_it->disp_pos = ZV; } else { - curchar = FETCH_CHAR (bidi_it->bytepos); - bidi_it->ch_len = CHAR_BYTES (curchar); + /* Fetch the character at BYTEPOS. If it is covered by a + display string, treat the entire run of covered characters as + a single character u+FFFC. */ + curchar = bidi_fetch_char (bidi_it->bytepos, bidi_it->charpos, + &bidi_it->disp_pos, bidi_it->frame_window_p, + &bidi_it->ch_len, &bidi_it->nchars); } bidi_it->ch = curchar; @@ -1006,10 +1102,10 @@ } /* Given an iterator state in BIDI_IT, advance one character position - in the buffer to the next character (in the logical order), resolve - any explicit embeddings and directional overrides, and return the - embedding level of the character after resolving explicit - directives and ignoring empty embeddings. */ + in the buffer/string to the next character (in the logical order), + resolve any explicit embeddings and directional overrides, and + return the embedding level of the character after resolving + explicit directives and ignoring empty embeddings. */ static int bidi_resolve_explicit (struct bidi_it *bidi_it) { @@ -1020,8 +1116,8 @@ && bidi_it->type == WEAK_BN && bidi_it->ignore_bn_limit == 0 /* only if not already known */ && bidi_it->bytepos < ZV_BYTE /* not already at EOB */ - && bidi_explicit_dir_char (FETCH_CHAR (bidi_it->bytepos - + bidi_it->ch_len))) + && bidi_explicit_dir_char (FETCH_MULTIBYTE_CHAR (bidi_it->bytepos + + bidi_it->ch_len))) { /* Avoid pushing and popping embedding levels if the level run is empty, as this breaks level runs where it shouldn't. @@ -1033,14 +1129,18 @@ bidi_copy_it (&saved_it, bidi_it); - while (bidi_explicit_dir_char (FETCH_CHAR (bidi_it->bytepos - + bidi_it->ch_len))) + while (bidi_explicit_dir_char (FETCH_MULTIBYTE_CHAR (bidi_it->bytepos + + bidi_it->ch_len))) { + /* This advances to the next character, skipping any + characters covered by display strings. */ level = bidi_resolve_explicit_1 (bidi_it); } + if (bidi_it->nchars <= 0) + abort (); if (level == prev_level) /* empty embedding */ - saved_it.ignore_bn_limit = bidi_it->charpos + 1; + saved_it.ignore_bn_limit = bidi_it->charpos + bidi_it->nchars; else /* this embedding is non-empty */ saved_it.ignore_bn_limit = -1; @@ -1076,8 +1176,8 @@ return new_level; } -/* Advance in the buffer, resolve weak types and return the type of - the next character after weak type resolution. */ +/* Advance in the buffer/string, resolve weak types and return the + type of the next character after weak type resolution. */ static bidi_type_t bidi_resolve_weak (struct bidi_it *bidi_it) { @@ -1156,7 +1256,8 @@ { next_char = bidi_it->bytepos + bidi_it->ch_len >= ZV_BYTE - ? BIDI_EOB : FETCH_CHAR (bidi_it->bytepos + bidi_it->ch_len); + ? BIDI_EOB : FETCH_MULTIBYTE_CHAR (bidi_it->bytepos + + bidi_it->ch_len); type_of_next = bidi_get_type (next_char, override); if (type_of_next == WEAK_BN @@ -1204,11 +1305,14 @@ type = WEAK_EN; else /* W5: ET/BN with EN after it. */ { - EMACS_INT en_pos = bidi_it->charpos + 1; + EMACS_INT en_pos = bidi_it->charpos + bidi_it->nchars; + if (bidi_it->nchars <= 0) + abort (); next_char = bidi_it->bytepos + bidi_it->ch_len >= ZV_BYTE - ? BIDI_EOB : FETCH_CHAR (bidi_it->bytepos + bidi_it->ch_len); + ? BIDI_EOB : FETCH_MULTIBYTE_CHAR (bidi_it->bytepos + + bidi_it->ch_len); type_of_next = bidi_get_type (next_char, override); if (type_of_next == WEAK_ET @@ -1299,8 +1403,8 @@ /* Arrrgh!! The UAX#9 algorithm is too deeply entrenched in the assumption of batch-style processing; see clauses W4, W5, and especially N1, which require to look far forward - (as well as back) in the buffer. May the fleas of a - thousand camels infest the armpits of those who design + (as well as back) in the buffer/string. May the fleas of + a thousand camels infest the armpits of those who design supposedly general-purpose algorithms by looking at their own implementations, and fail to consider other possible implementations! */ @@ -1391,8 +1495,9 @@ } /* Given an iterator state in BIDI_IT, advance one character position - in the buffer to the next character (in the logical order), resolve - the bidi type of that next character, and return that type. */ + in the buffer/string to the next character (in the logical order), + resolve the bidi type of that next character, and return that + type. */ static bidi_type_t bidi_type_of_next_char (struct bidi_it *bidi_it) { @@ -1416,15 +1521,16 @@ } /* Given an iterator state BIDI_IT, advance one character position in - the buffer to the next character (in the logical order), resolve - the embedding and implicit levels of that next character, and - return the resulting level. */ + the buffer/string to the next character (in the current scan + direction), resolve the embedding and implicit levels of that next + character, and return the resulting level. */ static int bidi_level_of_next_char (struct bidi_it *bidi_it) { bidi_type_t type; int level, prev_level = -1; struct bidi_saved_info next_for_neutral; + EMACS_INT next_char_pos; if (bidi_it->scan_dir == 1) { @@ -1466,8 +1572,23 @@ } next_for_neutral = bidi_it->next_for_neutral; - /* Perhaps it is already cached. */ - type = bidi_cache_find (bidi_it->charpos + bidi_it->scan_dir, -1, bidi_it); + /* Perhaps the character we want is already cached. If it is, the + call to bidi_cache_find below will return a type other than + UNKNOWN_BT. */ + if (bidi_cache_idx && !bidi_it->first_elt) + { + if (bidi_it->scan_dir > 0) + { + if (bidi_it->nchars <= 0) + abort (); + next_char_pos = bidi_it->charpos + bidi_it->nchars; + } + else + next_char_pos = bidi_it->charpos - 1; + type = bidi_cache_find (next_char_pos, -1, bidi_it); + } + else + type = UNKNOWN_BT; if (type != UNKNOWN_BT) { /* Don't lose the information for resolving neutrals! The @@ -1529,14 +1650,16 @@ int clen = bidi_it->ch_len; EMACS_INT bpos = bidi_it->bytepos; EMACS_INT cpos = bidi_it->charpos; + EMACS_INT disp_pos = bidi_it->disp_pos; + EMACS_INT nc = bidi_it->nchars; bidi_type_t chtype; + int fwp = bidi_it->frame_window_p; + if (bidi_it->nchars <= 0) + abort (); do { - /*_fetch_multibyte_char_len = 1;*/ - ch = bpos + clen >= ZV_BYTE ? BIDI_EOB : FETCH_CHAR (bpos + clen); - bpos += clen; - cpos++; - clen = (ch == BIDI_EOB ? 1 : CHAR_BYTES (ch)); + ch = bidi_fetch_char (bpos += clen, cpos += nc, &disp_pos, fwp, + &clen, &nc); if (ch == '\n' || ch == BIDI_EOB /* || ch == LINESEP_CHAR */) chtype = NEUTRAL_B; else @@ -1615,8 +1738,8 @@ If this level's other edge is cached, we simply jump to it, filling the iterator structure with the iterator state on the other edge. - Otherwise, we walk the buffer until we come back to the same level - as LEVEL. + Otherwise, we walk the buffer or string until we come back to the + same level as LEVEL. Note: we are not talking here about a ``level run'' in the UAX#9 sense of the term, but rather about a ``level'' which includes @@ -1680,6 +1803,7 @@ sentinel.bytepos--; sentinel.ch = '\n'; /* doesn't matter, but why not? */ sentinel.ch_len = 1; + sentinel.nchars = 1; } bidi_cache_iterator_state (&sentinel, 1); } @@ -1750,14 +1874,17 @@ && bidi_it->bytepos < ZV_BYTE) { EMACS_INT sep_len = - bidi_at_paragraph_end (bidi_it->charpos + 1, + bidi_at_paragraph_end (bidi_it->charpos + bidi_it->nchars, bidi_it->bytepos + bidi_it->ch_len); + if (bidi_it->nchars <= 0) + abort (); if (sep_len >= 0) { bidi_it->new_paragraph = 1; /* Record the buffer position of the last character of the paragraph separator. */ - bidi_it->separator_limit = bidi_it->charpos + 1 + sep_len; + bidi_it->separator_limit = + bidi_it->charpos + bidi_it->nchars + sep_len; } } @@ -1767,7 +1894,8 @@ last cached position, the cache's job is done and we can discard it. */ if (bidi_it->resolved_level == bidi_it->level_stack[0].level - && bidi_it->charpos > bidi_cache[bidi_cache_idx - 1].charpos) + && bidi_it->charpos > (bidi_cache[bidi_cache_idx - 1].charpos + + bidi_cache[bidi_cache_idx - 1].nchars - 1)) bidi_cache_reset (); /* But as long as we are caching during forward scan, we must cache each state, or else the cache integrity will be === modified file 'src/dispextern.h' --- src/dispextern.h 2011-05-31 06:05:00 +0000 +++ src/dispextern.h 2011-06-04 07:41:44 +0000 @@ -1816,12 +1816,16 @@ bidi_dir_t override; }; -/* Data type for iterating over bidi text. */ +/* Data type for reordering bidirectional text. */ struct bidi_it { EMACS_INT bytepos; /* iterator's position in buffer */ EMACS_INT charpos; - int ch; /* character itself */ - int ch_len; /* length of its multibyte sequence */ + int ch; /* character at that position, or u+FFFC + ("object replacement character") for a run + of characters covered by a display string */ + EMACS_INT nchars; /* its "length", usually 1; it's > 1 for a run + of characters covered by a display string */ + EMACS_INT ch_len; /* its length in bytes */ bidi_type_t type; /* bidi type of this character, after resolving weak and neutral types */ bidi_type_t type_after_w1; /* original type, after overrides and W1 */ @@ -1847,7 +1851,9 @@ int first_elt; /* if non-zero, examine current char first */ bidi_dir_t paragraph_dir; /* current paragraph direction */ int new_paragraph; /* if non-zero, we expect a new paragraph */ + int frame_window_p; /* non-zero if displaying on a GUI frame */ EMACS_INT separator_limit; /* where paragraph separator should end */ + EMACS_INT disp_pos; /* position of display string after ch */ }; /* Value is non-zero when the bidi iterator is at base paragraph @@ -2944,7 +2950,7 @@ /* Defined in bidi.c */ -extern void bidi_init_it (EMACS_INT, EMACS_INT, struct bidi_it *); +extern void bidi_init_it (EMACS_INT, EMACS_INT, int, struct bidi_it *); extern void bidi_move_to_visually_next (struct bidi_it *); extern void bidi_paragraph_init (bidi_dir_t, struct bidi_it *, int); extern int bidi_mirror_char (int); @@ -2955,7 +2961,7 @@ struct glyph_row *, struct glyph_row *, int); int line_bottom_y (struct it *); -int display_prop_intangible_p (Lisp_Object); +int display_prop_intangible_p (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT); void resize_echo_area_exactly (void); int resize_mini_window (struct window *, int); #if defined USE_TOOLKIT_SCROLL_BARS && !defined USE_GTK @@ -3005,6 +3011,8 @@ extern Lisp_Object lookup_glyphless_char_display (int, struct it *); extern int calc_pixel_width_or_height (double *, struct it *, Lisp_Object, struct font *, int, int *); +extern EMACS_INT compute_display_string_pos (EMACS_INT, int); +extern EMACS_INT compute_display_string_end (EMACS_INT); #ifdef HAVE_WINDOW_SYSTEM === modified file 'src/keyboard.c' --- src/keyboard.c 2011-05-28 22:39:39 +0000 +++ src/keyboard.c 2011-06-04 07:41:44 +0000 @@ -1729,7 +1729,7 @@ && PT > BEGV && PT < ZV && !NILP (val = get_char_property_and_overlay (make_number (PT), Qdisplay, Qnil, &overlay)) - && display_prop_intangible_p (val) + && display_prop_intangible_p (val, overlay, PT, PT_BYTE) && (!OVERLAYP (overlay) ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil) : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)), === modified file 'src/xdisp.c' --- src/xdisp.c 2011-05-28 22:39:39 +0000 +++ src/xdisp.c 2011-06-04 07:41:44 +0000 @@ -812,7 +812,7 @@ static int try_cursor_movement (Lisp_Object, struct text_pos, int *); static int trailing_whitespace_p (EMACS_INT); static unsigned long int message_log_check_duplicate (EMACS_INT, EMACS_INT); -static void push_it (struct it *); +static void push_it (struct it *, struct text_pos *); static void pop_it (struct it *); static void sync_frame_with_window_matrix_rows (struct window *); static void select_frame_for_redisplay (Lisp_Object); @@ -884,9 +884,11 @@ Lisp_Object); static int face_before_or_after_it_pos (struct it *, int); static EMACS_INT next_overlay_change (EMACS_INT); +static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object, + Lisp_Object, struct text_pos *, EMACS_INT, int); static int handle_single_display_spec (struct it *, Lisp_Object, Lisp_Object, Lisp_Object, - struct text_pos *, int); + struct text_pos *, EMACS_INT, int, int); static int underlying_face_id (struct it *); static int in_ellipses_for_invisible_text_p (struct display_pos *, struct window *); @@ -2564,7 +2566,7 @@ it->paragraph_embedding = R2L; else it->paragraph_embedding = NEUTRAL_DIR; - bidi_init_it (charpos, bytepos, &it->bidi_it); + bidi_init_it (charpos, bytepos, FRAME_WINDOW_P (it->f), &it->bidi_it); } /* If a buffer position was specified, set the iterator there, @@ -3085,6 +3087,82 @@ return endpos; } +/* Return the character position of a display string at or after CHARPOS. + If no display string exists at or after CHARPOS, return ZV. A + display string is either an overlay with `display' property whose + value is a string, or a `display' text property whose value is a + string. FRAME_WINDOW_P is non-zero when we are displaying a window + on a GUI frame. */ +EMACS_INT +compute_display_string_pos (EMACS_INT charpos, int frame_window_p) +{ + /* FIXME: Support display properties on strings (object = Qnil means + current buffer). */ + Lisp_Object object = Qnil; + Lisp_Object pos, spec; + struct text_pos position; + EMACS_INT bufpos; + + if (charpos >= ZV) + return ZV; + + /* If the character at CHARPOS is where the display string begins, + return CHARPOS. */ + pos = make_number (charpos); + CHARPOS (position) = charpos; + BYTEPOS (position) = CHAR_TO_BYTE (charpos); + bufpos = charpos; /* FIXME! support strings as well */ + if (!NILP (spec = Fget_char_property (pos, Qdisplay, object)) + && (charpos <= BEGV + || !EQ (Fget_char_property (make_number (charpos - 1), Qdisplay, + object), + spec)) + && handle_display_spec (NULL, spec, object, Qnil, &position, bufpos, + frame_window_p)) + return charpos; + + /* Look forward for the first character with a `display' property + that will replace the underlying text when displayed. */ + do { + pos = Fnext_single_char_property_change (pos, Qdisplay, object, Qnil); + CHARPOS (position) = XFASTINT (pos); + BYTEPOS (position) = CHAR_TO_BYTE (CHARPOS (position)); + if (CHARPOS (position) >= ZV) + break; + spec = Fget_char_property (pos, Qdisplay, object); + bufpos = CHARPOS (position); /* FIXME! support strings as well */ + } while (NILP (spec) + || !handle_display_spec (NULL, spec, object, Qnil, &position, bufpos, + frame_window_p)); + + return CHARPOS (position); +} + +/* Return the character position of the end of the display string that + started at CHARPOS. A display string is either an overlay with + `display' property whose value is a string or a `display' text + property whose value is a string. */ +EMACS_INT +compute_display_string_end (EMACS_INT charpos) +{ + /* FIXME: Support display properties on strings (object = Qnil means + current buffer). */ + Lisp_Object object = Qnil; + Lisp_Object pos = make_number (charpos); + + if (charpos >= ZV) + return ZV; + + if (NILP (Fget_char_property (pos, Qdisplay, object))) + abort (); + + /* Look forward for the first character where the `display' property + changes. */ + pos = Fnext_single_char_property_change (pos, Qdisplay, object, Qnil); + + return XFASTINT (pos); +} + /*********************************************************************** @@ -3743,8 +3821,9 @@ static enum prop_handled handle_display_prop (struct it *it) { - Lisp_Object prop, object, overlay; + Lisp_Object propval, object, overlay; struct text_pos *position; + EMACS_INT bufpos; /* Nonzero if some property replaces the display of the text itself. */ int display_replaced_p = 0; @@ -3752,11 +3831,13 @@ { object = it->string; position = &it->current.string_pos; + bufpos = CHARPOS (it->current.pos); } else { XSETWINDOW (object, it->w); position = &it->current.pos; + bufpos = CHARPOS (*position); } /* Reset those iterator values set from display property values. */ @@ -3771,9 +3852,9 @@ if (!it->string_from_display_prop_p) it->area = TEXT_AREA; - prop = get_char_property_and_overlay (make_number (position->charpos), - Qdisplay, object, &overlay); - if (NILP (prop)) + propval = get_char_property_and_overlay (make_number (position->charpos), + Qdisplay, object, &overlay); + if (NILP (propval)) return HANDLED_NORMALLY; /* Now OVERLAY is the overlay that gave us this property, or nil if it was a text property. */ @@ -3781,59 +3862,88 @@ if (!STRINGP (it->string)) object = it->w->buffer; - if (CONSP (prop) - /* Simple properties. */ - && !EQ (XCAR (prop), Qimage) - && !EQ (XCAR (prop), Qspace) - && !EQ (XCAR (prop), Qwhen) - && !EQ (XCAR (prop), Qslice) - && !EQ (XCAR (prop), Qspace_width) - && !EQ (XCAR (prop), Qheight) - && !EQ (XCAR (prop), Qraise) + display_replaced_p = handle_display_spec (it, propval, object, overlay, + position, bufpos, + FRAME_WINDOW_P (it->f)); + + return display_replaced_p ? HANDLED_RETURN : HANDLED_NORMALLY; +} + +/* Subroutine of handle_display_prop. Returns non-zero if the display + specification in SPEC is a replacing specification, i.e. it would + replace the text covered by `display' property with something else, + such as an image or a display string. + + See handle_single_display_spec for documentation of arguments. + frame_window_p is non-zero if the window being redisplayed is on a + GUI frame; this argument is used only if IT is NULL, see below. + + IT can be NULL, if this is called by the bidi reordering code + through compute_display_string_pos, which see. In that case, this + function only examines SPEC, but does not otherwise "handle" it, in + the sense that it doesn't set up members of IT from the display + spec. */ +static int +handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, + Lisp_Object overlay, struct text_pos *position, + EMACS_INT bufpos, int frame_window_p) +{ + int replacing_p = 0; + + if (CONSP (spec) + /* Simple specerties. */ + && !EQ (XCAR (spec), Qimage) + && !EQ (XCAR (spec), Qspace) + && !EQ (XCAR (spec), Qwhen) + && !EQ (XCAR (spec), Qslice) + && !EQ (XCAR (spec), Qspace_width) + && !EQ (XCAR (spec), Qheight) + && !EQ (XCAR (spec), Qraise) /* Marginal area specifications. */ - && !(CONSP (XCAR (prop)) && EQ (XCAR (XCAR (prop)), Qmargin)) - && !EQ (XCAR (prop), Qleft_fringe) - && !EQ (XCAR (prop), Qright_fringe) - && !NILP (XCAR (prop))) + && !(CONSP (XCAR (spec)) && EQ (XCAR (XCAR (spec)), Qmargin)) + && !EQ (XCAR (spec), Qleft_fringe) + && !EQ (XCAR (spec), Qright_fringe) + && !NILP (XCAR (spec))) { - for (; CONSP (prop); prop = XCDR (prop)) + for (; CONSP (spec); spec = XCDR (spec)) { - if (handle_single_display_spec (it, XCAR (prop), object, overlay, - position, display_replaced_p)) + if (handle_single_display_spec (it, XCAR (spec), object, overlay, + position, bufpos, replacing_p, + frame_window_p)) { - display_replaced_p = 1; + replacing_p = 1; /* If some text in a string is replaced, `position' no longer points to the position of `object'. */ - if (STRINGP (object)) + if (!it || STRINGP (object)) break; } } } - else if (VECTORP (prop)) + else if (VECTORP (spec)) { int i; - for (i = 0; i < ASIZE (prop); ++i) - if (handle_single_display_spec (it, AREF (prop, i), object, overlay, - position, display_replaced_p)) + for (i = 0; i < ASIZE (spec); ++i) + if (handle_single_display_spec (it, AREF (spec, i), object, overlay, + position, bufpos, replacing_p, + frame_window_p)) { - display_replaced_p = 1; + replacing_p = 1; /* If some text in a string is replaced, `position' no longer points to the position of `object'. */ - if (STRINGP (object)) + if (!it || STRINGP (object)) break; } } else { - if (handle_single_display_spec (it, prop, object, overlay, - position, 0)) - display_replaced_p = 1; + if (handle_single_display_spec (it, spec, object, overlay, + position, bufpos, 0, frame_window_p)) + replacing_p = 1; } - return display_replaced_p ? HANDLED_RETURN : HANDLED_NORMALLY; + return replacing_p; } - /* Value is the position of the end of the `display' property starting at START_POS in OBJECT. */ @@ -3857,10 +3967,12 @@ /* Set up IT from a single `display' property specification SPEC. OBJECT is the object in which the `display' property was found. *POSITION - is the position at which it was found. DISPLAY_REPLACED_P non-zero - means that we previously saw a display specification which already - replaced text display with something else, for example an image; - we ignore such properties after the first one has been processed. + is the position in OBJECT at which the `display' property was found. + BUFPOS is the buffer position of OBJECT (different from POSITION if + OBJECT is not a buffer). DISPLAY_REPLACED_P non-zero means that we + previously saw a display specification which already replaced text + display with something else, for example an image; we ignore such + properties after the first one has been processed. OVERLAY is the overlay this `display' property came from, or nil if it was a text property. @@ -3869,17 +3981,22 @@ cases too, set *POSITION to the position where the `display' property ends. + If IT is NULL, only examine the property specification in SPEC, but + don't set up IT. In that case, FRAME_WINDOW_P non-zero means SPEC + is intended to be displayed in a window on a GUI frame. + Value is non-zero if something was found which replaces the display of buffer or string text. */ static int handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object overlay, struct text_pos *position, - int display_replaced_p) + EMACS_INT bufpos, int display_replaced_p, + int frame_window_p) { Lisp_Object form; Lisp_Object location, value; - struct text_pos start_pos, save_pos; + struct text_pos start_pos = *position; int valid_p; /* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM. @@ -3903,11 +4020,12 @@ buffer or string. Bind `position' to the position in the object where the property was found, and `buffer-position' to the current position in the buffer. */ + + if (NILP (object)) + XSETBUFFER (object, current_buffer); specbind (Qobject, object); specbind (Qposition, make_number (CHARPOS (*position))); - specbind (Qbuffer_position, - make_number (STRINGP (object) - ? IT_CHARPOS (*it) : CHARPOS (*position))); + specbind (Qbuffer_position, make_number (bufpos)); GCPRO1 (form); form = safe_eval (form); UNGCPRO; @@ -3922,63 +4040,66 @@ && EQ (XCAR (spec), Qheight) && CONSP (XCDR (spec))) { - if (!FRAME_WINDOW_P (it->f)) - return 0; - - it->font_height = XCAR (XCDR (spec)); - if (!NILP (it->font_height)) + if (it) { - struct face *face = FACE_FROM_ID (it->f, it->face_id); - int new_height = -1; - - if (CONSP (it->font_height) - && (EQ (XCAR (it->font_height), Qplus) - || EQ (XCAR (it->font_height), Qminus)) - && CONSP (XCDR (it->font_height)) - && INTEGERP (XCAR (XCDR (it->font_height)))) - { - /* `(+ N)' or `(- N)' where N is an integer. */ - int steps = XINT (XCAR (XCDR (it->font_height))); - if (EQ (XCAR (it->font_height), Qplus)) - steps = - steps; - it->face_id = smaller_face (it->f, it->face_id, steps); - } - else if (FUNCTIONP (it->font_height)) - { - /* Call function with current height as argument. - Value is the new height. */ - Lisp_Object height; - height = safe_call1 (it->font_height, - face->lface[LFACE_HEIGHT_INDEX]); - if (NUMBERP (height)) - new_height = XFLOATINT (height); - } - else if (NUMBERP (it->font_height)) - { - /* Value is a multiple of the canonical char height. */ - struct face *f; - - f = FACE_FROM_ID (it->f, - lookup_basic_face (it->f, DEFAULT_FACE_ID)); - new_height = (XFLOATINT (it->font_height) - * XINT (f->lface[LFACE_HEIGHT_INDEX])); - } - else - { - /* Evaluate IT->font_height with `height' bound to the - current specified height to get the new height. */ - int count = SPECPDL_INDEX (); - - specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); - value = safe_eval (it->font_height); - unbind_to (count, Qnil); - - if (NUMBERP (value)) - new_height = XFLOATINT (value); - } - - if (new_height > 0) - it->face_id = face_with_height (it->f, it->face_id, new_height); + if (!FRAME_WINDOW_P (it->f)) + return 0; + + it->font_height = XCAR (XCDR (spec)); + if (!NILP (it->font_height)) + { + struct face *face = FACE_FROM_ID (it->f, it->face_id); + int new_height = -1; + + if (CONSP (it->font_height) + && (EQ (XCAR (it->font_height), Qplus) + || EQ (XCAR (it->font_height), Qminus)) + && CONSP (XCDR (it->font_height)) + && INTEGERP (XCAR (XCDR (it->font_height)))) + { + /* `(+ N)' or `(- N)' where N is an integer. */ + int steps = XINT (XCAR (XCDR (it->font_height))); + if (EQ (XCAR (it->font_height), Qplus)) + steps = - steps; + it->face_id = smaller_face (it->f, it->face_id, steps); + } + else if (FUNCTIONP (it->font_height)) + { + /* Call function with current height as argument. + Value is the new height. */ + Lisp_Object height; + height = safe_call1 (it->font_height, + face->lface[LFACE_HEIGHT_INDEX]); + if (NUMBERP (height)) + new_height = XFLOATINT (height); + } + else if (NUMBERP (it->font_height)) + { + /* Value is a multiple of the canonical char height. */ + struct face *f; + + f = FACE_FROM_ID (it->f, + lookup_basic_face (it->f, DEFAULT_FACE_ID)); + new_height = (XFLOATINT (it->font_height) + * XINT (f->lface[LFACE_HEIGHT_INDEX])); + } + else + { + /* Evaluate IT->font_height with `height' bound to the + current specified height to get the new height. */ + int count = SPECPDL_INDEX (); + + specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); + value = safe_eval (it->font_height); + unbind_to (count, Qnil); + + if (NUMBERP (value)) + new_height = XFLOATINT (value); + } + + if (new_height > 0) + it->face_id = face_with_height (it->f, it->face_id, new_height); + } } return 0; @@ -3989,12 +4110,15 @@ && EQ (XCAR (spec), Qspace_width) && CONSP (XCDR (spec))) { - if (!FRAME_WINDOW_P (it->f)) - return 0; + if (it) + { + if (!FRAME_WINDOW_P (it->f)) + return 0; - value = XCAR (XCDR (spec)); - if (NUMBERP (value) && XFLOATINT (value) > 0) - it->space_width = value; + value = XCAR (XCDR (spec)); + if (NUMBERP (value) && XFLOATINT (value) > 0) + it->space_width = value; + } return 0; } @@ -4005,20 +4129,23 @@ { Lisp_Object tem; - if (!FRAME_WINDOW_P (it->f)) - return 0; - - if (tem = XCDR (spec), CONSP (tem)) + if (it) { - it->slice.x = XCAR (tem); - if (tem = XCDR (tem), CONSP (tem)) + if (!FRAME_WINDOW_P (it->f)) + return 0; + + if (tem = XCDR (spec), CONSP (tem)) { - it->slice.y = XCAR (tem); + it->slice.x = XCAR (tem); if (tem = XCDR (tem), CONSP (tem)) { - it->slice.width = XCAR (tem); + it->slice.y = XCAR (tem); if (tem = XCDR (tem), CONSP (tem)) - it->slice.height = XCAR (tem); + { + it->slice.width = XCAR (tem); + if (tem = XCDR (tem), CONSP (tem)) + it->slice.height = XCAR (tem); + } } } } @@ -4031,36 +4158,43 @@ && EQ (XCAR (spec), Qraise) && CONSP (XCDR (spec))) { - if (!FRAME_WINDOW_P (it->f)) - return 0; + if (it) + { + if (!FRAME_WINDOW_P (it->f)) + return 0; #ifdef HAVE_WINDOW_SYSTEM - value = XCAR (XCDR (spec)); - if (NUMBERP (value)) - { - struct face *face = FACE_FROM_ID (it->f, it->face_id); - it->voffset = - (XFLOATINT (value) - * (FONT_HEIGHT (face->font))); + value = XCAR (XCDR (spec)); + if (NUMBERP (value)) + { + struct face *face = FACE_FROM_ID (it->f, it->face_id); + it->voffset = - (XFLOATINT (value) + * (FONT_HEIGHT (face->font))); + } +#endif /* HAVE_WINDOW_SYSTEM */ } -#endif /* HAVE_WINDOW_SYSTEM */ return 0; } /* Don't handle the other kinds of display specifications inside a string that we got from a `display' property. */ - if (it->string_from_display_prop_p) + if (it && it->string_from_display_prop_p) return 0; /* Characters having this form of property are not displayed, so we have to find the end of the property. */ - start_pos = *position; - *position = display_prop_end (it, object, start_pos); + if (it) + { + start_pos = *position; + *position = display_prop_end (it, object, start_pos); + } value = Qnil; /* Stop the scan at that end position--we assume that all text properties change there. */ - it->stop_charpos = position->charpos; + if (it) + it->stop_charpos = position->charpos; /* Handle `(left-fringe BITMAP [FACE])' and `(right-fringe BITMAP [FACE])'. */ @@ -4069,12 +4203,16 @@ || EQ (XCAR (spec), Qright_fringe)) && CONSP (XCDR (spec))) { - int face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID); int fringe_bitmap; - if (!FRAME_WINDOW_P (it->f)) - /* If we return here, POSITION has been advanced - across the text with this property. */ + if (it) + { + if (!FRAME_WINDOW_P (it->f)) + /* If we return here, POSITION has been advanced + across the text with this property. */ + return 0; + } + else if (!frame_window_p) return 0; #ifdef HAVE_WINDOW_SYSTEM @@ -4085,46 +4223,47 @@ across the text with this property. */ return 0; - if (CONSP (XCDR (XCDR (spec)))) - { - Lisp_Object face_name = XCAR (XCDR (XCDR (spec))); - int face_id2 = lookup_derived_face (it->f, face_name, - FRINGE_FACE_ID, 0); - if (face_id2 >= 0) - face_id = face_id2; - } - - /* Save current settings of IT so that we can restore them - when we are finished with the glyph property value. */ - - save_pos = it->position; - it->position = *position; - push_it (it); - it->position = save_pos; - - it->area = TEXT_AREA; - it->what = IT_IMAGE; - it->image_id = -1; /* no image */ - it->position = start_pos; - it->object = NILP (object) ? it->w->buffer : object; - it->method = GET_FROM_IMAGE; - it->from_overlay = Qnil; - it->face_id = face_id; - - /* Say that we haven't consumed the characters with - `display' property yet. The call to pop_it in - set_iterator_to_next will clean this up. */ - *position = start_pos; - - if (EQ (XCAR (spec), Qleft_fringe)) - { - it->left_user_fringe_bitmap = fringe_bitmap; - it->left_user_fringe_face_id = face_id; - } - else - { - it->right_user_fringe_bitmap = fringe_bitmap; - it->right_user_fringe_face_id = face_id; + if (it) + { + int face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID);; + + if (CONSP (XCDR (XCDR (spec)))) + { + Lisp_Object face_name = XCAR (XCDR (XCDR (spec))); + int face_id2 = lookup_derived_face (it->f, face_name, + FRINGE_FACE_ID, 0); + if (face_id2 >= 0) + face_id = face_id2; + } + + /* Save current settings of IT so that we can restore them + when we are finished with the glyph property value. */ + push_it (it, position); + + it->area = TEXT_AREA; + it->what = IT_IMAGE; + it->image_id = -1; /* no image */ + it->position = start_pos; + it->object = NILP (object) ? it->w->buffer : object; + it->method = GET_FROM_IMAGE; + it->from_overlay = Qnil; + it->face_id = face_id; + + /* Say that we haven't consumed the characters with + `display' property yet. The call to pop_it in + set_iterator_to_next will clean this up. */ + *position = start_pos; + + if (EQ (XCAR (spec), Qleft_fringe)) + { + it->left_user_fringe_bitmap = fringe_bitmap; + it->left_user_fringe_face_id = face_id; + } + else + { + it->right_user_fringe_bitmap = fringe_bitmap; + it->right_user_fringe_face_id = face_id; + } } #endif /* HAVE_WINDOW_SYSTEM */ return 1; @@ -4167,18 +4306,19 @@ valid_p = (STRINGP (value) #ifdef HAVE_WINDOW_SYSTEM - || (FRAME_WINDOW_P (it->f) && valid_image_p (value)) + || ((it ? FRAME_WINDOW_P (it->f) : frame_window_p) + && valid_image_p (value)) #endif /* not HAVE_WINDOW_SYSTEM */ || (CONSP (value) && EQ (XCAR (value), Qspace))); if (valid_p && !display_replaced_p) { + if (!it) + return 1; + /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ - save_pos = it->position; - it->position = *position; - push_it (it); - it->position = save_pos; + push_it (it, position); it->from_overlay = overlay; if (NILP (location)) @@ -4235,83 +4375,31 @@ return 0; } - -/* Check if SPEC is a display sub-property value whose text should be - treated as intangible. */ - -static int -single_display_spec_intangible_p (Lisp_Object prop) -{ - /* Skip over `when FORM'. */ - if (CONSP (prop) && EQ (XCAR (prop), Qwhen)) - { - prop = XCDR (prop); - if (!CONSP (prop)) - return 0; - prop = XCDR (prop); - } - - if (STRINGP (prop)) - return 1; - - if (!CONSP (prop)) - return 0; - - /* Skip over `margin LOCATION'. If LOCATION is in the margins, - we don't need to treat text as intangible. */ - if (EQ (XCAR (prop), Qmargin)) - { - prop = XCDR (prop); - if (!CONSP (prop)) - return 0; - - prop = XCDR (prop); - if (!CONSP (prop) - || EQ (XCAR (prop), Qleft_margin) - || EQ (XCAR (prop), Qright_margin)) - return 0; - } - - return (CONSP (prop) - && (EQ (XCAR (prop), Qimage) - || EQ (XCAR (prop), Qspace))); -} - - /* Check if PROP is a display property value whose text should be - treated as intangible. */ + treated as intangible. OVERLAY is the overlay from which PROP + came, or nil if it came from a text property. CHARPOS and BYTEPOS + specify the buffer position covered by PROP. */ int -display_prop_intangible_p (Lisp_Object prop) +display_prop_intangible_p (Lisp_Object prop, Lisp_Object overlay, + EMACS_INT charpos, EMACS_INT bytepos) { - if (CONSP (prop) - && CONSP (XCAR (prop)) - && !EQ (Qmargin, XCAR (XCAR (prop)))) - { - /* A list of sub-properties. */ - while (CONSP (prop)) - { - if (single_display_spec_intangible_p (XCAR (prop))) - return 1; - prop = XCDR (prop); - } - } - else if (VECTORP (prop)) - { - /* A vector of sub-properties. */ - int i; - for (i = 0; i < ASIZE (prop); ++i) - if (single_display_spec_intangible_p (AREF (prop, i))) - return 1; - } - else - return single_display_spec_intangible_p (prop); + int frame_window_p = FRAME_WINDOW_P (XFRAME (selected_frame)); + struct text_pos position; - return 0; + SET_TEXT_POS (position, charpos, bytepos); + return handle_display_spec (NULL, prop, Qnil, overlay, + &position, charpos, frame_window_p); } -/* Return 1 if PROP is a display sub-property value containing STRING. */ +/* Return 1 if PROP is a display sub-property value containing STRING. + + Implementation note: this and the following function are really + special cases of handle_display_spec and + handle_single_display_spec, and should ideally use the same code. + Until they do, these two pairs must be consistent and must be + modified in sync. */ static int single_display_spec_string_p (Lisp_Object prop, Lisp_Object string) @@ -4325,6 +4413,16 @@ prop = XCDR (prop); if (!CONSP (prop)) return 0; + /* Actually, the condition following `when' should be eval'ed, + like handle_single_display_spec does, and we should return + zero if it evaluates to nil. However, this function is + called only when the buffer was already displayed and some + glyph in the glyph matrix was found to come from a display + string. Therefore, the condition was already evaluated, and + the result was non-nil, otherwise the display string wouldn't + have been displayed and we would have never been called for + this property. Thus, we can skip the evaluation and assume + its result is non-nil. */ prop = XCDR (prop); } @@ -4341,7 +4439,7 @@ return 0; } - return CONSP (prop) && EQ (XCAR (prop), string); + return EQ (prop, string) || (CONSP (prop) && EQ (XCAR (prop), string)); } @@ -4351,8 +4449,8 @@ display_prop_string_p (Lisp_Object prop, Lisp_Object string) { if (CONSP (prop) - && CONSP (XCAR (prop)) - && !EQ (Qmargin, XCAR (XCAR (prop)))) + && !EQ (XCAR (prop), Qwhen) + && !(CONSP (XCAR (prop)) && EQ (Qmargin, XCAR (XCAR (prop))))) { /* A list of sub-properties. */ while (CONSP (prop)) @@ -4852,7 +4950,7 @@ /* When called from handle_stop, there might be an empty display string loaded. In that case, don't bother saving it. */ if (!STRINGP (it->string) || SCHARS (it->string)) - push_it (it); + push_it (it, NULL); /* Set up IT to deliver display elements from the first overlay string. */ @@ -4894,10 +4992,11 @@ /* Save current settings of IT on IT->stack. Called, for example, before setting up IT for an overlay string, to be able to restore IT's settings to what they were after the overlay string has been - processed. */ + processed. If POSITION is non-NULL, it is the position to save on + the stack instead of IT->position. */ static void -push_it (struct it *it) +push_it (struct it *it, struct text_pos *position) { struct iterator_stack_entry *p; @@ -4924,7 +5023,7 @@ p->u.stretch.object = it->object; break; } - p->position = it->position; + p->position = position ? *position : it->position; p->current = it->current; p->end_charpos = it->end_charpos; p->string_nchars = it->string_nchars; @@ -5382,6 +5481,7 @@ { it->bidi_it.first_elt = 1; it->bidi_it.paragraph_dir = NEUTRAL_DIR; + it->bidi_it.disp_pos = -1; } if (set_stop_p) @@ -12688,11 +12788,30 @@ GLYPH_BEFORE and GLYPH_AFTER, and it came from a string positioned between POS_BEFORE and POS_AFTER in the buffer. */ - struct glyph *stop = glyph_after; + struct glyph *start, *stop; EMACS_INT pos = pos_before; x = -1; - for (glyph = glyph_before + incr; + + /* GLYPH_BEFORE and GLYPH_AFTER are the glyphs that + correspond to POS_BEFORE and POS_AFTER, respectively. We + need START and STOP in the order that corresponds to the + row's direction as given by its reversed_p flag. If the + directionality of characters between POS_BEFORE and + POS_AFTER is the opposite of the row's base direction, + these characters will have been reordered for display, + and we need to reverse START and STOP. */ + if (!row->reversed_p) + { + start = min (glyph_before, glyph_after); + stop = max (glyph_before, glyph_after); + } + else + { + start = max (glyph_before, glyph_after); + stop = min (glyph_before, glyph_after); + } + for (glyph = start + incr; row->reversed_p ? glyph > stop : glyph < stop; ) { @@ -17111,7 +17230,7 @@ static int push_display_prop (struct it *it, Lisp_Object prop) { - push_it (it); + push_it (it, NULL); if (STRINGP (prop)) { @@ -18040,6 +18159,8 @@ bytepos--; itb.charpos = pos; itb.bytepos = bytepos; + itb.nchars = -1; + itb.frame_window_p = FRAME_WINDOW_P (SELECTED_FRAME ()); /* guesswork */ itb.first_elt = 1; itb.separator_limit = -1; itb.paragraph_dir = NEUTRAL_DIR; ------------------------------------------------------------ revno: 104481 fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8785 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-06-02 15:04:44 -0300 message: * lisp/subr.el (make-progress-reporter): Add "..." by default. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-06-02 11:24:12 +0000 +++ lisp/ChangeLog 2011-06-02 18:04:44 +0000 @@ -1,3 +1,7 @@ +2011-06-02 Stefan Monnier + + * subr.el (make-progress-reporter): Add "..." by default (bug#8785). + 2011-06-02 Juanma Barranquero * bs.el (bs--mark-unmark, bs--nth-wrapper): === modified file 'lisp/subr.el' --- lisp/subr.el 2011-06-01 14:19:45 +0000 +++ lisp/subr.el 2011-06-02 18:04:44 +0000 @@ -3702,6 +3702,8 @@ `float-time' is not present, time is not tracked at all. If the OS is not capable of measuring fractions of seconds, this parameter is effectively rounded up." + (when (string-match "[[:alnum:]]\\'" message) + (setq message (concat message "..."))) (unless min-time (setq min-time 0.2)) (let ((reporter ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.