Now on revision 114588. ------------------------------------------------------------ revno: 114588 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 23:32:35 -0400 message: * lisp/profiler.el: Create a more coherent calltree from partial backtraces. (profiler-format): Hide the tail with `invisible' so that C-s can still find the hidden elements. (profiler-calltree-depth): Don't recurse so enthusiastically. (profiler-function-equal): New hash-table-test. (profiler-calltree-build-unified): New function. (profiler-calltree-build): Use it. (profiler-report-make-name-part): Indent the calltree less. (profiler-report-mode): Add visibility specs for profiler-format. (profiler-report-expand-entry, profiler-report-toggle-entry): Expand the whole subtree when provided with a prefix arg. * src/fns.c (hashfn_user_defined): Allow hash functions to return any Lisp_Object. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 03:18:01 +0000 +++ lisp/ChangeLog 2013-10-09 03:32:35 +0000 @@ -1,3 +1,17 @@ +2013-10-09 Stefan Monnier + + * profiler.el: Create a more coherent calltree from partial backtraces. + (profiler-format): Hide the tail with `invisible' so that C-s can still + find the hidden elements. + (profiler-calltree-depth): Don't recurse so enthusiastically. + (profiler-function-equal): New hash-table-test. + (profiler-calltree-build-unified): New function. + (profiler-calltree-build): Use it. + (profiler-report-make-name-part): Indent the calltree less. + (profiler-report-mode): Add visibility specs for profiler-format. + (profiler-report-expand-entry, profiler-report-toggle-entry): + Expand the whole subtree when provided with a prefix arg. + 2013-10-09 Dmitry Gutov * progmodes/ruby-mode.el (ruby-smie-rules): Indent after hanging === modified file 'lisp/profiler.el' --- lisp/profiler.el 2013-09-11 01:43:07 +0000 +++ lisp/profiler.el 2013-10-09 03:32:35 +0000 @@ -27,6 +27,7 @@ ;;; Code: (require 'cl-lib) +(require 'pcase) (defgroup profiler nil "Emacs profiler." @@ -86,10 +87,12 @@ (profiler-ensure-string arg))) for len = (length str) if (< width len) - collect (substring str 0 width) into frags + collect (progn (put-text-property (max 0 (- width 2)) len + 'invisible 'profiler str) + str) into frags else collect - (let ((padding (make-string (- width len) ?\s))) + (let ((padding (make-string (max 0 (- width len)) ?\s))) (cl-ecase align (left (concat str padding)) (right (concat padding str)))) @@ -248,10 +251,10 @@ (not (profiler-calltree-count< a b))) (defun profiler-calltree-depth (tree) - (let ((parent (profiler-calltree-parent tree))) - (if (null parent) - 0 - (1+ (profiler-calltree-depth parent))))) + (let ((d 0)) + (while (setq tree (profiler-calltree-parent tree)) + (cl-incf d)) + d)) (defun profiler-calltree-find (tree entry) "Return a child tree of ENTRY under TREE." @@ -269,10 +272,9 @@ (profiler-calltree-walk child function))) (defun profiler-calltree-build-1 (tree log &optional reverse) - ;; FIXME: Do a better job of reconstructing a complete call-tree - ;; when the backtraces have been truncated. Ideally, we should be - ;; able to reduce profiler-max-stack-depth to 3 or 4 and still - ;; get a meaningful call-tree. + ;; This doesn't try to stitch up partial backtraces together. + ;; We still use it for reverse calltrees, but for forward calltrees, we use + ;; profiler-calltree-build-unified instead now. (maphash (lambda (backtrace count) (let ((node tree) @@ -289,6 +291,115 @@ (setq node child))))))) log)) + +(define-hash-table-test 'profiler-function-equal #'function-equal + (lambda (f) (cond + ((byte-code-function-p f) (aref f 1)) + ((eq (car-safe f) 'closure) (cddr f)) + (t f)))) + +(defun profiler-calltree-build-unified (tree log) + ;; Let's try to unify all those partial backtraces into a single + ;; call tree. First, we record in fun-map all the functions that appear + ;; in `log' and where they appear. + (let ((fun-map (make-hash-table :test 'profiler-function-equal)) + (parent-map (make-hash-table :test 'eq)) + (leftover-tree (profiler-make-calltree + :entry (intern "...") :parent tree))) + (push leftover-tree (profiler-calltree-children tree)) + (maphash + (lambda (backtrace _count) + (let ((max (length backtrace))) + ;; Don't record the head elements in there, since we want to use this + ;; fun-map to find parents of partial backtraces, but parents only + ;; make sense if they have something "above". + (dotimes (i (1- max)) + (let ((f (aref backtrace i))) + (when f + (push (cons i backtrace) (gethash f fun-map))))))) + log) + ;; Then, for each partial backtrace, try to find a parent backtrace + ;; (i.e. a backtrace that describes (part of) the truncated part of + ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3 + ;; is deeper), any backtrace that includes f1 could be a parent; and indeed + ;; the counts of this partial backtrace could each come from a different + ;; parent backtrace (some of which may not even be in `log'). So we should + ;; consider each backtrace that includes f1 and give it some percentage of + ;; `count'. But we can't know for sure what percentage to give to each + ;; possible parent. + ;; The "right" way might be to give a percentage proportional to the counts + ;; already registered for that parent, or some such statistical principle. + ;; But instead, we will give all our counts to a single "best + ;; matching" parent. So let's look for the best matching parent, and store + ;; the result in parent-map. + ;; Using the "best matching parent" is important also to try and avoid + ;; stitching together backtraces that can't possibly go together. + ;; For example, when the head is `apply' (or `mapcar', ...), we want to + ;; make sure we don't just use any parent that calls `apply', since most of + ;; them would never, in turn, cause apply to call the subsequent function. + (maphash + (lambda (backtrace _count) + (let* ((max (1- (length backtrace))) + (head (aref backtrace max)) + (best-parent nil) + (best-match (1+ max)) + (parents (gethash head fun-map))) + (pcase-dolist (`(,i . ,parent) parents) + (when t ;; (<= (- max i) best-match) ;Else, it can't be better. + (let ((match max) + (imatch i)) + (cl-assert (>= match imatch)) + (cl-assert (function-equal (aref backtrace max) + (aref parent i))) + (while (progn + (cl-decf imatch) (cl-decf match) + (when (> imatch 0) + (function-equal (aref backtrace match) + (aref parent imatch))))) + (when (< match best-match) + (cl-assert (<= (- max i) best-match)) + ;; Let's make sure this parent is not already our child: we + ;; don't want cycles here! + (let ((valid t) + (tmp-parent parent)) + (while (setq tmp-parent + (if (eq tmp-parent backtrace) + (setq valid nil) + (cdr (gethash tmp-parent parent-map))))) + (when valid + (setq best-match match) + (setq best-parent (cons i parent)))))))) + (puthash backtrace best-parent parent-map))) + log) + ;; Now we have a single parent per backtrace, so we have a unified tree. + ;; Let's build the actual call-tree from it. + (maphash + (lambda (backtrace count) + (let ((node tree) + (parents (list (cons -1 backtrace))) + (tmp backtrace) + (max (length backtrace))) + (while (setq tmp (gethash tmp parent-map)) + (push tmp parents) + (setq tmp (cdr tmp))) + (when (aref (cdar parents) (1- max)) + (cl-incf (profiler-calltree-count leftover-tree) count) + (setq node leftover-tree)) + (pcase-dolist (`(,i . ,parent) parents) + (let ((j (1- max))) + (while (> j i) + (let ((f (aref parent j))) + (cl-decf j) + (when f + (let ((child (profiler-calltree-find node f))) + (unless child + (setq child (profiler-make-calltree + :entry f :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child))))))))) + log))) + (defun profiler-calltree-compute-percentages (tree) (let ((total-count 0)) ;; FIXME: the memory profiler's total wraps around all too easily! @@ -303,7 +414,9 @@ (cl-defun profiler-calltree-build (log &key reverse) (let ((tree (profiler-make-calltree))) - (profiler-calltree-build-1 tree log reverse) + (if reverse + (profiler-calltree-build-1 tree log reverse) + (profiler-calltree-build-unified tree log)) (profiler-calltree-compute-percentages tree) tree)) @@ -371,7 +484,7 @@ (defun profiler-report-make-name-part (tree) (let* ((entry (profiler-calltree-entry tree)) (depth (profiler-calltree-depth tree)) - (indent (make-string (* (1- depth) 2) ?\s)) + (indent (make-string (* (1- depth) 1) ?\s)) (mark (if (profiler-calltree-leaf-p tree) profiler-report-leaf-mark profiler-report-closed-mark)) @@ -379,7 +492,7 @@ (format "%s%s %s" indent mark entry))) (defun profiler-report-header-line-format (fmt &rest args) - (let* ((header (apply 'profiler-format fmt args)) + (let* ((header (apply #'profiler-format fmt args)) (escaped (replace-regexp-in-string "%" "%%" header))) (concat " " escaped))) @@ -404,7 +517,7 @@ (insert (propertize (concat line "\n") 'calltree tree)))) (defun profiler-report-insert-calltree-children (tree) - (mapc 'profiler-report-insert-calltree + (mapc #'profiler-report-insert-calltree (profiler-calltree-children tree))) @@ -502,6 +615,7 @@ (define-derived-mode profiler-report-mode special-mode "Profiler-Report" "Profiler Report Mode." + (add-to-invisibility-spec '(profiler . t)) (setq buffer-read-only t buffer-undo-list t truncate-lines t)) @@ -531,9 +645,10 @@ (forward-line -1) (profiler-report-move-to-entry)) -(defun profiler-report-expand-entry () - "Expand entry at point." - (interactive) +(defun profiler-report-expand-entry (&optional full) + "Expand entry at point. +With a prefix argument, expand the whole subtree." + (interactive "P") (save-excursion (beginning-of-line) (when (search-forward (concat profiler-report-closed-mark " ") @@ -543,7 +658,14 @@ (let ((inhibit-read-only t)) (replace-match (concat profiler-report-open-mark " ")) (forward-line) - (profiler-report-insert-calltree-children tree) + (let ((first (point)) + (last (copy-marker (point) t))) + (profiler-report-insert-calltree-children tree) + (when full + (goto-char first) + (while (< (point) last) + (profiler-report-expand-entry) + (forward-line 1)))) t)))))) (defun profiler-report-collapse-entry () @@ -568,11 +690,11 @@ (delete-region start (line-beginning-position))))) t))) -(defun profiler-report-toggle-entry () +(defun profiler-report-toggle-entry (&optional arg) "Expand entry at point if the tree is collapsed, otherwise collapse." - (interactive) - (or (profiler-report-expand-entry) + (interactive "P") + (or (profiler-report-expand-entry arg) (profiler-report-collapse-entry))) (defun profiler-report-find-entry (&optional event) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 20:04:40 +0000 +++ src/ChangeLog 2013-10-09 03:32:35 +0000 @@ -1,3 +1,8 @@ +2013-10-09 Stefan Monnier + + * fns.c (hashfn_user_defined): Allow hash functions to return any + Lisp_Object. + 2013-10-08 Paul Eggert Fix minor problems found by static checking. === modified file 'src/fns.c' --- src/fns.c 2013-09-29 18:50:28 +0000 +++ src/fns.c 2013-10-09 03:32:35 +0000 @@ -3571,9 +3571,7 @@ args[0] = ht->user_hash_function; args[1] = key; hash = Ffuncall (2, args); - if (!INTEGERP (hash)) - signal_error ("Invalid hash code returned from user-supplied hash function", hash); - return XUINT (hash); + return hashfn_eq (ht, hash); } /* An upper bound on the size of a hash table index. It must fit in @@ -4542,9 +4540,9 @@ TEST must be a function taking two arguments and returning non-nil if both arguments are the same. HASH must be a function taking one -argument and return an integer that is the hash code of the argument. -Hash code computation should use the whole value range of integers, -including negative integers. */) +argument and returning an object that is the hash code of the argument. +It should be the case that if (eq (funcall HASH x1) (funcall HASH x2)) +returns nil, then (funcall TEST x1 x2) also returns nil. */) (Lisp_Object name, Lisp_Object test, Lisp_Object hash) { return Fput (name, Qhash_table_test, list2 (test, hash)); ------------------------------------------------------------ revno: 114587 committer: Dmitry Gutov branch nick: trunk timestamp: Wed 2013-10-09 06:18:01 +0300 message: * lisp/progmodes/ruby-mode.el (ruby-smie-rules): Indent after hanging iuwu-mod token. (ruby-smie--implicit-semi-p): Prohibit implicit semicolon after hanging iuwu-mod token. (ruby-smie--forward-token): Do not include a dot after a token in that token. (ruby-smie--backward-token): Likewise. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 23:20:12 +0000 +++ lisp/ChangeLog 2013-10-09 03:18:01 +0000 @@ -1,3 +1,13 @@ +2013-10-09 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-smie-rules): Indent after hanging + iuwu-mod token. + (ruby-smie--implicit-semi-p): Prohibit implicit semicolon after + hanging iuwu-mod token. + (ruby-smie--forward-token): Do not include a dot after a token in + that token. + (ruby-smie--backward-token): Likewise. + 2013-10-08 Juri Linkov * isearch.el (isearch-help-map, isearch-mode-map): Don't bind [t] === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-10-07 23:03:16 +0000 +++ lisp/progmodes/ruby-mode.el 2013-10-09 03:18:01 +0000 @@ -296,6 +296,9 @@ (let ((tok (save-excursion (ruby-smie--backward-token)))) (or (equal tok "?") (string-match "\\`\\s." tok)))) + (and (eq (car (syntax-after (1- (point)))) 2) + (equal (save-excursion (ruby-smie--backward-token)) + "iuwu-mod")) (save-excursion (forward-comment 1) (eq (char-after) ?.)))))) @@ -334,9 +337,6 @@ (if (looking-at ":\\s.+") (progn (goto-char (match-end 0)) (match-string 0)) ;; bug#15208. (let ((tok (smie-default-forward-token))) - (when (eq ?. (char-after)) - (forward-char 1) - (setq tok (concat tok "." (ruby-smie--forward-id)))) (cond ((member tok '("unless" "if" "while" "until")) (if (save-excursion (forward-word -1) (ruby-smie--bosp)) @@ -375,7 +375,7 @@ (let ((tok (smie-default-backward-token))) (when (eq ?. (char-before)) (forward-char -1) - (setq tok (concat (ruby-smie--backward-id) "." tok))) + (setq tok (concat "." tok))) (when (and (eq ?: (char-before)) (string-match "\\`\\s." tok)) (forward-char -1) (setq tok (concat ":" tok))) ;; bug#15208. (cond @@ -394,6 +394,9 @@ (line-end-position)) (ruby-smie--backward-token)) ;Fully redundant. (t ";"))) + ;; FIXME: We shouldn't merge the dot with preceding token here + ;; either, but not doing that breaks indentation of hanging + ;; method calls with dot on the first line. ((equal tok ".") (concat (ruby-smie--backward-id) tok)) (t tok))))))) @@ -419,7 +422,7 @@ ;; when the opening statement is hanging. (when (smie-rule-hanging-p) (smie-backward-sexp 'halfsexp) (smie-indent-virtual))) - (`(:after . "=") 2) + (`(:after . ,(or "=" "iuwu-mod")) 2) (`(:before . "do") (when (or (smie-rule-hanging-p) (save-excursion === modified file 'test/automated/ruby-mode-tests.el' --- test/automated/ruby-mode-tests.el 2013-10-06 01:21:51 +0000 +++ test/automated/ruby-mode-tests.el 2013-10-09 03:18:01 +0000 @@ -594,6 +594,9 @@ | def foo | self.end | D.new.class + | [1, 2, 3].map do |i| + | i + 1 + | end.sum | end |end")) @@ -601,11 +604,11 @@ (ruby-with-temp-buffer ruby-sexp-test-example (goto-line 2) (ruby-forward-sexp) - (should (= 5 (line-number-at-pos))))) + (should (= 8 (line-number-at-pos))))) (ert-deftest ruby-backward-sexp-skips-method-calls-with-keyword-names () (ruby-with-temp-buffer ruby-sexp-test-example - (goto-line 5) + (goto-line 8) (end-of-line) (ruby-backward-sexp) (should (= 2 (line-number-at-pos))))) === modified file 'test/indent/ruby.rb' --- test/indent/ruby.rb 2013-10-07 23:01:23 +0000 +++ test/indent/ruby.rb 2013-10-09 03:18:01 +0000 @@ -148,10 +148,14 @@ } } +foo if + bar + # Examples below still fail with `ruby-use-smie' on: foo + bar -foo if - bar +foo = [1, 2, 3].map do |i| + i + 1 +end ------------------------------------------------------------ revno: 114586 fixes bug: http://debbugs.gnu.org/15200 committer: Juri Linkov branch nick: trunk timestamp: Wed 2013-10-09 02:20:12 +0300 message: * lisp/isearch.el (isearch-help-map, isearch-mode-map): Don't bind [t] to isearch-other-control-char. (isearch-mode): Add isearch-pre-command-hook to pre-command-hook and isearch-post-command-hook to post-command-hook. (isearch-done): Remove isearch-pre-command-hook from pre-command-hook and isearch-post-command-hook from post-command-hook. (isearch-unread-key-sequence) (isearch-reread-key-sequence-naturally) (isearch-lookup-scroll-key, isearch-other-control-char) (isearch-other-meta-char): Remove functions. (isearch-pre-command-hook, isearch-post-command-hook): New functions based on isearch-other-meta-char rewritten relying on the new behavior of overriding-terminal-local-map that does not replace the local keymaps any more. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 17:49:20 +0000 +++ lisp/ChangeLog 2013-10-08 23:20:12 +0000 @@ -1,3 +1,20 @@ +2013-10-08 Juri Linkov + + * isearch.el (isearch-help-map, isearch-mode-map): Don't bind [t] + to isearch-other-control-char. + (isearch-mode): Add isearch-pre-command-hook to pre-command-hook + and isearch-post-command-hook to post-command-hook. + (isearch-done): Remove isearch-pre-command-hook from pre-command-hook + and isearch-post-command-hook from post-command-hook. + (isearch-unread-key-sequence) + (isearch-reread-key-sequence-naturally) + (isearch-lookup-scroll-key, isearch-other-control-char) + (isearch-other-meta-char): Remove functions. + (isearch-pre-command-hook, isearch-post-command-hook): + New functions based on isearch-other-meta-char rewritten + relying on the new behavior of overriding-terminal-local-map + that does not replace the local keymaps any more. (Bug#15200) + 2013-10-08 Eli Zaretskii Support menus on text-mode terminals. === modified file 'lisp/isearch.el' --- lisp/isearch.el 2013-08-28 16:39:51 +0000 +++ lisp/isearch.el 2013-10-08 23:20:12 +0000 @@ -349,7 +349,6 @@ (defvar isearch-help-map (let ((map (make-sparse-keymap))) - (define-key map [t] 'isearch-other-control-char) (define-key map (char-to-string help-char) 'isearch-help-for-help) (define-key map [help] 'isearch-help-for-help) (define-key map [f1] 'isearch-help-for-help) @@ -423,9 +422,6 @@ ;; Make all multibyte characters search for themselves. (set-char-table-range (nth 1 map) (cons #x100 (max-char)) 'isearch-printing-char) - ;; Make function keys, etc, which aren't bound to a scrolling-function - ;; exit the search. - (define-key map [t] 'isearch-other-control-char) ;; Single-byte printing chars extend the search string by default. (setq i ?\s) @@ -440,8 +436,7 @@ ;; default local key binding for any key not otherwise bound. (let ((meta-map (make-sparse-keymap))) (define-key map (char-to-string meta-prefix-char) meta-map) - (define-key map [escape] meta-map) - (define-key meta-map [t] 'isearch-other-meta-char)) + (define-key map [escape] meta-map)) ;; Several non-printing chars change the searching behavior. (define-key map "\C-s" 'isearch-repeat-forward) @@ -521,9 +516,6 @@ ;; The key translations defined in the C-x 8 prefix should add ;; characters to the search string. See iso-transl.el. - (define-key map "\C-x" nil) - (define-key map [?\C-x t] 'isearch-other-control-char) - (define-key map "\C-x8" nil) (define-key map "\C-x8\r" 'isearch-char-by-name) map) @@ -920,6 +912,8 @@ (isearch-update) + (add-hook 'pre-command-hook 'isearch-pre-command-hook nil t) + (add-hook 'post-command-hook 'isearch-post-command-hook nil t) (add-hook 'mouse-leave-buffer-hook 'isearch-done) (add-hook 'kbd-macro-termination-hook 'isearch-done) @@ -998,6 +992,8 @@ (unless (equal (car command-history) command) (setq command-history (cons command command-history))))) + (remove-hook 'pre-command-hook 'isearch-pre-command-hook t) + (remove-hook 'post-command-hook 'isearch-post-command-hook t) (remove-hook 'mouse-leave-buffer-hook 'isearch-done) (remove-hook 'kbd-macro-termination-hook 'isearch-done) (setq isearch-lazy-highlight-start nil) @@ -2100,26 +2096,6 @@ (min last-other-end isearch-barrier))) (setq isearch-adjusted t))))))) -(defun isearch-unread-key-sequence (keylist) - "Unread the given key-sequence KEYLIST. -Scroll-bar or mode-line events are processed appropriately." - (cancel-kbd-macro-events) - (apply 'isearch-unread keylist) - ;; If the event was a scroll-bar or mode-line click, the event will have - ;; been prefixed by a symbol such as vertical-scroll-bar. We must remove - ;; it here, because this symbol will be attached to the event again next - ;; time it gets read by read-key-sequence. - ;; - ;; (Old comment from isearch-other-meta-char: "Note that we don't have to - ;; modify the event anymore in 21 because read_key_sequence no longer - ;; modifies events to produce fake prefix keys.") - (if (and (> (length keylist) 1) - (symbolp (car keylist)) - (listp (cadr keylist)) - (not (numberp (posn-point - (event-start (cadr keylist) ))))) - (pop unread-command-events))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; scrolling within Isearch mode. Alan Mackenzie (acm@muc.de), 2003/2/24 ;; @@ -2244,198 +2220,57 @@ (recenter 0)))) (goto-char isearch-point)) -(defun isearch-reread-key-sequence-naturally (keylist) - "Reread key sequence KEYLIST with an inactive Isearch-mode keymap. -Return the key sequence as a string/vector." - (isearch-unread-key-sequence keylist) - (let (overriding-terminal-local-map) - ;; This will go through function-key-map, if nec. - ;; The arg DONT-DOWNCASE-LAST prevents premature shift-translation. - (read-key-sequence nil nil t))) - -(defun isearch-lookup-scroll-key (key-seq) - "If KEY-SEQ is bound to a scrolling command, return it as a symbol. -Otherwise return nil." - (let* ((overriding-terminal-local-map nil) - (binding (key-binding key-seq))) - (and binding (symbolp binding) (commandp binding) - (or (eq (get binding 'isearch-scroll) t) - (eq (get binding 'scroll-command) t)) - binding))) - -(defalias 'isearch-other-control-char 'isearch-other-meta-char) - -(defun isearch-other-meta-char (&optional arg) - "Process a miscellaneous key sequence in Isearch mode. - -Try to convert the current key-sequence to something usable in Isearch -mode, either by converting it with `function-key-map', downcasing a -key with C-, or finding a \"scrolling command\" bound to -it. \(In the last case, we may have to read more events.) If so, -either unread the converted sequence or execute the command. - -Otherwise, if `search-exit-option' is non-nil (the default) unread the -key-sequence and exit the search normally. If it is the symbol -`edit', the search string is edited in the minibuffer and the meta -character is unread so that it applies to editing the string. - -ARG is the prefix argument. It will be transmitted through to the -scrolling command or to the command whose key-sequence exits -Isearch mode." - (interactive "P") - (let* ((key (if current-prefix-arg ; not nec the same as ARG - (substring (this-command-keys) universal-argument-num-events) - (this-command-keys))) - (main-event (aref key 0)) - (keylist (listify-key-sequence key)) - scroll-command isearch-point) - (cond ((and (= (length key) 1) - (let ((lookup (lookup-key local-function-key-map key))) - (not (or (null lookup) (integerp lookup) - (keymapp lookup))))) - ;; Handle a function key that translates into something else. - ;; If the key has a global definition too, - ;; exit and unread the key itself, so its global definition runs. - ;; Otherwise, unread the translation, - ;; so that the translated key takes effect within isearch. - (cancel-kbd-macro-events) - (if (lookup-key global-map key) - (progn - (isearch-done) - (setq prefix-arg arg) - (apply 'isearch-unread keylist)) - (setq keylist - (listify-key-sequence - (lookup-key local-function-key-map key))) - (while keylist - (setq key (car keylist)) - ;; Handle an undefined shifted printing character - ;; by downshifting it if that makes it printing. - ;; (As read-key-sequence would normally do, - ;; if we didn't have a default definition.) - (if (and (integerp key) - (memq 'shift (event-modifiers key)) - (>= key (+ ?\s (- ?\S-a ?a))) - (/= key (+ 127 (- ?\S-a ?a))) - (< key (+ 256 (- ?\S-a ?a)))) - (setq key (- key (- ?\S-a ?a)))) - ;; If KEY is a printing char, we handle it here - ;; directly to avoid the input method and keyboard - ;; coding system translating it. - (if (and (integerp key) - (>= key ?\s) (/= key 127) (< key 256)) - (progn - ;; Ensure that the processed char is recorded in - ;; the keyboard macro, if any (Bug#4894) - (store-kbd-macro-event key) - (isearch-process-search-char key) - (setq keylist (cdr keylist))) - ;; As the remaining keys in KEYLIST can't be handled - ;; here, we must reread them. - (setq prefix-arg arg) - (apply 'isearch-unread keylist) - (setq keylist nil))))) - ( - ;; Handle an undefined shifted control character - ;; by downshifting it if that makes it defined. - ;; (As read-key-sequence would normally do, - ;; if we didn't have a default definition.) - (let ((mods (event-modifiers main-event))) - (and (integerp main-event) - (memq 'shift mods) - (memq 'control mods) - (not (memq (lookup-key isearch-mode-map - (let ((copy (copy-sequence key))) - (aset copy 0 - (- main-event - (- ?\C-\S-a ?\C-a))) - copy) - nil) - '(nil - isearch-other-control-char))))) - (setcar keylist (- main-event (- ?\C-\S-a ?\C-a))) - (cancel-kbd-macro-events) - (setq prefix-arg arg) - (apply 'isearch-unread keylist)) - ((eq search-exit-option 'edit) - (setq prefix-arg arg) - (apply 'isearch-unread keylist) - (isearch-edit-string)) - ;; Handle a scrolling function or prefix argument. - ((progn - (setq key (isearch-reread-key-sequence-naturally keylist) - keylist (listify-key-sequence key) - main-event (aref key 0)) - (or (and isearch-allow-scroll - (setq scroll-command (isearch-lookup-scroll-key key))) - (and isearch-allow-prefix - (let (overriding-terminal-local-map) - (setq scroll-command (key-binding key)) - (memq scroll-command - '(universal-argument - negative-argument digit-argument)))))) - ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a - ;; complete key sequence, possibly as modified by function-key-map, - ;; not merely the one or two event fragment which invoked - ;; isearch-other-meta-char in the first place. - (setq isearch-point (point)) - (setq prefix-arg arg) - (command-execute scroll-command) - (let ((ab-bel (isearch-string-out-of-window isearch-point))) - (if ab-bel - (isearch-back-into-window (eq ab-bel 'above) isearch-point) - (goto-char isearch-point))) - (isearch-update)) - ;; A mouse click on the isearch message starts editing the search string - ((and (eq (car-safe main-event) 'down-mouse-1) - (window-minibuffer-p (posn-window (event-start main-event)))) - ;; Swallow the up-event. - (read-event) - (isearch-edit-string)) - (search-exit-option - (let (window) - (setq prefix-arg arg) - (isearch-unread-key-sequence keylist) - (setq main-event (car unread-command-events)) - - ;; Don't store special commands in the keyboard macro. - (let (overriding-terminal-local-map) - (when (memq (key-binding key) - '(kmacro-start-macro - kmacro-end-macro kmacro-end-and-call-macro)) - (cancel-kbd-macro-events))) - - ;; If we got a mouse click event, that event contains the - ;; window clicked on. maybe it was read with the buffer - ;; it was clicked on. If so, that buffer, not the current one, - ;; is in isearch mode. So end the search in that buffer. - - ;; ??? I have no idea what this if checks for, but it's - ;; obviously wrong for the case that a down-mouse event - ;; on another window invokes this function. The event - ;; will contain the window clicked on and that window's - ;; buffer is certainly not always in Isearch mode. - ;; - ;; Leave the code in, but check for current buffer not - ;; being in Isearch mode for now, until someone tells - ;; what it's really supposed to do. - ;; - ;; --gerd 2001-08-10. - - (if (and (not isearch-mode) - (listp main-event) - (setq window (posn-window (event-start main-event))) - (windowp window) - (or (> (minibuffer-depth) 0) - (not (window-minibuffer-p window)))) - (with-current-buffer (window-buffer window) - (isearch-done) - (isearch-clean-overlays)) - (isearch-done) - (isearch-clean-overlays) - (setq prefix-arg arg)))) - (t;; otherwise nil - (isearch-process-search-string key key))))) +(defvar isearch-pre-scroll-point nil) + +(defun isearch-pre-command-hook () + "Decide whether to exit Isearch mode before executing the command. +Don't exit Isearch if the key sequence that invoked this command +is bound in `isearch-mode-map', or if the invoked command is +a prefix argument command (when `isearch-allow-prefix' is non-nil), +or it is a scrolling command (when `isearch-allow-scroll' is non-nil). +Otherwise, exit Isearch (when `search-exit-option' is non-nil) +before the command is executed globally with terminated Isearch." + (let* ((key (this-command-keys)) + (main-event (aref key 0))) + (cond + ;; Don't exit Isearch for isearch key bindings. + ;; FIXME: remove prefix arg to lookup key without prefix. + ((commandp (lookup-key isearch-mode-map key nil))) + ;; Optionally edit the search string instead of exiting. + ((eq search-exit-option 'edit) + (setq this-command 'isearch-edit-string)) + ;; Handle a scrolling function or prefix argument. + ((or (and isearch-allow-prefix + (memq this-command '(universal-argument + negative-argument + digit-argument))) + (and isearch-allow-scroll + (or (eq (get this-command 'isearch-scroll) t) + (eq (get this-command 'scroll-command) t)))) + (when isearch-allow-scroll + (setq isearch-pre-scroll-point (point)))) + ;; A mouse click on the isearch message starts editing the search string. + ((and (eq (car-safe main-event) 'down-mouse-1) + (window-minibuffer-p (posn-window (event-start main-event)))) + ;; Swallow the up-event. + (read-event) + (setq this-command 'isearch-edit-string)) + ;; Other characters terminate the search and are then executed normally. + (search-exit-option + (isearch-done) + (isearch-clean-overlays)) + ;; If search-exit-option is nil, run the command without exiting Isearch. + (t + (isearch-process-search-string key key))))) + +(defun isearch-post-command-hook () + (when isearch-pre-scroll-point + (let ((ab-bel (isearch-string-out-of-window isearch-pre-scroll-point))) + (if ab-bel + (isearch-back-into-window (eq ab-bel 'above) isearch-pre-scroll-point) + (goto-char isearch-pre-scroll-point))) + (setq isearch-pre-scroll-point nil) + (isearch-update))) (defun isearch-quote-char (&optional count) "Quote special characters for incremental search. ------------------------------------------------------------ revno: 114585 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-10-08 13:04:40 -0700 message: Fix minor problems found by static checking. * dispnew.c (save_current_matrix): Omit unnecessary casts. * dispnew.c (update_frame_with_menu): Mark debug local as used. * keyboard.c, keyboard.h (Qmouse_movement): Now static. * keyboard.c (read_menu_command): Remove unused local. * lisp.h (read_menu_command): New decl. * menu.c, menu.h (menu_item_width): Arg is now unsigned char *, for benefit of STRING_CHAR_AND_LENGTH. All uses changed. Return ptrdiff_t, not int. * term.c (tty_menu_struct): 'allocated' member is now ptrdiff_t, not int, for benefit of xpalloc. (tty_menu_create, tty_menu_make_room): Simplify by using xzalloc and xpalloc. (have_menus_p): Remove; unused. (tty_menu_add_pane, tty_menu_add_selection): Change signedness of local char * pointer to pacify STRING_CHAR_AND_LENGTH. (tty_menu_add_selection, tty_menu_locate, tty_meny_destroy): Now static. (save_and_enable_current_matrix): Omit unnecessary casts. (read_menu_input): Omit local extern decl (now in lisp.h). Don't access uninitialized storage if mouse_get_xy fails. (tty_menu_activate): Mark local as initialized, for lint. (tty_menu_activate, tty_meny_show): Remove unused locals. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 17:49:20 +0000 +++ src/ChangeLog 2013-10-08 20:04:40 +0000 @@ -1,3 +1,29 @@ +2013-10-08 Paul Eggert + + Fix minor problems found by static checking. + * dispnew.c (save_current_matrix): Omit unnecessary casts. + * dispnew.c (update_frame_with_menu): Mark debug local as used. + * keyboard.c, keyboard.h (Qmouse_movement): Now static. + * keyboard.c (read_menu_command): Remove unused local. + * lisp.h (read_menu_command): New decl. + * menu.c, menu.h (menu_item_width): Arg is now unsigned char *, for + benefit of STRING_CHAR_AND_LENGTH. All uses changed. + Return ptrdiff_t, not int. + * term.c (tty_menu_struct): 'allocated' member is now ptrdiff_t, + not int, for benefit of xpalloc. + (tty_menu_create, tty_menu_make_room): Simplify by using xzalloc + and xpalloc. + (have_menus_p): Remove; unused. + (tty_menu_add_pane, tty_menu_add_selection): Change signedness of + local char * pointer to pacify STRING_CHAR_AND_LENGTH. + (tty_menu_add_selection, tty_menu_locate, tty_meny_destroy): + Now static. + (save_and_enable_current_matrix): Omit unnecessary casts. + (read_menu_input): Omit local extern decl (now in lisp.h). + Don't access uninitialized storage if mouse_get_xy fails. + (tty_menu_activate): Mark local as initialized, for lint. + (tty_menu_activate, tty_meny_show): Remove unused locals. + 2013-10-08 Eli Zaretskii Support menus on text-mode terminals. === modified file 'src/dispnew.c' --- src/dispnew.c 2013-10-08 17:49:20 +0000 +++ src/dispnew.c 2013-10-08 20:04:40 +0000 @@ -1853,7 +1853,7 @@ if (from->used[LEFT_MARGIN_AREA]) { nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); - to->glyphs[LEFT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + to->glyphs[LEFT_MARGIN_AREA] = xmalloc (nbytes); memcpy (to->glyphs[LEFT_MARGIN_AREA], from->glyphs[LEFT_MARGIN_AREA], nbytes); to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; @@ -1861,7 +1861,7 @@ if (from->used[RIGHT_MARGIN_AREA]) { nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); - to->glyphs[RIGHT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + to->glyphs[RIGHT_MARGIN_AREA] = xmalloc (nbytes); memcpy (to->glyphs[RIGHT_MARGIN_AREA], from->glyphs[RIGHT_MARGIN_AREA], nbytes); to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; @@ -3123,6 +3123,8 @@ check_window_matrix_pointers (root_window); #endif add_frame_display_history (f, paused_p); +#else + IF_LINT ((void) paused_p); #endif /* Reset flags indicating that a window should be updated. */ === modified file 'src/keyboard.c' --- src/keyboard.c 2013-10-08 17:49:20 +0000 +++ src/keyboard.c 2013-10-08 20:04:40 +0000 @@ -289,7 +289,7 @@ at inopportune times. */ /* Symbols to head events. */ -Lisp_Object Qmouse_movement; +static Lisp_Object Qmouse_movement; static Lisp_Object Qscroll_bar_movement; Lisp_Object Qswitch_frame; static Lisp_Object Qfocus_in, Qfocus_out; @@ -1696,7 +1696,6 @@ Lisp_Object read_menu_command (void) { - Lisp_Object cmd; Lisp_Object keybuf[30]; ptrdiff_t count = SPECPDL_INDEX (); int i; === modified file 'src/keyboard.h' --- src/keyboard.h 2013-09-26 07:37:16 +0000 +++ src/keyboard.h 2013-10-08 20:04:40 +0000 @@ -450,7 +450,7 @@ extern Lisp_Object Qevent_kind; /* The values of Qevent_kind properties. */ -extern Lisp_Object Qmouse_click, Qmouse_movement; +extern Lisp_Object Qmouse_click; extern Lisp_Object Qhelp_echo; === modified file 'src/lisp.h' --- src/lisp.h 2013-10-08 04:25:33 +0000 +++ src/lisp.h 2013-10-08 20:04:40 +0000 @@ -3905,6 +3905,7 @@ extern void safe_run_hooks (Lisp_Object); extern void cmd_error_internal (Lisp_Object, const char *); extern Lisp_Object command_loop_1 (void); +extern Lisp_Object read_menu_command (void); extern Lisp_Object recursive_edit_1 (void); extern void record_auto_save (void); extern void force_auto_save_soon (void); === modified file 'src/menu.c' --- src/menu.c 2013-10-08 14:28:37 +0000 +++ src/menu.c 2013-10-08 20:04:40 +0000 @@ -1036,11 +1036,11 @@ } #endif /* HAVE_NS */ -int -menu_item_width (const char *str) +ptrdiff_t +menu_item_width (const unsigned char *str) { - int len; - const char *p; + ptrdiff_t len; + const unsigned char *p; for (len = 0, p = str; *p; ) { @@ -1104,7 +1104,7 @@ if (XINT (pos) <= col /* We use <= so the blank between 2 items on a TTY is considered part of the previous item. */ - && col <= XINT (pos) + menu_item_width (SSDATA (str))) + && col <= XINT (pos) + menu_item_width (SDATA (str))) { item = AREF (items, i); return item; === modified file 'src/menu.h' --- src/menu.h 2013-10-08 14:28:37 +0000 +++ src/menu.h 2013-10-08 20:04:40 +0000 @@ -53,5 +53,5 @@ Lisp_Object, const char **, Time); extern Lisp_Object tty_menu_show (struct frame *, int, int, int, int, Lisp_Object, int, const char **); -extern int menu_item_width (const char *); +extern ptrdiff_t menu_item_width (const unsigned char *); #endif /* MENU_H */ === modified file 'src/term.c' --- src/term.c 2013-10-08 19:06:40 +0000 +++ src/term.c 2013-10-08 20:04:40 +0000 @@ -2814,7 +2814,7 @@ char **text; struct tty_menu_struct **submenu; int *panenumber; /* Also used as enabled flag. */ - int allocated; + ptrdiff_t allocated; int panecount; int width; const char **help_text; @@ -2825,38 +2825,27 @@ static tty_menu * tty_menu_create (void) { - tty_menu *menu; - - menu = (tty_menu *) xmalloc (sizeof (tty_menu)); - menu->allocated = menu->count = menu->panecount = menu->width = 0; - return menu; + return xzalloc (sizeof *tty_menu_create ()); } /* Allocate some (more) memory for MENU ensuring that there is room for one - for item. */ + more item. */ static void tty_menu_make_room (tty_menu *menu) { - if (menu->allocated == 0) - { - int count = menu->allocated = 10; - menu->text = (char **) xmalloc (count * sizeof (char *)); - menu->submenu = (tty_menu **) xmalloc (count * sizeof (tty_menu *)); - menu->panenumber = (int *) xmalloc (count * sizeof (int)); - menu->help_text = (const char **) xmalloc (count * sizeof (char *)); - } - else if (menu->allocated == menu->count) - { - int count = menu->allocated = menu->allocated + 10; - menu->text - = (char **) xrealloc (menu->text, count * sizeof (char *)); - menu->submenu - = (tty_menu **) xrealloc (menu->submenu, count * sizeof (tty_menu *)); - menu->panenumber - = (int *) xrealloc (menu->panenumber, count * sizeof (int)); - menu->help_text - = (const char **) xrealloc (menu->help_text, count * sizeof (char *)); + if (menu->allocated == menu->count) + { + ptrdiff_t allocated = menu->allocated; + menu->text = xpalloc (menu->text, &allocated, 1, -1, sizeof *menu->text); + menu->text = xrealloc (menu->text, allocated * sizeof *menu->text); + menu->submenu = xrealloc (menu->submenu, + allocated * sizeof *menu->submenu); + menu->panenumber = xrealloc (menu->panenumber, + allocated * sizeof *menu->panenumber); + menu->help_text = xrealloc (menu->help_text, + allocated * sizeof *menu->help_text); + menu->allocated = allocated; } } @@ -2965,18 +2954,13 @@ /* --------------------------- X Menu emulation ---------------------- */ -/* Report availability of menus. */ - -int -have_menus_p (void) { return 1; } - /* Create a new pane and place it on the outer-most level. */ static int tty_menu_add_pane (tty_menu *menu, const char *txt) { int len; - const char *p; + const unsigned char *p; tty_menu_make_room (menu); menu->submenu[menu->count] = tty_menu_create (); @@ -2986,7 +2970,7 @@ menu->count++; /* Update the menu width, if necessary. */ - for (len = 0, p = txt; *p; ) + for (len = 0, p = (unsigned char *) txt; *p; ) { int ch_len; int ch = STRING_CHAR_AND_LENGTH (p, ch_len); @@ -3003,12 +2987,12 @@ /* Create a new item in a menu pane. */ -int +static int tty_menu_add_selection (tty_menu *menu, int pane, char *txt, int enable, char const *help_text) { int len; - char *p; + unsigned char *p; if (pane) if (!(menu = tty_menu_search_pane (menu, pane))) @@ -3021,7 +3005,7 @@ menu->count++; /* Update the menu width, if necessary. */ - for (len = 0, p = txt; *p; ) + for (len = 0, p = (unsigned char *) txt; *p; ) { int ch_len; int ch = STRING_CHAR_AND_LENGTH (p, ch_len); @@ -3038,7 +3022,7 @@ /* Decide where the menu would be placed if requested at (X,Y). */ -void +static void tty_menu_locate (tty_menu *menu, int x, int y, int *ulx, int *uly, int *width, int *height) { @@ -3085,7 +3069,7 @@ if (from->used[LEFT_MARGIN_AREA]) { nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); - to->glyphs[LEFT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + to->glyphs[LEFT_MARGIN_AREA] = xmalloc (nbytes); memcpy (to->glyphs[LEFT_MARGIN_AREA], from->glyphs[LEFT_MARGIN_AREA], nbytes); to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; @@ -3093,7 +3077,7 @@ if (from->used[RIGHT_MARGIN_AREA]) { nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); - to->glyphs[RIGHT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + to->glyphs[RIGHT_MARGIN_AREA] = xmalloc (nbytes); memcpy (to->glyphs[RIGHT_MARGIN_AREA], from->glyphs[RIGHT_MARGIN_AREA], nbytes); to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; @@ -3194,7 +3178,6 @@ } else { - extern Lisp_Object read_menu_command (void); Lisp_Object cmd; int usable_input = 1; int st = 0; @@ -3215,13 +3198,7 @@ if (EQ (cmd, Qt) || EQ (cmd, Qtty_menu_exit)) return -1; if (EQ (cmd, Qtty_menu_mouse_movement)) - { - int mx, my; - - mouse_get_xy (&mx, &my); - *x = mx; - *y = my; - } + mouse_get_xy (x, y); else if (EQ (cmd, Qtty_menu_next_menu)) { usable_input = 0; @@ -3261,13 +3238,14 @@ int kbd_navigation) { struct tty_menu_state *state; - int statecount, x, y, i, b, leave, result, onepane; + int statecount, x, y, i, leave, onepane; + int result IF_LINT (= 0); int title_faces[4]; /* face to display the menu title */ int faces[4], buffers_num_deleted = 0; struct frame *sf = SELECTED_FRAME (); struct tty_display_info *tty = FRAME_TTY (sf); bool first_time; - Lisp_Object saved_echo_area_message, selectface; + Lisp_Object selectface; /* Don't allow non-positive x0 and y0, lest the menu will wrap around the display. */ @@ -3465,7 +3443,7 @@ /* Dispose of a menu. */ -void +static void tty_menu_destroy (tty_menu *menu) { int i; @@ -3576,7 +3554,7 @@ if (ix <= *x /* We use <= so the blank between 2 items on a TTY is considered part of the previous item. */ - && *x <= ix + menu_item_width (SSDATA (str))) + && *x <= ix + menu_item_width (SDATA (str))) { /* Found current item. Now compute the X coordinate of the previous or next item. */ @@ -3614,8 +3592,6 @@ int dispwidth, dispheight; int i, j, lines, maxlines; int maxwidth; - int dummy_int; - unsigned int dummy_uint; ptrdiff_t specpdl_count = SPECPDL_INDEX (); if (! FRAME_TERMCAP_P (f)) ------------------------------------------------------------ revno: 114584 committer: Eli Zaretskii branch nick: trunk timestamp: Tue 2013-10-08 22:06:40 +0300 message: Attempt to fix broken compilation on several systems due to menu.h. src/term.c: Include "../lwlib/lwlib.h" before including menu.h. diff: === modified file 'src/term.c' --- src/term.c 2013-10-08 17:49:20 +0000 +++ src/term.c 2013-10-08 19:06:40 +0000 @@ -51,6 +51,10 @@ static int been_here = -1; #endif +#ifdef USE_X_TOOLKIT +#include "../lwlib/lwlib.h" +#endif + #include "cm.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" ------------------------------------------------------------ revno: 114583 fixes bug: http://debbugs.gnu.org/15557 committer: Eli Zaretskii branch nick: trunk timestamp: Tue 2013-10-08 21:42:25 +0300 message: Fix bug #15557 with spelling in the manual. ack.texi (Acknowledgments): Fix spelling of Hrvoje Nikֵ¡iִ‡'s name. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2013-10-08 17:49:20 +0000 +++ doc/emacs/ChangeLog 2013-10-08 18:42:25 +0000 @@ -1,5 +1,8 @@ 2013-10-08 Eli Zaretskii + * ack.texi (Acknowledgments): Fix spelling of Hrvoje Nikšić's + name. (Bug#15557) + Support menus on text-mode terminals. * screen.texi (Menu Bar): Adapt to TTY menus. === modified file 'doc/emacs/ack.texi' --- doc/emacs/ack.texi 2013-06-28 16:08:27 +0000 +++ doc/emacs/ack.texi 2013-10-08 18:42:25 +0000 @@ -884,7 +884,7 @@ the status of version-controlled directories. @item -Hrvoje Niksic wrote @file{savehist.el}, for saving the minibuffer +Hrvoje Nikšić wrote @file{savehist.el}, for saving the minibuffer history between Emacs sessions. @item ------------------------------------------------------------ revno: 114582 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Tue 2013-10-08 20:49:20 +0300 message: Support menus on text-mode terminals. src/xterm.h (xw_popup_dialog): Add prototype. src/xmenu.c (Fx_popup_dialog): Function moved to menu.c. (xmenu_show): Block input here, instead in Fx_popup_menu. (xw_popup_dialog): New function, with X-specific bits of popup dialogs. src/xdisp.c (deep_copy_glyph_row, display_tty_menu_item): New functions. src/window.c (Fset_window_configuration): Use run-time tests of the frame type instead of compile-time conditionals, when menu-bar lines are considered. src/w32term.h (w32con_hide_cursor, w32con_show_cursor) (w32_popup_dialog): New prototypes. src/w32menu.c (Fx_popup_dialog): Function deleted. (w32_popup_dialog): New function, with w32 specific bits of popup dialogs. Block input here. src/w32inevt.c (w32_console_read_socket): Minor change to add debugging TTY events. src/w32fns.c (show_hourglass): If returning early because the frame is not a GUI frame, unblock input. src/w32console.c (w32con_hide_cursor, w32con_show_cursor, cursorX) (cursorY): New functions. src/termhooks.h (cursorX, cursorY): Prototypes of functions on WINDOWSNT, macros that call curX and curY elsewhere. src/termchar.h (struct tty_display_info) : New flag. src/term.c (tty_hide_cursor, tty_show_cursor) [WINDOWSNT]: Call w32 specific function to hide and show cursor on a text-mode terminal. (tty_menu_struct, struct tty_menu_state): New structures. (tty_menu_create, tty_menu_make_room, tty_menu_search_pane) (tty_menu_calc_size, mouse_get_xy, tty_menu_display) (have_menus_p, tty_menu_add_pane, tty_menu_add_selection) (tty_menu_locate, save_and_enable_current_matrix) (restore_desired_matrix, screen_update, read_menu_input) (tty_menu_activate, tty_menu_destroy, tty_menu_help_callback) (tty_pop_down_menu, tty_menu_last_menubar_item) (tty_menu_new_item_coords, tty_menu_show): New functions. (syms_of_term): New DEFSYMs for tty-menu-* symbols. src/nsterm.h (ns_popup_dialog): Adjust prototype. src/nsmenu.m (ns_menu_show): Block and unblock input here, instead of in x-popup-menu. (ns_popup_dialog): Adapt order of arguments to the other *_menu_show implementations. (Fx_popup_dialog): Function deleted. src/msdos.c (x_set_menu_bar_lines): Delete unused function. src/menu.h (tty_menu_show, menu_item_width): provide prototypes. src/menu.c (have_boxes): New function. (single_keymap_panes): Use it instead of a compile-time conditional. (single_menu_item): Use run-time tests of the frame type instead of compile-time conditionals. (encode_menu_string): New function. (list_of_items, list_of_panes): Use it instead of ENCODE_STRING the macro, since different types of frame need different encoding of menu items. (digest_single_submenu): Use run-time tests of frame type instead of, or in addition to, compile-time conditionals. (menu_item_width, Fmenu_bar_menu_at_x_y): New functions. (Fx_popup_menu): Detect when the function is called from keyboard on a TTY. Don't barf when invoked on a text-mode frame. Check frame type at run time, instead of compile-time conditionals for invoking terminal-specific menu-show functions. Call tty_menu_show on text-mode frames. (Fx_popup_dialog): Moved here from xmenu.c. Test frame types at run time to determine which alternative to invoke; support dialogs on TTYs. src/keyboard.h : Declare. src/keyboard.c : Now extern. : New static variable. (read_key_sequence): Accept an additional argument, a flag to prevent redisplay during reading of the key sequence. All callers changed. (read_menu_command): New function. (read_char): When COMMANDFLAG is -2, do not redisplay and do not autosave. (toolkit_menubar_in_use): New function. (make_lispy_event): Use it instead of a compile-time test. src/fns.c (Fyes_or_no_p) [HAVE_MENUS]: Don't condition on window-system being available. src/editfns.c (Fmessage_box) [HAVE_MENUS]: Don't condition the call to x-popup-dialog on the frame type, they all now support popup dialogs. src/dispnew.c (save_current_matrix): Save the margin areas. (restore_current_matrix): Restore margin areas. (update_frame_with_menu): New function. src/dispextern.h (display_tty_menu_item, update_frame_with_menu): Add prototypes. src/alloc.c (make_save_ptr): Now compiled unconditionally. lisp/tmm.el (tmm-menubar): Adapt doc string to TTY menus functionality. lisp/tooltip.el (tooltip-mode): Don't error out on TTYs. lisp/menu-bar.el (popup-menu, popup-menu-normalize-position): Moved here from mouse.el. (popup-menu): Support menu-bar navigation on TTYs using C-f/C-b and arrow keys. (tty-menu-navigation-map): New map for TTY menu navigation. lisp/loadup.el ("tooltip"): Load even if x-show-tip is not available. lisp/frame.el (display-mouse-p): Report text-mode mouse as available on w32. (display-popup-menus-p): Report availability if mouse is available; don't condition on window-system. lisp/faces.el (tty-menu-enabled-face, tty-menu-disabled-face) (tty-menu-selected-face): New faces. configure.ac (HAVE_MENUS): Define unconditionally. doc/emacs/screen.texi (Menu Bar): Adapt to TTY menus. doc/emacs/frames.texi (Frames): Mention menu support on text terminals. doc/emacs/files.texi (Visiting): Mention the "File" menu-bar menu. doc/emacs/display.texi (Standard Faces): Mention TTY faces for menus. doc/lispref/keymaps.texi (Defining Menus, Mouse Menus, Menu Bar): Modify wording to the effect that menus are supported on TTYs. doc/lisprefframes.texi (Pop-Up Menus, Dialog Boxes) (Display Feature Testing): Update for menu support on TTYs. etc/NEWS: Mention the new features. diff: === modified file 'ChangeLog' --- ChangeLog 2013-10-08 05:12:29 +0000 +++ ChangeLog 2013-10-08 17:49:20 +0000 @@ -1,3 +1,7 @@ +2013-10-08 Eli Zaretskii + + * configure.ac (HAVE_MENUS): Define unconditionally. + 2013-10-07 Paul Eggert Improve support for popcount and counting trailing zeros (Bug#15550). === modified file 'configure.ac' --- configure.ac 2013-09-25 03:44:34 +0000 +++ configure.ac 2013-09-26 07:37:16 +0000 @@ -1898,11 +1898,8 @@ fi fi -### If we're using X11, we should use the X menu package. -HAVE_MENUS=no -case ${HAVE_X11} in - yes ) HAVE_MENUS=yes ;; -esac +### We always support menus. +HAVE_MENUS=yes # Does the opsystem file prohibit the use of the GNU malloc? # Assume not, until told otherwise. @@ -3183,15 +3180,9 @@ ## Extra CFLAGS applied to src/*.m files. GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE" fi - # We also have mouse menus. - HAVE_MENUS=yes OTHER_FILES=ns-app fi -if test "${HAVE_W32}" = "yes"; then - HAVE_MENUS=yes -fi - ### Use session management (-lSM -lICE) if available HAVE_X_SM=no LIBXSM= @@ -4672,9 +4663,7 @@ if test "${HAVE_MENUS}" = "yes" ; then AC_DEFINE(HAVE_MENUS, 1, - [Define to 1 if you have mouse menus. - (This is automatic if you use X, but the option to specify it remains.) - It is also defined with other window systems that support xmenu.c.]) + [Define to 1 if you have mouse menus. (This is supported in all configurations, but the option to specify it remains.)]) fi if test "${GNU_MALLOC}" = "yes" ; then === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2013-10-06 09:46:04 +0000 +++ doc/emacs/ChangeLog 2013-10-08 17:49:20 +0000 @@ -1,3 +1,14 @@ +2013-10-08 Eli Zaretskii + + Support menus on text-mode terminals. + * screen.texi (Menu Bar): Adapt to TTY menus. + + * frames.texi (Frames): Mention menu support on text terminals. + + * files.texi (Visiting): Mention the "File" menu-bar menu. + + * display.texi (Standard Faces): Mention TTY faces for menus. + 2013-10-06 Xue Fuqiao * cal-xtra.texi (Calendar Customizing, Diary Display): Remove @refill. === modified file 'doc/emacs/display.texi' --- doc/emacs/display.texi 2013-07-26 06:56:35 +0000 +++ doc/emacs/display.texi 2013-10-02 17:27:52 +0000 @@ -710,6 +710,17 @@ @cindex customization of @code{menu} face This face determines the colors and font of Emacs's menus. @xref{Menu Bars}. +@item tty-menu-enabled-face +@cindex faces for text-mode menus +@cindex TTY menu faces +This face is used to display enabled menu items on text-mode +terminals. +@item tty-menu-disabled-face +This face is used to display disabled menu items on text-mode +terminals. +@item tty-menu-selected-face +This face is used to display on text-mode terminals the menu item that +would be selected if you click a mouse or press @key{RET}. @end table @node Text Scale === modified file 'doc/emacs/files.texi' --- doc/emacs/files.texi 2013-08-14 10:45:10 +0000 +++ doc/emacs/files.texi 2013-10-02 17:27:52 +0000 @@ -286,6 +286,10 @@ moves or copies the file into the displayed directory. For details, see @ref{Drag and Drop}, and @ref{Misc Dired Features}. + On text-mode terminals and on graphical displays when Emacs was +built without a GUI toolkit, you can visit files via the menu-bar +``File'' menu, which has a ``Visit New File'' item. + Each time you visit a file, Emacs automatically scans its contents to detect what character encoding and end-of-line convention it uses, and converts these to Emacs's internal encoding and end-of-line === modified file 'doc/emacs/frames.texi' --- doc/emacs/frames.texi 2013-01-01 09:11:05 +0000 +++ doc/emacs/frames.texi 2013-10-02 17:27:52 +0000 @@ -39,7 +39,7 @@ @ifnottex @pxref{MS-DOS Mouse}, @end ifnottex -for doing so on MS-DOS). +for doing so on MS-DOS). Menus are supported on all text terminals. @menu * Mouse Commands:: Moving, cutting, and pasting, with the mouse. === modified file 'doc/emacs/screen.texi' --- doc/emacs/screen.texi 2013-01-01 09:11:05 +0000 +++ doc/emacs/screen.texi 2013-10-02 17:40:29 +0000 @@ -287,13 +287,12 @@ @kindex M-` @kindex F10 -@findex tmm-menubar @findex menu-bar-open - On a graphical display, you can use the mouse to choose a command -from the menu bar. An arrow on the right edge of a menu item means it -leads to a subsidiary menu, or @dfn{submenu}. A @samp{...} at the end -of a menu item means that the command will prompt you for further -input before it actually does anything. + On a display that support a mouse, you can use the mouse to choose a +command from the menu bar. An arrow on the right edge of a menu item +means it leads to a subsidiary menu, or @dfn{submenu}. A @samp{...} +at the end of a menu item means that the command will prompt you for +further input before it actually does anything. Some of the commands in the menu bar have ordinary key bindings as well; if so, a key binding is shown in parentheses after the item @@ -305,14 +304,20 @@ item by pressing @key{F10} (to run the command @code{menu-bar-open}). You can then navigate the menus with the arrow keys. To activate a selected menu item, press @key{RET}; to cancel menu navigation, press -@key{ESC}. +@kbd{C-g} or @kbd{ESC ESC ESC}. - On a text terminal, you can use the menu bar by typing @kbd{M-`} or -@key{F10} (these run the command @code{tmm-menubar}). This lets you -select a menu item with the keyboard. A provisional choice appears in -the echo area. You can use the up and down arrow keys to move through -the menu to different items, and then you can type @key{RET} to select -the item. Each menu item is also designated by a letter or digit -(usually the initial of some word in the item's name). This letter or -digit is separated from the item name by @samp{==>}. You can type the -item's letter or digit to select the item. +@findex tmm-menubar +@vindex tty-menu-open-use-tmm + On a text terminal, you can optionally access the menu-bar menus in +the echo area. To this end, customize the variable +@code{tty-menu-open-use-tmm} to a non-@code{nil} value. Then typing +@key{F10} will run the command @code{tmm-menubar} instead of dropping +down the menu. (You can also type @kbd{M-`}, which always invokes +@code{tmm-menubar}.) @code{tmm-menubar} lets you select a menu item +with the keyboard. A provisional choice appears in the echo area. +You can use the up and down arrow keys to move through the menu to +different items, and then you can type @key{RET} to select the item. +Each menu item is also designated by a letter or digit (usually the +initial of some word in the item's name). This letter or digit is +separated from the item name by @samp{==>}. You can type the item's +letter or digit to select the item. === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-10-07 03:46:32 +0000 +++ doc/lispref/ChangeLog 2013-10-08 17:49:20 +0000 @@ -1,3 +1,12 @@ +2013-10-08 Eli Zaretskii + + Support menus on text-mode terminals. + * keymaps.texi (Defining Menus, Mouse Menus, Menu Bar): Modify + wording to the effect that menus are supported on TTYs. + + * frames.texi (Pop-Up Menus, Dialog Boxes) + (Display Feature Testing): Update for menu support on TTYs. + 2013-10-07 Stefan Monnier * tips.texi (Comment Tips): Discourage use of triple semi-colons for === modified file 'doc/lispref/frames.texi' --- doc/lispref/frames.texi 2013-08-13 02:45:12 +0000 +++ doc/lispref/frames.texi 2013-10-03 19:10:34 +0000 @@ -1741,8 +1741,10 @@ @node Pop-Up Menus @section Pop-Up Menus - When using a window system, a Lisp program can pop up a menu so that -the user can choose an alternative with the mouse. + A Lisp program can pop up a menu so that the user can choose an +alternative with the mouse. On a text terminal, if the mouse is not +available, the user can choose an alternative using the keyboard +motion keys---@kbd{C-n}, @kbd{C-p}, or up- and down-arrow keys. @defun x-popup-menu position menu This function displays a pop-up menu and returns an indication of @@ -1763,20 +1765,22 @@ may be a window or a frame. If @var{position} is @code{t}, it means to use the current mouse -position. If @var{position} is @code{nil}, it means to precompute the -key binding equivalents for the keymaps specified in @var{menu}, -without actually displaying or popping up the menu. +position (or the top-left corner of the frame if the mouse is not +available on a text terminal). If @var{position} is @code{nil}, it +means to precompute the key binding equivalents for the keymaps +specified in @var{menu}, without actually displaying or popping up the +menu. The argument @var{menu} says what to display in the menu. It can be a keymap or a list of keymaps (@pxref{Menu Keymaps}). In this case, the return value is the list of events corresponding to the user's choice. This list has more than one element if the choice occurred in a submenu. (Note that @code{x-popup-menu} does not actually execute the -command bound to that sequence of events.) On toolkits that support -menu titles, the title is taken from the prompt string of @var{menu} -if @var{menu} is a keymap, or from the prompt string of the first -keymap in @var{menu} if it is a list of keymaps (@pxref{Defining -Menus}). +command bound to that sequence of events.) On text terminals and +toolkits that support menu titles, the title is taken from the prompt +string of @var{menu} if @var{menu} is a keymap, or from the prompt +string of the first keymap in @var{menu} if it is a list of keymaps +(@pxref{Defining Menus}). Alternatively, @var{menu} can have the following form: @@ -1800,7 +1804,7 @@ If the user gets rid of the menu without making a valid choice, for instance by clicking the mouse away from a valid choice or by typing -keyboard input, then this normally results in a quit and +@kbd{C-g}, then this normally results in a quit and @code{x-popup-menu} does not return. But if @var{position} is a mouse button event (indicating that the user invoked the menu with the mouse) then no quit occurs and @code{x-popup-menu} returns @code{nil}. @@ -1872,7 +1876,8 @@ If @var{header} is non-@code{nil}, the frame title for the box is @samp{Information}, otherwise it is @samp{Question}. The former is used -for @code{message-box} (@pxref{message-box}). +for @code{message-box} (@pxref{message-box}). (On text terminals, the +box title is not displayed.) In some configurations, Emacs cannot display a real dialog box; so instead it displays the same items in a pop-up menu in the center of the @@ -2284,9 +2289,9 @@ @defun display-popup-menus-p &optional display This function returns @code{t} if popup menus are supported on -@var{display}, @code{nil} if not. Support for popup menus requires that -the mouse be available, since the user cannot choose menu items without -a mouse. +@var{display}, @code{nil} if not. Support for popup menus requires +that the mouse be available, since the menu is popped up by clicking +the mouse on some portion of the Emacs display. @end defun @defun display-graphic-p &optional display === modified file 'doc/lispref/keymaps.texi' --- doc/lispref/keymaps.texi 2013-06-19 13:51:47 +0000 +++ doc/lispref/keymaps.texi 2013-10-03 19:10:34 +0000 @@ -2023,7 +2023,7 @@ the menu's commands. Emacs displays the overall prompt string as the menu title in some cases, depending on the toolkit (if any) used for displaying menus.@footnote{It is required for menus which do not use a -toolkit, e.g., under MS-DOS.} Keyboard menus also display the +toolkit, e.g., on a text terminal.} Keyboard menus also display the overall prompt string. The easiest way to construct a keymap with a prompt string is to @@ -2371,16 +2371,17 @@ items, the menu shows the contents of the nested keymap directly, not as a submenu. - However, if Emacs is compiled without X toolkit support, submenus -are not supported. Each nested keymap is shown as a menu item, but -clicking on it does not automatically pop up the submenu. If you wish -to imitate the effect of submenus, you can do that by giving a nested -keymap an item string which starts with @samp{@@}. This causes Emacs -to display the nested keymap using a separate @dfn{menu pane}; the -rest of the item string after the @samp{@@} is the pane label. If -Emacs is compiled without X toolkit support, menu panes are not used; -in that case, a @samp{@@} at the beginning of an item string is -omitted when the menu label is displayed, and has no other effect. + However, if Emacs is compiled without X toolkit support, or on text +terminals, submenus are not supported. Each nested keymap is shown as +a menu item, but clicking on it does not automatically pop up the +submenu. If you wish to imitate the effect of submenus, you can do +that by giving a nested keymap an item string which starts with +@samp{@@}. This causes Emacs to display the nested keymap using a +separate @dfn{menu pane}; the rest of the item string after the +@samp{@@} is the pane label. If Emacs is compiled without X toolkit +support, or if a menu is displayed on a text terminal, menu panes are +not used; in that case, a @samp{@@} at the beginning of an item string +is omitted when the menu label is displayed, and has no other effect. @node Keyboard Menus @subsection Menus and the Keyboard @@ -2485,10 +2486,10 @@ @subsection The Menu Bar @cindex menu bar - On graphical displays, there is usually a @dfn{menu bar} at the top -of each frame. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. Menu -bar items are subcommands of the fake ``function key'' -@code{menu-bar}, as defined in the active keymaps. + Emacs usually shows a @dfn{menu bar} at the top of each frame. +@xref{Menu Bars,,,emacs, The GNU Emacs Manual}. Menu bar items are +subcommands of the fake ``function key'' @code{menu-bar}, as defined +in the active keymaps. To add an item to the menu bar, invent a fake ``function key'' of your own (let's call it @var{key}), and make a binding for the key sequence @@ -2575,7 +2576,7 @@ A @dfn{tool bar} is a row of clickable icons at the top of a frame, just below the menu bar. @xref{Tool Bars,,,emacs, The GNU Emacs -Manual}. +Manual}. Emacs normally shows a tool bar on graphical displays. On each frame, the frame parameter @code{tool-bar-lines} controls how many lines' worth of height to reserve for the tool bar. A zero === modified file 'etc/NEWS' --- etc/NEWS 2013-10-08 06:17:49 +0000 +++ etc/NEWS 2013-10-08 17:49:20 +0000 @@ -65,6 +65,22 @@ * Changes in Emacs 24.4 ++++ +** Emacs now supports menus on text-mode terminals. +If the terminal supports a mouse, clicking on the menu bar, or on +sensitive portions of the mode line or header line, will drop down the +menu defined at that position. Likewise, clicking C-mouse-2 or +C-mouse-2 or C-mouse-3 on the text area will pop up the menus defined +for those locations. + +If the text terminal does not support a mouse, you can activate the +first menu-bar menu by typing F10, which invokes `menu-bar-open'. + +If you want the previous behavior, whereby F10 invoked `tmm-menubar', +customize the option `tty-menu-open-use-tmm' to a non-nil value. +(Typing M-` will always invoke `tmm-menubar', even if +`tty-menu-open-use-tmm' is nil.) + ** Key ? also describes prefix bindings like C-h. +++ @@ -653,6 +669,16 @@ * Lisp Changes in Emacs 24.4 ++++ +** Functions that pop up menus and dialogs now work on all terminal types, +including TTYs. +This includes `x-popup-menu', `x-popup-dialog', `message-box', +`yes-or-no-p', etc. + +The function `display-popup-menus-p' will now return non-nil for a +display or frame whenever a mouse is supported on that display or +frame. + ** New bool-vector set operation functions: *** `bool-vector-exclusive-or' *** `bool-vector-union' === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 14:57:18 +0000 +++ lisp/ChangeLog 2013-10-08 17:49:20 +0000 @@ -1,3 +1,27 @@ +2013-10-08 Eli Zaretskii + + Support menus on text-mode terminals. + * tmm.el (tmm-menubar): Adapt doc string to TTY menus + functionality. + + * tooltip.el (tooltip-mode): Don't error out on TTYs. + + * menu-bar.el (popup-menu, popup-menu-normalize-position): Moved + here from mouse.el. + (popup-menu): Support menu-bar navigation on TTYs using C-f/C-b + and arrow keys. + (tty-menu-navigation-map): New map for TTY menu navigation. + + * loadup.el ("tooltip"): Load even if x-show-tip is not available. + + * frame.el (display-mouse-p): Report text-mode mouse as available + on w32. + (display-popup-menus-p): Report availability if mouse is + available; don't condition on window-system. + + * faces.el (tty-menu-enabled-face, tty-menu-disabled-face) + (tty-menu-selected-face): New faces. + 2013-10-08 Stefan Monnier * emacs-lisp/lisp-mode.el: Font-lock cl-lib constructs. === modified file 'lisp/faces.el' --- lisp/faces.el 2013-09-28 10:01:50 +0000 +++ lisp/faces.el 2013-10-08 17:49:20 +0000 @@ -2142,7 +2142,6 @@ (frame-set-background-mode frame t) (face-set-after-frame-default frame))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Standard faces. @@ -2551,6 +2550,26 @@ :version "24.1" :group 'basic-faces) +;; Faces for TTY menus. +(defface tty-menu-enabled-face + '((t + :foreground "yellow" :background "blue" :weight bold)) + "Face for displaying enabled items in TTY menus." + :group 'basic-faces) + +(defface tty-menu-disabled-face + '((((class color) (min-colors 16)) + :foreground "lightgray" :background "blue") + (t + :foreground "white" :background "blue")) + "Face for displaying disabled items in TTY menus." + :group 'basic-faces) + +(defface tty-menu-selected-face + '((t :background "red")) + "Face for displaying the currently selected item in TTY menus." + :group 'basic-faces) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names. === modified file 'lisp/frame.el' --- lisp/frame.el 2013-09-18 03:58:26 +0000 +++ lisp/frame.el 2013-10-02 18:44:40 +0000 @@ -1304,17 +1304,17 @@ xterm-mouse-mode) ;; t-mouse is distributed with the GPM package. It doesn't have ;; a toggle. - (featurep 't-mouse)))))) + (featurep 't-mouse) + ;; No way to check whether a w32 console has a mouse, assume + ;; it always does. + (boundp 'w32-use-full-screen-buffer)))))) (defun display-popup-menus-p (&optional display) "Return non-nil if popup menus are supported on DISPLAY. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display). Support for popup menus requires that the mouse be available." - (and - (let ((frame-type (framep-on-display display))) - (memq frame-type '(x w32 pc ns))) - (display-mouse-p display))) + (display-mouse-p display)) (defun display-graphic-p (&optional display) "Return non-nil if DISPLAY is a graphic display. === modified file 'lisp/loadup.el' --- lisp/loadup.el 2013-08-05 18:05:46 +0000 +++ lisp/loadup.el 2013-10-08 15:11:29 +0000 @@ -276,7 +276,7 @@ (load "vc/vc-hooks") (load "vc/ediff-hook") -(if (fboundp 'x-show-tip) (load "tooltip")) +(if (not (eq system-type 'ms-dos)) (load "tooltip")) ;If you want additional libraries to be preloaded and their ;doc strings kept in the DOC file rather than in core, === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2013-08-16 06:50:58 +0000 +++ lisp/menu-bar.el 2013-10-08 15:11:29 +0000 @@ -2182,13 +2182,211 @@ (declare-function x-menu-bar-open "term/x-win" (&optional frame)) (declare-function w32-menu-bar-open "term/w32-win" (&optional frame)) +(defun popup-menu (menu &optional position prefix from-menu-bar) + "Popup the given menu and call the selected option. +MENU can be a keymap, an easymenu-style menu or a list of keymaps as for +`x-popup-menu'. +The menu is shown at the place where POSITION specifies. About +the form of POSITION, see `popup-menu-normalize-position'. +PREFIX is the prefix argument (if any) to pass to the command. +FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." + (let* ((map (cond + ((keymapp menu) menu) + ((and (listp menu) (keymapp (car menu))) menu) + (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu))) + (filter (when (symbolp map) + (plist-get (get map 'menu-prop) :filter)))) + (if filter (funcall filter (symbol-function map)) map))))) + (frame (selected-frame)) + event cmd) + (if from-menu-bar + (let* ((xy (posn-x-y position)) + (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy)))) + (setq position (list menu-symbol (list frame '(menu-bar) + xy 0)))) + (setq position (popup-menu-normalize-position position))) + ;; The looping behavior was taken from lmenu's popup-menu-popup + (while (and map (setq event + ;; map could be a prefix key, in which case + ;; we need to get its function cell + ;; definition. + (x-popup-menu position (indirect-function map)))) + ;; Strangely x-popup-menu returns a list. + ;; mouse-major-mode-menu was using a weird: + ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events))) + (setq cmd + (cond + ((and from-menu-bar + (consp event) + (numberp (car event)) + (numberp (cdr event))) + (let ((x (car event)) + (y (cdr event)) + menu-symbol) + (setq menu-symbol (menu-bar-menu-at-x-y x y)) + (setq position (list menu-symbol (list frame '(menu-bar) + event 0))) + (setq map + (or + (lookup-key global-map (vector 'menu-bar menu-symbol)) + (lookup-key (current-local-map) (vector 'menu-bar + menu-symbol)))))) + ((and (not (keymapp map)) (listp map)) + ;; We were given a list of keymaps. Search them all + ;; in sequence until a first binding is found. + (let ((mouse-click (apply 'vector event)) + binding) + (while (and map (null binding)) + (setq binding (lookup-key (car map) mouse-click)) + (if (numberp binding) ; `too long' + (setq binding nil)) + (setq map (cdr map))) + binding)) + (t + ;; We were given a single keymap. + (lookup-key map (apply 'vector event))))) + ;; Clear out echoing, which perhaps shows a prefix arg. + (message "") + ;; Maybe try again but with the submap. + (setq map (if (keymapp cmd) cmd))) + ;; If the user did not cancel by refusing to select, + ;; and if the result is a command, run it. + (when (and (null map) (commandp cmd)) + (setq prefix-arg prefix) + ;; `setup-specified-language-environment', for instance, + ;; expects this to be set from a menu keymap. + (setq last-command-event (car (last event))) + ;; mouse-major-mode-menu was using `command-execute' instead. + (call-interactively cmd)))) + +(defun popup-menu-normalize-position (position) + "Convert the POSITION to the form which `popup-menu' expects internally. +POSITION can an event, a posn- value, a value having +form ((XOFFSET YOFFSET) WINDOW), or nil. +If nil, the current mouse position is used." + (pcase position + ;; nil -> mouse cursor position + (`nil + (let ((mp (mouse-pixel-position))) + (list (list (cadr mp) (cddr mp)) (car mp)))) + ;; Value returned from `event-end' or `posn-at-point'. + ((pred posnp) + (let ((xy (posn-x-y position))) + (list (list (car xy) (cdr xy)) + (posn-window position)))) + ;; Event. + ((pred eventp) + (popup-menu-normalize-position (event-end position))) + (t position))) + +(defvar tty-menu-navigation-map + (let ((map (make-sparse-keymap))) + ;; The next line is disabled because it breaks interpretation of + ;; escape sequences, produced by TTY arrow keys, as tty-menu-* + ;; commands. Instead, we explicitly bind some keys to + ;; tty-menu-exit. + ;;(define-key map [t] 'tty-menu-exit) + + ;; The tty-menu-* are just symbols interpreted by term.c, they are + ;; not real commands. + (substitute-key-definition 'keyboard-quit 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition 'keyboard-escape-quit 'tty-menu-exit + map (current-global-map)) + ;; The bindings of menu-bar items are so that clicking on the menu + ;; bar when a menu is already shown pops down that menu. + ;; FIXME: we should iterate over all the visible menu-bar items, + ;; instead of naming them explicitly here. Also, this doesn't + ;; include items added by current major mode. + (substitute-key-definition (lookup-key (current-global-map) [menu-bar file]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition (lookup-key (current-global-map) [menu-bar edit]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition (lookup-key (current-global-map) [menu-bar options]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition (lookup-key (current-global-map) [menu-bar buffer]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition (lookup-key (current-global-map) [menu-bar tools]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition (lookup-key (current-global-map) [menu-bar help-menu]) + 'tty-menu-exit + map (current-global-map)) + (substitute-key-definition 'forward-char 'tty-menu-next-menu + map (current-global-map)) + (substitute-key-definition 'backward-char 'tty-menu-prev-menu + map (current-global-map)) + ;; The following two will need to be revised if we ever support + ;; a right-to-left menu bar. + (substitute-key-definition 'right-char 'tty-menu-next-menu + map (current-global-map)) + (substitute-key-definition 'left-char 'tty-menu-prev-menu + map (current-global-map)) + (substitute-key-definition 'next-line 'tty-menu-next-item + map (current-global-map)) + (substitute-key-definition 'previous-line 'tty-menu-prev-item + map (current-global-map)) + (substitute-key-definition 'newline 'tty-menu-select + map (current-global-map)) + (substitute-key-definition 'newline-and-indent 'tty-menu-select + map (current-global-map)) + (define-key map [?\C-r] 'tty-menu-select) + (define-key map [?\C-j] 'tty-menu-select) + (define-key map [return] 'tty-menu-select) + (define-key map [linefeed] 'tty-menu-select) + (define-key map [down-mouse-1] 'tty-menu-select) + (define-key map [drag-mouse-1] 'tty-menu-select) + (define-key map [mode-line drag-mouse-1] 'tty-menu-select) + (define-key map [mode-line down-mouse-1] 'tty-menu-select) + (define-key map [header-line mouse-1] 'tty-menu-select) + (define-key map [header-line drag-mouse-1] 'tty-menu-select) + (define-key map [header-line down-mouse-1] 'tty-menu-select) + (define-key map [mode-line mouse-1] 'tty-menu-ignore) + (define-key map [mode-line mouse-2] 'tty-menu-ignore) + (define-key map [mode-line mouse-3] 'tty-menu-ignore) + (define-key map [mode-line C-mouse-1] 'tty-menu-ignore) + (define-key map [mode-line C-mouse-2] 'tty-menu-ignore) + (define-key map [mode-line C-mouse-3] 'tty-menu-ignore) + ;; The mouse events must be bound to tty-menu-ignore, otherwise + ;; the initial mouse click will select and immediately pop down + ;; the menu. + (define-key map [mouse-1] 'tty-menu-ignore) + (define-key map [C-mouse-1] 'tty-menu-ignore) + (define-key map [C-mouse-2] 'tty-menu-ignore) + (define-key map [C-mouse-3] 'tty-menu-ignore) + (define-key map [mouse-movement] 'tty-menu-mouse-movement) + map) + "Keymap used while processing TTY menus.") + + +(defcustom tty-menu-open-use-tmm nil + "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'. + +If nil, \\[menu-bar-open] will drop down the menu corresponding to the +first (leftmost) menu-bar item; you can select other items by typing +\\[forward-char], \\[backward-char], \\[right-char] and \\[left-char]." + :type '(choice (const :tag "F10 drops down TTY menus" nil) + (const :tag "F10 invokes tmm-menubar" t)) + :group 'display + :version "24.4") + +(defvar tty-menu--initial-menu-x 1 + "X coordinate of the first menu-bar menu dropped by F10. + +This is meant to be used only for debugging TTY menus.") + (defun menu-bar-open (&optional frame) "Start key navigation of the menu bar in FRAME. This function decides which method to use to access the menu depending on FRAME's terminal device. On X displays, it calls -`x-menu-bar-open'; on Windows, `w32-menu-bar-open' otherwise it -calls `tmm-menubar'. +`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; otherwise it +calls either `popup-menu' or `tmm-menubar' depending on whether +\`tty-menu-open-use-tmm' is nil or not. If FRAME is nil or not given, use the selected frame." (interactive) @@ -2196,6 +2394,13 @@ (cond ((eq type 'x) (x-menu-bar-open frame)) ((eq type 'w32) (w32-menu-bar-open frame)) + ((null tty-menu-open-use-tmm) + (let* ((x tty-menu--initial-menu-x) + (menu (menu-bar-menu-at-x-y x 0 frame))) + (popup-menu (or + (lookup-key global-map (vector 'menu-bar menu)) + (lookup-key (current-local-map) (vector 'menu-bar menu))) + (posn-at-x-y x 0 nil t) nil t))) (t (with-selected-frame (or frame (selected-frame)) (tmm-menubar)))))) === modified file 'lisp/mouse.el' --- lisp/mouse.el 2013-09-18 04:21:29 +0000 +++ lisp/mouse.el 2013-09-26 07:37:16 +0000 @@ -144,79 +144,6 @@ ;; Provide a mode-specific menu on a mouse button. -(defun popup-menu (menu &optional position prefix) - "Popup the given menu and call the selected option. -MENU can be a keymap, an easymenu-style menu or a list of keymaps as for -`x-popup-menu'. -The menu is shown at the place where POSITION specifies. About -the form of POSITION, see `popup-menu-normalize-position'. -PREFIX is the prefix argument (if any) to pass to the command." - (let* ((map (cond - ((keymapp menu) menu) - ((and (listp menu) (keymapp (car menu))) menu) - (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu))) - (filter (when (symbolp map) - (plist-get (get map 'menu-prop) :filter)))) - (if filter (funcall filter (symbol-function map)) map))))) - event cmd - (position (popup-menu-normalize-position position))) - ;; The looping behavior was taken from lmenu's popup-menu-popup - (while (and map (setq event - ;; map could be a prefix key, in which case - ;; we need to get its function cell - ;; definition. - (x-popup-menu position (indirect-function map)))) - ;; Strangely x-popup-menu returns a list. - ;; mouse-major-mode-menu was using a weird: - ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events))) - (setq cmd - (if (and (not (keymapp map)) (listp map)) - ;; We were given a list of keymaps. Search them all - ;; in sequence until a first binding is found. - (let ((mouse-click (apply 'vector event)) - binding) - (while (and map (null binding)) - (setq binding (lookup-key (car map) mouse-click)) - (if (numberp binding) ; `too long' - (setq binding nil)) - (setq map (cdr map))) - binding) - ;; We were given a single keymap. - (lookup-key map (apply 'vector event)))) - ;; Clear out echoing, which perhaps shows a prefix arg. - (message "") - ;; Maybe try again but with the submap. - (setq map (if (keymapp cmd) cmd))) - ;; If the user did not cancel by refusing to select, - ;; and if the result is a command, run it. - (when (and (null map) (commandp cmd)) - (setq prefix-arg prefix) - ;; `setup-specified-language-environment', for instance, - ;; expects this to be set from a menu keymap. - (setq last-command-event (car (last event))) - ;; mouse-major-mode-menu was using `command-execute' instead. - (call-interactively cmd)))) - -(defun popup-menu-normalize-position (position) - "Convert the POSITION to the form which `popup-menu' expects internally. -POSITION can an event, a posn- value, a value having -form ((XOFFSET YOFFSET) WINDOW), or nil. -If nil, the current mouse position is used." - (pcase position - ;; nil -> mouse cursor position - (`nil - (let ((mp (mouse-pixel-position))) - (list (list (cadr mp) (cddr mp)) (car mp)))) - ;; Value returned from `event-end' or `posn-at-point'. - ((pred posnp) - (let ((xy (posn-x-y position))) - (list (list (car xy) (cdr xy)) - (posn-window position)))) - ;; Event. - ((pred eventp) - (popup-menu-normalize-position (event-end position))) - (t position))) - (defun minor-mode-menu-from-indicator (indicator) "Show menu for minor mode specified by INDICATOR. Interactively, INDICATOR is read using completion. === modified file 'lisp/tmm.el' --- lisp/tmm.el 2013-02-13 13:40:00 +0000 +++ lisp/tmm.el 2013-10-08 09:01:26 +0000 @@ -50,7 +50,11 @@ "Text-mode emulation of looking and choosing from a menubar. See the documentation for `tmm-prompt'. X-POSITION, if non-nil, specifies a horizontal position within the menu bar; -we make that menu bar item (the one at that position) the default choice." +we make that menu bar item (the one at that position) the default choice. + +Note that \\[menu-bar-open] by default drops down TTY menus; if you want it +to invoke `tmm-menubar' instead, customize the variable +\`tty-menu-open-use-tmm' to a non-nil value." (interactive) (run-hooks 'menu-bar-update-hook) ;; Obey menu-bar-final-items; put those items last. === modified file 'lisp/tooltip.el' --- lisp/tooltip.el 2013-05-24 06:50:22 +0000 +++ lisp/tooltip.el 2013-10-08 15:11:29 +0000 @@ -58,9 +58,7 @@ :init-value t :initialize 'custom-initialize-delay :group 'tooltip - (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) - (error "Sorry, tooltips are not yet available on this system")) - (if tooltip-mode + (if (and tooltip-mode (fboundp 'x-show-tip)) (progn (add-hook 'pre-command-hook 'tooltip-hide) (add-hook 'tooltip-functions 'tooltip-help-tips)) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 14:56:15 +0000 +++ src/ChangeLog 2013-10-08 17:49:20 +0000 @@ -1,3 +1,116 @@ +2013-10-08 Eli Zaretskii + + Support menus on text-mode terminals. + * xterm.h (xw_popup_dialog): Add prototype. + + * xmenu.c (Fx_popup_dialog): Function moved to menu.c. + (xmenu_show): Block input here, instead in Fx_popup_menu. + (xw_popup_dialog): New function, with X-specific bits of popup + dialogs. + + * xdisp.c (deep_copy_glyph_row, display_tty_menu_item): New + functions. + + * window.c (Fset_window_configuration): Use run-time tests of the + frame type instead of compile-time conditionals, when menu-bar + lines are considered. + + * w32term.h (w32con_hide_cursor, w32con_show_cursor) + (w32_popup_dialog): New prototypes. + + * w32menu.c (Fx_popup_dialog): Function deleted. + (w32_popup_dialog): New function, with w32 specific bits of popup + dialogs. Block input here. + + * w32inevt.c (w32_console_read_socket): Minor change to add + debugging TTY events. + + * w32fns.c (show_hourglass): If returning early because the frame + is not a GUI frame, unblock input. + + * w32console.c (w32con_hide_cursor, w32con_show_cursor, cursorX) + (cursorY): New functions. + + * termhooks.h (cursorX, cursorY): Prototypes of functions on + WINDOWSNT, macros that call curX and curY elsewhere. + + * termchar.h (struct tty_display_info) : New flag. + + * term.c (tty_hide_cursor, tty_show_cursor) [WINDOWSNT]: Call w32 + specific function to hide and show cursor on a text-mode terminal. + (tty_menu_struct, struct tty_menu_state): New structures. + (tty_menu_create, tty_menu_make_room, tty_menu_search_pane) + (tty_menu_calc_size, mouse_get_xy, tty_menu_display) + (have_menus_p, tty_menu_add_pane, tty_menu_add_selection) + (tty_menu_locate, save_and_enable_current_matrix) + (restore_desired_matrix, screen_update, read_menu_input) + (tty_menu_activate, tty_menu_destroy, tty_menu_help_callback) + (tty_pop_down_menu, tty_menu_last_menubar_item) + (tty_menu_new_item_coords, tty_menu_show): New functions. + (syms_of_term): New DEFSYMs for tty-menu-* symbols. + + * nsterm.h (ns_popup_dialog): Adjust prototype. + + * nsmenu.m (ns_menu_show): Block and unblock input here, instead + of in x-popup-menu. + (ns_popup_dialog): Adapt order of arguments to the other + *_menu_show implementations. + (Fx_popup_dialog): Function deleted. + + * msdos.c (x_set_menu_bar_lines): Delete unused function. + + * menu.h (tty_menu_show, menu_item_width): provide prototypes. + + * menu.c (have_boxes): New function. + (single_keymap_panes): Use it instead of a compile-time + conditional. + (single_menu_item): Use run-time tests of the frame type instead + of compile-time conditionals. + (encode_menu_string): New function. + (list_of_items, list_of_panes): Use it instead of ENCODE_STRING + the macro, since different types of frame need different encoding + of menu items. + (digest_single_submenu): Use run-time tests of frame type instead + of, or in addition to, compile-time conditionals. + (menu_item_width, Fmenu_bar_menu_at_x_y): New functions. + (Fx_popup_menu): Detect when the function is called from keyboard + on a TTY. Don't barf when invoked on a text-mode frame. Check + frame type at run time, instead of compile-time conditionals for + invoking terminal-specific menu-show functions. Call + tty_menu_show on text-mode frames. + (Fx_popup_dialog): Moved here from xmenu.c. Test frame types at + run time to determine which alternative to invoke; support dialogs + on TTYs. + + * keyboard.h : Declare. + + * keyboard.c : Now extern. + : New static variable. + (read_key_sequence): Accept an additional argument, a flag to + prevent redisplay during reading of the key sequence. All callers + changed. + (read_menu_command): New function. + (read_char): When COMMANDFLAG is -2, do not redisplay and do not + autosave. + (toolkit_menubar_in_use): New function. + (make_lispy_event): Use it instead of a compile-time test. + + * fns.c (Fyes_or_no_p) [HAVE_MENUS]: Don't condition on + window-system being available. + + * editfns.c (Fmessage_box) [HAVE_MENUS]: Don't condition the call + to x-popup-dialog on the frame type, they all now support popup + dialogs. + + * dispnew.c (save_current_matrix): Save the margin areas. + (restore_current_matrix): Restore margin areas. + (update_frame_with_menu): New function. + + * dispextern.h (display_tty_menu_item, update_frame_with_menu): + Add prototypes. + + * alloc.c (make_save_ptr): Now compiled unconditionally. + 2013-10-08 Dmitry Antipov * dispnew.c (set_window_update_flags): Add buffer arg. Adjust comment. === modified file 'src/alloc.c' --- src/alloc.c 2013-10-08 04:25:33 +0000 +++ src/alloc.c 2013-10-08 17:49:20 +0000 @@ -3408,7 +3408,6 @@ return val; } -#if defined HAVE_NS || defined HAVE_NTGUI Lisp_Object make_save_ptr (void *a) { @@ -3418,7 +3417,6 @@ p->data[0].pointer = a; return val; } -#endif Lisp_Object make_save_ptr_int (void *a, ptrdiff_t b) === modified file 'src/cm.h' --- src/cm.h 2013-01-01 09:11:05 +0000 +++ src/cm.h 2013-09-05 11:00:55 +0000 @@ -139,7 +139,7 @@ #define MultiDownCost(tty) (tty)->Wcm->cc_multidown #define MultiLeftCost(tty) (tty)->Wcm->cc_multileft #define MultiRightCost(tty) (tty)->Wcm->cc_multiright -#endif +#endif /* NoCMShortHand */ #define cmat(tty,row,col) (curY(tty) = (row), curX(tty) = (col)) #define cmplus(tty,n) \ === modified file 'src/dispextern.h' --- src/dispextern.h 2013-10-08 14:56:15 +0000 +++ src/dispextern.h 2013-10-08 17:49:20 +0000 @@ -3256,6 +3256,7 @@ extern int cursor_in_mouse_face_p (struct window *w); extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *, int, int, enum draw_glyphs_face); +extern void display_tty_menu_item (const char *, int, int, int, int, int); /* Flags passed to try_window. */ #define TRY_WINDOW_CHECK_MARGINS (1 << 0) @@ -3427,6 +3428,8 @@ int popup_activated (void); +/* Defined in dispnew.c */ + extern Lisp_Object buffer_posn_from_coords (struct window *, int *, int *, struct display_pos *, @@ -3442,6 +3445,7 @@ int *, int *, int *, int *); extern void redraw_frame (struct frame *); extern bool update_frame (struct frame *, bool, bool); +extern void update_frame_with_menu (struct frame *); extern void bitch_at_user (void); extern void adjust_frame_glyphs (struct frame *); void free_glyphs (struct frame *); @@ -3467,7 +3471,7 @@ void init_display (void); void syms_of_display (void); extern Lisp_Object Qredisplay_dont_pause; -void spec_glyph_lookup_face (struct window *, GLYPH *); +extern void spec_glyph_lookup_face (struct window *, GLYPH *); /* Defined in terminal.c */ === modified file 'src/dispnew.c' --- src/dispnew.c 2013-10-08 14:56:15 +0000 +++ src/dispnew.c 2013-10-08 17:49:20 +0000 @@ -1844,9 +1844,28 @@ struct glyph_row *from = f->current_matrix->rows + i; struct glyph_row *to = saved->rows + i; ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph); + to->glyphs[TEXT_AREA] = xmalloc (nbytes); memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes); to->used[TEXT_AREA] = from->used[TEXT_AREA]; + to->enabled_p = from->enabled_p; + to->hash = from->hash; + if (from->used[LEFT_MARGIN_AREA]) + { + nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); + to->glyphs[LEFT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + memcpy (to->glyphs[LEFT_MARGIN_AREA], + from->glyphs[LEFT_MARGIN_AREA], nbytes); + to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; + } + if (from->used[RIGHT_MARGIN_AREA]) + { + nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); + to->glyphs[RIGHT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + memcpy (to->glyphs[RIGHT_MARGIN_AREA], + from->glyphs[RIGHT_MARGIN_AREA], nbytes); + to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; + } } return saved; @@ -1866,9 +1885,30 @@ struct glyph_row *from = saved->rows + i; struct glyph_row *to = f->current_matrix->rows + i; ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph); + memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes); to->used[TEXT_AREA] = from->used[TEXT_AREA]; xfree (from->glyphs[TEXT_AREA]); + nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); + if (nbytes) + { + memcpy (to->glyphs[LEFT_MARGIN_AREA], + from->glyphs[LEFT_MARGIN_AREA], nbytes); + to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; + xfree (from->glyphs[LEFT_MARGIN_AREA]); + } + else + to->used[LEFT_MARGIN_AREA] = 0; + nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); + if (nbytes) + { + memcpy (to->glyphs[RIGHT_MARGIN_AREA], + from->glyphs[RIGHT_MARGIN_AREA], nbytes); + to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; + xfree (from->glyphs[RIGHT_MARGIN_AREA]); + } + else + to->used[RIGHT_MARGIN_AREA] = 0; } xfree (saved->rows); @@ -3047,6 +3087,47 @@ return paused_p; } +/* Update a TTY frame F that has a menu dropped down over some of its + glyphs. This is like the second part of update_frame, but it + doesn't call build_frame_matrix, because we already have the + desired matrix prepared, and don't want it to be overwritten by the + text of the normal display. */ +void +update_frame_with_menu (struct frame *f) +{ + struct window *root_window = XWINDOW (f->root_window); + bool paused_p; + + eassert (FRAME_TERMCAP_P (f)); + + /* We are working on frame matrix basis. Set the frame on whose + frame matrix we operate. */ + set_frame_matrix_frame (f); + + /* Update the display */ + update_begin (f); + /* Force update_frame_1 not to stop due to pending input, and not + try scrolling. */ + paused_p = update_frame_1 (f, 1, 1); + update_end (f); + + if (FRAME_TTY (f)->termscript) + fflush (FRAME_TTY (f)->termscript); + fflush (FRAME_TTY (f)->output); + /* Check window matrices for lost pointers. */ +#if GLYPH_DEBUG +#if 0 + /* We cannot possibly survive the matrix pointers check, since + we have overwritten parts of the frame glyph matrix without + making any updates to the window matrices. */ + check_window_matrix_pointers (root_window); +#endif + add_frame_display_history (f, paused_p); +#endif + + /* Reset flags indicating that a window should be updated. */ + set_window_update_flags (root_window, NULL, 0); +} /************************************************************************ === modified file 'src/editfns.c' --- src/editfns.c 2013-10-05 15:06:17 +0000 +++ src/editfns.c 2013-10-08 17:49:20 +0000 @@ -3472,22 +3472,17 @@ { Lisp_Object val = Fformat (nargs, args); #ifdef HAVE_MENUS - /* The MS-DOS frames support popup menus even though they are - not FRAME_WINDOW_P. */ - if (FRAME_WINDOW_P (XFRAME (selected_frame)) - || FRAME_MSDOS_P (XFRAME (selected_frame))) - { - Lisp_Object pane, menu; - struct gcpro gcpro1; - pane = list1 (Fcons (build_string ("OK"), Qt)); - GCPRO1 (pane); - menu = Fcons (val, pane); - Fx_popup_dialog (Qt, menu, Qt); - UNGCPRO; - return val; - } -#endif /* HAVE_MENUS */ + Lisp_Object pane, menu; + struct gcpro gcpro1; + + pane = list1 (Fcons (build_string ("OK"), Qt)); + GCPRO1 (pane); + menu = Fcons (val, pane); + Fx_popup_dialog (Qt, menu, Qt); + UNGCPRO; +#else /* !HAVE_MENUS */ message3 (val); +#endif return val; } } === modified file 'src/fns.c' --- src/fns.c 2013-09-24 06:43:20 +0000 +++ src/fns.c 2013-09-29 18:50:28 +0000 @@ -2434,8 +2434,8 @@ The user must confirm the answer with RET, and can edit it until it has been confirmed. -Under a windowing system a dialog box will be used if `last-nonmenu-event' -is nil, and `use-dialog-box' is non-nil. */) +If dialog boxes are supported, a dialog box will be used +if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) (Lisp_Object prompt) { register Lisp_Object ans; @@ -2446,8 +2446,7 @@ #ifdef HAVE_MENUS if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && window_system_available (SELECTED_FRAME ())) + && use_dialog_box) { Lisp_Object pane, menu, obj; redisplay_preserve_echo_area (4); === modified file 'src/frame.h' --- src/frame.h 2013-10-02 15:38:12 +0000 +++ src/frame.h 2013-10-08 17:49:20 +0000 @@ -1248,9 +1248,6 @@ Lisp_Object oldval); extern void x_activate_menubar (struct frame *); extern void x_real_positions (struct frame *, int *, int *); -extern void x_set_menu_bar_lines (struct frame *, - Lisp_Object, - Lisp_Object); extern void free_frame_menubar (struct frame *); extern void x_free_frame_resources (struct frame *); === modified file 'src/keyboard.c' --- src/keyboard.c 2013-10-08 05:13:21 +0000 +++ src/keyboard.c 2013-10-08 17:49:20 +0000 @@ -289,7 +289,7 @@ at inopportune times. */ /* Symbols to head events. */ -static Lisp_Object Qmouse_movement; +Lisp_Object Qmouse_movement; static Lisp_Object Qscroll_bar_movement; Lisp_Object Qswitch_frame; static Lisp_Object Qfocus_in, Qfocus_out; @@ -354,6 +354,8 @@ static Lisp_Object Qvertical_scroll_bar; Lisp_Object Qmenu_bar; +static Lisp_Object Qecho_keystrokes; + static void recursive_edit_unwind (Lisp_Object buffer); static Lisp_Object command_loop (void); static Lisp_Object Qcommand_execute; @@ -1305,7 +1307,7 @@ sans error-handling encapsulation. */ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, - bool, bool, bool); + bool, bool, bool, bool); void safe_run_hooks (Lisp_Object); static void adjust_point_for_property (ptrdiff_t, bool); @@ -1431,7 +1433,7 @@ /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0], - Qnil, 0, 1, 1); + Qnil, 0, 1, 1, 0); /* A filter may have run while we were reading the input. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) @@ -1691,6 +1693,31 @@ } } +Lisp_Object +read_menu_command (void) +{ + Lisp_Object cmd; + Lisp_Object keybuf[30]; + ptrdiff_t count = SPECPDL_INDEX (); + int i; + + /* We don't want to echo the keystrokes while navigating the + menus. */ + specbind (Qecho_keystrokes, make_number (0)); + + i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0], + Qnil, 0, 1, 1, 1); + + unbind_to (count, Qnil); + + if (! FRAME_LIVE_P (XFRAME (selected_frame))) + Fkill_emacs (Qnil); + if (i == 0 || i == -1) + return Qt; + + return read_key_sequence_cmd; +} + /* Adjust point to a boundary of a region that has such a property that should be treated intangible. For the moment, we check `composition', `display' and `invisible' properties. @@ -2358,6 +2385,7 @@ /* Read a character from the keyboard; call the redisplay if needed. */ /* commandflag 0 means do not autosave, but do redisplay. -1 means do not redisplay, but do autosave. + -2 means do neither. 1 means do both. */ /* The arguments MAP is for menu prompting. MAP is a keymap. @@ -2722,7 +2750,7 @@ /* Maybe auto save due to number of keystrokes. */ - if (commandflag != 0 + if (commandflag != 0 && commandflag != -2 && auto_save_interval > 0 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20) && !detect_input_pending_run_timers (0)) @@ -2774,7 +2802,7 @@ 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */ /* Auto save if enough time goes by without input. */ - if (commandflag != 0 + if (commandflag != 0 && commandflag != -2 && num_nonmacro_input_events > last_auto_save && INTEGERP (Vauto_save_timeout) && XINT (Vauto_save_timeout) > 0) @@ -3870,7 +3898,22 @@ } } else - wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0); + { + bool do_display = true; + + if (FRAME_TERMCAP_P (SELECTED_FRAME ())) + { + struct tty_display_info *tty = CURTTY (); + + /* When this TTY is displaying a menu, we must prevent + any redisplay, because we modify the frame's glyph + matrix behind the back of the display engine. */ + if (tty->showing_menu) + do_display = false; + } + + wait_reading_process_output (0, 0, -1, do_display, Qnil, NULL, 0); + } if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr) gobble_input (); @@ -5363,6 +5406,20 @@ extra_info)))); } +/* Return non-zero if F is a GUI frame that uses some toolkit-managed + menu bar. This really means that Emacs draws and manages the menu + bar as part of its normal display, and therefore can compute its + geometry. */ +static bool +toolkit_menubar_in_use (struct frame *f) +{ +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) + return !(!FRAME_WINDOW_P (f)); +#else + return false; +#endif +} + /* Given a struct input_event, build the lisp event which represents it. If EVENT is 0, build a mouse movement event from the mouse movement buffer, which should have a movement event in it. @@ -5514,64 +5571,64 @@ if (event->kind == MOUSE_CLICK_EVENT) { struct frame *f = XFRAME (event->frame_or_window); -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS) int row, column; -#endif /* Ignore mouse events that were made on frame that have been deleted. */ if (! FRAME_LIVE_P (f)) return Qnil; -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS) /* EVENT->x and EVENT->y are frame-relative pixel coordinates at this place. Under old redisplay, COLUMN and ROW are set to frame relative glyph coordinates which are then used to determine whether this click is in a menu (non-toolkit version). */ - pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), - &column, &row, NULL, 1); - - /* In the non-toolkit version, clicks on the menu bar - are ordinary button events in the event buffer. - Distinguish them, and invoke the menu. - - (In the toolkit version, the toolkit handles the menu bar - and Emacs doesn't know about it until after the user - makes a selection.) */ - if (row >= 0 && row < FRAME_MENU_BAR_LINES (f) - && (event->modifiers & down_modifier)) + if (!toolkit_menubar_in_use (f)) { - Lisp_Object items, item; - - /* Find the menu bar item under `column'. */ - item = Qnil; - items = FRAME_MENU_BAR_ITEMS (f); - for (i = 0; i < ASIZE (items); i += 4) + pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), + &column, &row, NULL, 1); + + /* In the non-toolkit version, clicks on the menu bar + are ordinary button events in the event buffer. + Distinguish them, and invoke the menu. + + (In the toolkit version, the toolkit handles the + menu bar and Emacs doesn't know about it until + after the user makes a selection.) */ + if (row >= 0 && row < FRAME_MENU_BAR_LINES (f) + && (event->modifiers & down_modifier)) { - Lisp_Object pos, string; - string = AREF (items, i + 1); - pos = AREF (items, i + 3); - if (NILP (string)) - break; - if (column >= XINT (pos) - && column < XINT (pos) + SCHARS (string)) + Lisp_Object items, item; + + /* Find the menu bar item under `column'. */ + item = Qnil; + items = FRAME_MENU_BAR_ITEMS (f); + for (i = 0; i < ASIZE (items); i += 4) { - item = AREF (items, i); - break; + Lisp_Object pos, string; + string = AREF (items, i + 1); + pos = AREF (items, i + 3); + if (NILP (string)) + break; + if (column >= XINT (pos) + && column < XINT (pos) + SCHARS (string)) + { + item = AREF (items, i); + break; + } } + + /* ELisp manual 2.4b says (x y) are window + relative but code says they are + frame-relative. */ + position = list4 (event->frame_or_window, + Qmenu_bar, + Fcons (event->x, event->y), + make_number (event->timestamp)); + + return list2 (item, position); } - - /* ELisp manual 2.4b says (x y) are window relative but - code says they are frame-relative. */ - position = list4 (event->frame_or_window, - Qmenu_bar, - Fcons (event->x, event->y), - make_number (event->timestamp)); - - return list2 (item, position); } -#endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */ position = make_lispy_position (f, event->x, event->y, event->timestamp); @@ -8792,6 +8849,9 @@ Echo starting immediately unless `prompt' is 0. + If PREVENT_REDISPLAY is non-zero, avoid redisplay by calling + read_char with a suitable COMMANDFLAG argument. + Where a key sequence ends depends on the currently active keymaps. These include any minor mode keymaps active in the current buffer, the current buffer's local map, and the global map. @@ -8824,7 +8884,7 @@ static int read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, bool dont_downcase_last, bool can_return_switch_frame, - bool fix_current_buffer) + bool fix_current_buffer, bool prevent_redisplay) { ptrdiff_t count = SPECPDL_INDEX (); @@ -8905,8 +8965,8 @@ { if (!NILP (prompt)) { - /* Install the string STR as the beginning of the string of - echoing, so that it serves as a prompt for the next + /* Install the string PROMPT as the beginning of the string + of echoing, so that it serves as a prompt for the next character. */ kset_echo_string (current_kboard, prompt); current_kboard->echo_after_prompt = SCHARS (prompt); @@ -9061,7 +9121,9 @@ { KBOARD *interrupted_kboard = current_kboard; struct frame *interrupted_frame = SELECTED_FRAME (); - key = read_char (NILP (prompt), + /* Calling read_char with COMMANDFLAG = -2 avoids + redisplay in read_char and its subroutines. */ + key = read_char (prevent_redisplay ? -2 : NILP (prompt), current_binding, last_nonmenu_event, &used_mouse_menu, NULL); if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */ @@ -9757,7 +9819,7 @@ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), prompt, ! NILP (dont_downcase_last), - ! NILP (can_return_switch_frame), 0); + ! NILP (can_return_switch_frame), 0, 0); #if 0 /* The following is fine for code reading a key sequence and then proceeding with a lengthy computation, but it's not good @@ -11003,6 +11065,8 @@ DEFSYM (Qhelp_form_show, "help-form-show"); + DEFSYM (Qecho_keystrokes, "echo-keystrokes"); + Fset (Qinput_method_exit_on_first_char, Qnil); Fset (Qinput_method_use_echo_area, Qnil); === modified file 'src/keyboard.h' --- src/keyboard.h 2013-09-20 15:34:36 +0000 +++ src/keyboard.h 2013-09-26 07:37:16 +0000 @@ -450,7 +450,7 @@ extern Lisp_Object Qevent_kind; /* The values of Qevent_kind properties. */ -extern Lisp_Object Qmouse_click; +extern Lisp_Object Qmouse_click, Qmouse_movement; extern Lisp_Object Qhelp_echo; === modified file 'src/menu.c' --- src/menu.c 2013-09-13 15:03:51 +0000 +++ src/menu.c 2013-10-08 14:28:37 +0000 @@ -30,6 +30,7 @@ #include "termhooks.h" #include "blockinput.h" #include "dispextern.h" +#include "buffer.h" #ifdef USE_X_TOOLKIT #include "../lwlib/lwlib.h" @@ -50,10 +51,16 @@ #include "menu.h" -/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ +/* Return non-zero if menus can handle radio and toggle buttons. */ +static bool +have_boxes (void) +{ #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) -#define HAVE_BOXES 1 + if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))) + return 1; #endif + return 0; +} Lisp_Object menu_items; @@ -283,13 +290,14 @@ push_menu_pane (pane_name, prefix); -#ifndef HAVE_BOXES - /* Remember index for first item in this pane so we can go back and - add a prefix when (if) we see the first button. After that, notbuttons - is set to 0, to mark that we have seen a button and all non button - items need a prefix. */ - skp.notbuttons = menu_items_used; -#endif + if (!have_boxes ()) + { + /* Remember index for first item in this pane so we can go back + and add a prefix when (if) we see the first button. After + that, notbuttons is set to 0, to mark that we have seen a + button and all non button items need a prefix. */ + skp.notbuttons = menu_items_used; + } GCPRO1 (skp.pending_maps); map_keymap_canonical (keymap, single_menu_item, Qnil, &skp); @@ -345,77 +353,72 @@ return; } -#if defined (HAVE_X_WINDOWS) || defined (MSDOS) -#ifndef HAVE_BOXES /* Simulate radio buttons and toggle boxes by putting a prefix in front of them. */ - { - Lisp_Object prefix = Qnil; - Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE); - if (!NILP (type)) - { - Lisp_Object selected - = AREF (item_properties, ITEM_PROPERTY_SELECTED); - - if (skp->notbuttons) - /* The first button. Line up previous items in this menu. */ - { - int idx = skp->notbuttons; /* Index for first item this menu. */ - int submenu = 0; - Lisp_Object tem; - while (idx < menu_items_used) - { - tem - = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME); - if (NILP (tem)) - { - idx++; - submenu++; /* Skip sub menu. */ - } - else if (EQ (tem, Qlambda)) - { - idx++; - submenu--; /* End sub menu. */ - } - else if (EQ (tem, Qt)) - idx += 3; /* Skip new pane marker. */ - else if (EQ (tem, Qquote)) - idx++; /* Skip a left, right divider. */ - else - { - if (!submenu && SREF (tem, 0) != '\0' - && SREF (tem, 0) != '-') - ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME, - concat2 (build_string (" "), tem)); - idx += MENU_ITEMS_ITEM_LENGTH; - } - } - skp->notbuttons = 0; - } - - /* Calculate prefix, if any, for this item. */ - if (EQ (type, QCtoggle)) - prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); - else if (EQ (type, QCradio)) - prefix = build_string (NILP (selected) ? "( ) " : "(*) "); - } - /* Not a button. If we have earlier buttons, then we need a prefix. */ - else if (!skp->notbuttons && SREF (item_string, 0) != '\0' - && SREF (item_string, 0) != '-') - prefix = build_string (" "); - - if (!NILP (prefix)) - item_string = concat2 (prefix, item_string); + if (!have_boxes ()) + { + Lisp_Object prefix = Qnil; + Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE); + if (!NILP (type)) + { + Lisp_Object selected + = AREF (item_properties, ITEM_PROPERTY_SELECTED); + + if (skp->notbuttons) + /* The first button. Line up previous items in this menu. */ + { + int idx = skp->notbuttons; /* Index for first item this menu. */ + int submenu = 0; + Lisp_Object tem; + while (idx < menu_items_used) + { + tem + = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME); + if (NILP (tem)) + { + idx++; + submenu++; /* Skip sub menu. */ + } + else if (EQ (tem, Qlambda)) + { + idx++; + submenu--; /* End sub menu. */ + } + else if (EQ (tem, Qt)) + idx += 3; /* Skip new pane marker. */ + else if (EQ (tem, Qquote)) + idx++; /* Skip a left, right divider. */ + else + { + if (!submenu && SREF (tem, 0) != '\0' + && SREF (tem, 0) != '-') + ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME, + concat2 (build_string (" "), tem)); + idx += MENU_ITEMS_ITEM_LENGTH; + } + } + skp->notbuttons = 0; + } + + /* Calculate prefix, if any, for this item. */ + if (EQ (type, QCtoggle)) + prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); + else if (EQ (type, QCradio)) + prefix = build_string (NILP (selected) ? "( ) " : "(*) "); + } + /* Not a button. If we have earlier buttons, then we need a prefix. */ + else if (!skp->notbuttons && SREF (item_string, 0) != '\0' + && SREF (item_string, 0) != '-') + prefix = build_string (" "); + + if (!NILP (prefix)) + item_string = concat2 (prefix, item_string); } -#endif /* not HAVE_BOXES */ -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) - if (!NILP (map)) + if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)) + && !NILP (map)) /* Indicate visually that this is a submenu. */ item_string = concat2 (item_string, build_string (" >")); -#endif - -#endif /* HAVE_X_WINDOWS || MSDOS */ push_menu_item (item_string, enabled, key, AREF (item_properties, ITEM_PROPERTY_DEF), @@ -426,7 +429,8 @@ #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) /* Display a submenu using the toolkit. */ - if (! (NILP (map) || NILP (enabled))) + if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)) + && ! (NILP (map) || NILP (enabled))) { push_submenu_start (); single_keymap_panes (map, Qnil, key, skp->maxdepth - 1); @@ -455,6 +459,16 @@ finish_menu_items (); } +/* Encode a menu string as appropriate for menu-updating-frame's type. */ +static Lisp_Object +encode_menu_string (Lisp_Object str) +{ + /* TTY menu strings are encoded by write_glyphs, when they are + delivered to the glass, so no need to encode them here. */ + if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))) + return str; + return ENCODE_MENU_STRING (str); +} /* Push the items in a single pane defined by the alist PANE. */ static void @@ -466,13 +480,13 @@ { item = XCAR (tail); if (STRINGP (item)) - push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt, + push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil); else if (CONSP (item)) { item1 = XCAR (item); CHECK_STRING (item1); - push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item), + push_menu_item (encode_menu_string (item1), Qt, XCDR (item), Qt, Qnil, Qnil, Qnil, Qnil); } else @@ -497,7 +511,7 @@ elt = XCAR (tail); pane_name = Fcar (elt); CHECK_STRING (pane_name); - push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil); + push_menu_pane (encode_menu_string (pane_name), Qnil); pane_data = Fcdr (elt); CHECK_CONS (pane_data); list_of_items (pane_data); @@ -614,6 +628,7 @@ int submenu_depth = 0; widget_value **submenu_stack; bool panes_seen = 0; + struct frame *f = XFRAME (Vmenu_updating_frame); submenu_stack = alloca (menu_items_used * sizeof *submenu_stack); wv = xmalloc_widget_value (); @@ -663,30 +678,35 @@ pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + /* TTY menus display menu items via tty_write_glyphs, which + will encode the strings as appropriate. */ + if (!FRAME_TERMCAP_P (f)) + { #ifdef HAVE_NTGUI - if (STRINGP (pane_name)) - { - if (unicode_append_menu) - /* Encode as UTF-8 for now. */ - pane_name = ENCODE_UTF_8 (pane_name); - else if (STRING_MULTIBYTE (pane_name)) - pane_name = ENCODE_SYSTEM (pane_name); + if (STRINGP (pane_name)) + { + if (unicode_append_menu) + /* Encode as UTF-8 for now. */ + pane_name = ENCODE_UTF_8 (pane_name); + else if (STRING_MULTIBYTE (pane_name)) + pane_name = ENCODE_SYSTEM (pane_name); - ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); - } + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } #elif defined (USE_LUCID) && defined (HAVE_XFT) - if (STRINGP (pane_name)) - { - pane_name = ENCODE_UTF_8 (pane_name); - ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); - } + if (STRINGP (pane_name)) + { + pane_name = ENCODE_UTF_8 (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } #elif !defined (HAVE_MULTILINGUAL_MENU) - if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) - { - pane_name = ENCODE_MENU_STRING (pane_name); - ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_MENU_STRING (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } +#endif } -#endif pane_string = (NILP (pane_name) ? "" : SSDATA (pane_name)); @@ -737,47 +757,52 @@ selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + /* TTY menu items and their descriptions will be encoded by + tty_write_glyphs. */ + if (!FRAME_TERMCAP_P (f)) + { #ifdef HAVE_NTGUI - if (STRINGP (item_name)) - { - if (unicode_append_menu) - item_name = ENCODE_UTF_8 (item_name); - else if (STRING_MULTIBYTE (item_name)) - item_name = ENCODE_SYSTEM (item_name); - - ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); - } - - if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) - { - descrip = ENCODE_SYSTEM (descrip); - ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); - } + if (STRINGP (item_name)) + { + if (unicode_append_menu) + item_name = ENCODE_UTF_8 (item_name); + else if (STRING_MULTIBYTE (item_name)) + item_name = ENCODE_SYSTEM (item_name); + + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_SYSTEM (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } #elif USE_LUCID - if (STRINGP (item_name)) - { - item_name = ENCODE_UTF_8 (item_name); - ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); - } + if (STRINGP (item_name)) + { + item_name = ENCODE_UTF_8 (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } - if (STRINGP (descrip)) - { - descrip = ENCODE_UTF_8 (descrip); - ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); - } + if (STRINGP (descrip)) + { + descrip = ENCODE_UTF_8 (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } #elif !defined (HAVE_MULTILINGUAL_MENU) - if (STRING_MULTIBYTE (item_name)) - { - item_name = ENCODE_MENU_STRING (item_name); - ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); - } + if (STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_MENU_STRING (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } - if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) - { - descrip = ENCODE_MENU_STRING (descrip); - ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); - } + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_MENU_STRING (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } #endif + } wv = xmalloc_widget_value (); if (prev_wv) @@ -1011,6 +1036,85 @@ } #endif /* HAVE_NS */ +int +menu_item_width (const char *str) +{ + int len; + const char *p; + + for (len = 0, p = str; *p; ) + { + int ch_len; + int ch = STRING_CHAR_AND_LENGTH (p, ch_len); + + len += CHAR_WIDTH (ch); + p += ch_len; + } + return len; +} + +DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y, + 2, 3, 0, + doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y. +X and Y are frame-relative pixel coordinates, assumed to define +a location within the menu bar. +If FRAME is nil or omitted, it defaults to the selected frame. + +Value is the symbol of the menu at X/Y, or nil if the specified +coordinates are not within the FRAME's menu bar. The symbol can +be used to look up the menu like this: + + (lookup-key MAP [menu-bar SYMBOL]) + +where MAP is either the current global map or the current local map, +since menu-bar items come from both. + +This function can return non-nil only on a text-terminal frame +or on an X frame that doesn't use any GUI toolkit. Otherwise, +Emacs does not manage the menu bar and cannot convert coordinates +into menu items. */) + (Lisp_Object x, Lisp_Object y, Lisp_Object frame) +{ + int row, col; + struct frame *f = decode_any_frame (frame); + + if (!FRAME_LIVE_P (f)) + return Qnil; + + pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1); + if (0 <= row && row < FRAME_MENU_BAR_LINES (f)) + { + Lisp_Object items, item; + int i; + + /* Find the menu bar item under `col'. */ + item = Qnil; + items = FRAME_MENU_BAR_ITEMS (f); + /* This loop assumes a single menu-bar line, and will fail to + find an item if it is not in the first line. Note that + make_lispy_event in keyboard.c makes the same assumption. */ + for (i = 0; i < ASIZE (items); i += 4) + { + Lisp_Object pos, str; + + str = AREF (items, i + 1); + pos = AREF (items, i + 3); + if (NILP (str)) + return item; + if (XINT (pos) <= col + /* We use <= so the blank between 2 items on a TTY is + considered part of the previous item. */ + && col <= XINT (pos) + menu_item_width (SSDATA (str))) + { + item = AREF (items, i); + return item; + } + } + } + return Qnil; +} + + DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, doc: /* Pop up a deck-of-cards menu and return user's selection. POSITION is a position specification. This is either a mouse button event @@ -1056,7 +1160,7 @@ no quit occurs and `x-popup-menu' returns nil. */) (Lisp_Object position, Lisp_Object menu) { - Lisp_Object keymap, tem; + Lisp_Object keymap, tem, tem2; int xpos = 0, ypos = 0; Lisp_Object title; const char *error_name = NULL; @@ -1065,6 +1169,7 @@ Lisp_Object x, y, window; bool keymaps = 0; bool for_click = 0; + bool kbd_menu_navigation = 0; ptrdiff_t specpdl_count = SPECPDL_INDEX (); struct gcpro gcpro1; @@ -1077,8 +1182,6 @@ { bool get_current_pos_p = 0; - check_window_system (SELECTED_FRAME ()); - /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) @@ -1100,6 +1203,22 @@ for_click = 1; tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ + tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */ + /* The kbd_menu_navigation flag is set when the menu was + invoked by F10, which probably means they have no + mouse. In that case, we let them switch between + top-level menu-bar menus by using C-f/C-b and + horizontal arrow keys, since they cannot click the + mouse to open a different submenu. This flag is only + supported by tty_menu_show. We set it when POSITION + and last_nonmenu_event are different, which means we + constructed POSITION by hand (in popup-menu, see + menu-bar.el) to look like a mouse click on the menu bar + event. */ + if (!EQ (POSN_POSN (last_nonmenu_event), + POSN_POSN (position)) + && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar)) + kbd_menu_navigation = 1; tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); @@ -1194,11 +1313,6 @@ xpos += XINT (x); ypos += XINT (y); - /* FIXME: Find a more general check! */ - if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f) - || FRAME_W32_P (f) || FRAME_NS_P (f))) - error ("Can not put GUI menu on this terminal"); - XSETFRAME (Vmenu_updating_frame, f); } #endif /* HAVE_MENUS */ @@ -1287,7 +1401,8 @@ #ifdef HAVE_MENUS #ifdef HAVE_WINDOW_SYSTEM /* Hide a previous tip, if any. */ - Fx_hide_tip (); + if (!FRAME_TERMCAP_P (f)) + Fx_hide_tip (); #endif #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ @@ -1296,7 +1411,7 @@ can occur if you press ESC or click outside a menu without selecting a menu item. */ - if (current_popup_menu) + if (current_popup_menu && FRAME_W32_P (f)) { discard_menu_items (); FRAME_DISPLAY_INFO (f)->grabbed = 0; @@ -1310,26 +1425,34 @@ #endif /* Display them in a menu. */ - block_input (); /* FIXME: Use a terminal hook! */ #if defined HAVE_NTGUI - selection = w32_menu_show (f, xpos, ypos, for_click, - keymaps, title, &error_name); -#elif defined HAVE_NS - selection = ns_menu_show (f, xpos, ypos, for_click, - keymaps, title, &error_name); -#else /* MSDOS and X11 */ + if (FRAME_W32_P (f)) + selection = w32_menu_show (f, xpos, ypos, for_click, + keymaps, title, &error_name); + else +#endif +#if defined HAVE_NS + if (FRAME_NS_P (f)) + selection = ns_menu_show (f, xpos, ypos, for_click, + keymaps, title, &error_name); + else +#endif +#if (defined (HAVE_X_WINDOWS) || defined (MSDOS)) /* Assume last_event_timestamp is the timestamp of the button event. Is this assumption ever violated? We can't use the timestamp stored within POSITION because there the top bits from the actual timestamp may be truncated away (Bug#4930). */ - selection = xmenu_show (f, xpos, ypos, for_click, - keymaps, title, &error_name, - last_event_timestamp); + if (FRAME_X_P (f) || FRAME_MSDOS_P (f)) + selection = xmenu_show (f, xpos, ypos, for_click, + keymaps, title, &error_name, + last_event_timestamp); + else #endif - - unblock_input (); + if (FRAME_TERMCAP_P (f)) + selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title, + kbd_menu_navigation, &error_name); #ifdef HAVE_NS unbind_to (specpdl_count, Qnil); @@ -1338,7 +1461,8 @@ #endif #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ - FRAME_DISPLAY_INFO (f)->grabbed = 0; + if (FRAME_W32_P (f)) + FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif #endif /* HAVE_MENUS */ @@ -1349,6 +1473,145 @@ return selection; } +#ifdef HAVE_MENUS + +DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, + doc: /* Pop up a dialog box and return user's selection. +POSITION specifies which frame to use. +This is normally a mouse button event or a window or frame. +If POSITION is t, it means to use the frame the mouse is on. +The dialog box appears in the middle of the specified frame. + +CONTENTS specifies the alternatives to display in the dialog box. +It is a list of the form (DIALOG ITEM1 ITEM2...). +Each ITEM is a cons cell (STRING . VALUE). +The return value is VALUE from the chosen item. + +An ITEM may also be just a string--that makes a nonselectable item. +An ITEM may also be nil--that means to put all preceding items +on the left of the dialog box and all following items on the right. +\(By default, approximately half appear on each side.) + +If HEADER is non-nil, the frame title for the box is "Information", +otherwise it is "Question". + +If the user gets rid of the dialog box without making a valid choice, +for instance using the window manager, then this produces a quit and +`x-popup-dialog' does not return. */) + (Lisp_Object position, Lisp_Object contents, Lisp_Object header) +{ + struct frame *f = NULL; + Lisp_Object window; + + /* Decode the first argument: find the window or frame to use. */ + if (EQ (position, Qt) + || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtool_bar)))) + { +#if 0 /* Using the frame the mouse is on may not be right. */ + /* Use the mouse's current position. */ + struct frame *new_f = SELECTED_FRAME (); + Lisp_Object bar_window; + enum scroll_bar_part part; + Time time; + Lisp_Object x, y; + + (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); + + if (new_f != 0) + XSETFRAME (window, new_f); + else + window = selected_window; +#endif + window = selected_window; + } + else if (CONSP (position)) + { + Lisp_Object tem = XCAR (position); + if (CONSP (tem)) + window = Fcar (XCDR (position)); + else + { + tem = Fcar (XCDR (position)); /* EVENT_START (position) */ + window = Fcar (tem); /* POSN_WINDOW (tem) */ + } + } + else if (WINDOWP (position) || FRAMEP (position)) + window = position; + else + window = Qnil; + + /* Decode where to put the menu. */ + + if (FRAMEP (window)) + f = XFRAME (window); + else if (WINDOWP (window)) + { + CHECK_LIVE_WINDOW (window); + f = XFRAME (WINDOW_FRAME (XWINDOW (window))); + } + else + /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, + but I don't want to make one now. */ + CHECK_WINDOW (window); + + /* Force a redisplay before showing the dialog. If a frame is created + just before showing the dialog, its contents may not have been fully + drawn, as this depends on timing of events from the X server. Redisplay + is not done when a dialog is shown. If redisplay could be done in the + X event loop (i.e. the X event loop does not run in a signal handler) + this would not be needed. + + Do this before creating the widget value that points to Lisp + string contents, because Fredisplay may GC and relocate them. */ + Fredisplay (Qt); +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + if (FRAME_WINDOW_P (f)) + return xw_popup_dialog (f, header, contents); + else +#endif +#if defined (HAVE_NTGUI) && defined (HAVE_DIALOGS) + if (FRAME_W32_P (f)) + return w32_popup_dialog (f, header, contents); + else +#endif +#ifdef HAVE_NS + if (FRAME_NS_P (f)) + return ns_popup_dialog (position, header, contents); + else +#endif + /* Display a menu with these alternatives + in the middle of frame F. */ + { + Lisp_Object x, y, frame, newpos, prompt; + int x_coord, y_coord; + + prompt = Fcar (contents); + if (FRAME_WINDOW_P (f)) + { + x_coord = FRAME_PIXEL_WIDTH (f); + y_coord = FRAME_PIXEL_HEIGHT (f); + } + else + { + x_coord = FRAME_COLS (f); + /* Center the title at frame middle. (TTY menus have their + upper-left corner at the given position.) */ + if (STRINGP (prompt)) + x_coord -= SCHARS (prompt); + y_coord = FRAME_LINES (f); + } + XSETFRAME (frame, f); + XSETINT (x, x_coord / 2); + XSETINT (y, y_coord / 2); + newpos = list2 (list2 (x, y), frame); + + return Fx_popup_menu (newpos, list2 (prompt, contents)); + } +} + +#endif /* HAVE_MENUS */ + void syms_of_menu (void) { @@ -1357,4 +1620,9 @@ menu_items_inuse = Qnil; defsubr (&Sx_popup_menu); + +#ifdef HAVE_MENUS + defsubr (&Sx_popup_dialog); +#endif + defsubr (&Smenu_bar_menu_at_x_y); } === modified file 'src/menu.h' --- src/menu.h 2013-08-03 03:29:03 +0000 +++ src/menu.h 2013-10-08 14:28:37 +0000 @@ -51,4 +51,7 @@ Lisp_Object, const char **); extern Lisp_Object xmenu_show (struct frame *, int, int, bool, bool, Lisp_Object, const char **, Time); +extern Lisp_Object tty_menu_show (struct frame *, int, int, int, int, + Lisp_Object, int, const char **); +extern int menu_item_width (const char *); #endif /* MENU_H */ === modified file 'src/msdos.c' --- src/msdos.c 2013-09-24 06:43:20 +0000 +++ src/msdos.c 2013-09-26 07:37:16 +0000 @@ -1379,13 +1379,6 @@ emacs_abort (); } -/* set-window-configuration on window.c needs this. */ -void -x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) -{ - set_menu_bar_lines (f, value, oldval); -} - /* This was copied from xfaces.c */ extern Lisp_Object Qbackground_color; === modified file 'src/nsmenu.m' --- src/nsmenu.m 2013-09-22 14:26:10 +0000 +++ src/nsmenu.m 2013-09-29 18:38:56 +0000 @@ -833,6 +833,8 @@ ptrdiff_t specpdl_count = SPECPDL_INDEX (); widget_value *wv, *first_wv = 0; + block_input (); + p.x = x; p.y = y; /* now parse stage 2 as in ns_update_menubar */ @@ -1035,6 +1037,7 @@ popup_activated_flag = 0; [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; + unblock_input (); return tem; } @@ -1449,7 +1452,7 @@ Lisp_Object -ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) +ns_popup_dialog (Lisp_Object position, Lisp_Object header, Lisp_Object contents) { id dialog; Lisp_Object window, tem, title; @@ -1916,34 +1919,6 @@ } -DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, - doc: /* Pop up a dialog box and return user's selection. -POSITION specifies which frame to use. -This is normally a mouse button event or a window or frame. -If POSITION is t, it means to use the frame the mouse is on. -The dialog box appears in the middle of the specified frame. - -CONTENTS specifies the alternatives to display in the dialog box. -It is a list of the form (DIALOG ITEM1 ITEM2...). -Each ITEM is a cons cell (STRING . VALUE). -The return value is VALUE from the chosen item. - -An ITEM may also be just a string--that makes a nonselectable item. -An ITEM may also be nil--that means to put all preceding items -on the left of the dialog box and all following items on the right. -\(By default, approximately half appear on each side.) - -If HEADER is non-nil, the frame title for the box is "Information", -otherwise it is "Question". - -If the user gets rid of the dialog box without making a valid choice, -for instance using the window manager, then this produces a quit and -`x-popup-dialog' does not return. */) - (Lisp_Object position, Lisp_Object contents, Lisp_Object header) -{ - return ns_popup_dialog (position, contents, header); -} - DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0, doc: /* Return t if a menu or popup dialog is active. */) (void) @@ -1965,7 +1940,6 @@ update menus there. */ trackingMenu = 1; #endif - defsubr (&Sx_popup_dialog); defsubr (&Sns_reset_menu); defsubr (&Smenu_or_popup_active_p); === modified file 'src/nsterm.h' --- src/nsterm.h 2013-09-28 10:01:50 +0000 +++ src/nsterm.h 2013-10-08 17:49:20 +0000 @@ -850,8 +850,8 @@ extern Lisp_Object find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data); -extern Lisp_Object ns_popup_dialog (Lisp_Object position, Lisp_Object contents, - Lisp_Object header); +extern Lisp_Object ns_popup_dialog (Lisp_Object position, Lisp_Object header, + Lisp_Object contents); #define NSAPP_DATA2_RUNASSCRIPT 10 extern void ns_run_ascript (void); === modified file 'src/term.c' --- src/term.c 2013-09-11 08:24:05 +0000 +++ src/term.c 2013-10-08 17:49:20 +0000 @@ -56,6 +56,8 @@ #include "xterm.h" #endif +#include "menu.h" + /* The name of the default console device. */ #ifdef WINDOWSNT #define DEV_TTY "CONOUT$" @@ -302,7 +304,11 @@ if (tty->cursor_hidden == 0) { tty->cursor_hidden = 1; +#ifdef WINDOWSNT + w32con_hide_cursor (); +#else OUTPUT_IF (tty, tty->TS_cursor_invisible); +#endif } } @@ -315,9 +321,13 @@ if (tty->cursor_hidden) { tty->cursor_hidden = 0; +#ifdef WINDOWSNT + w32con_show_cursor (); +#else OUTPUT_IF (tty, tty->TS_cursor_normal); if (visible_cursor) OUTPUT_IF (tty, tty->TS_cursor_visible); +#endif } } @@ -2755,6 +2765,1107 @@ #endif /* HAVE_GPM */ +/*********************************************************************** + Menus + ***********************************************************************/ + +#if defined (HAVE_MENUS) && !defined (MSDOS) + +/* TTY menu implementation and main ideas are borrowed from msdos.c. + + However, unlike on MSDOS, where the menu text is drawn directly to + the display video memory, on a TTY we use display_string (see + display_tty_menu_item in xdisp.c) to put the glyphs produced from + the menu items directly into the frame's 'desired_matrix' glyph + matrix, and then call update_frame_with_menu to deliver the results + to the glass. The previous contents of the screen, in the form of + the current_matrix, is stashed away, and used to restore screen + contents when the menu selection changes or when the final + selection is made and the menu should be popped down. + + The idea of this implementation was suggested by Gerd Moellmann. */ + +#define TTYM_FAILURE -1 +#define TTYM_SUCCESS 1 +#define TTYM_NO_SELECT 2 +#define TTYM_IA_SELECT 3 +#define TTYM_NEXT 4 +#define TTYM_PREV 5 + +/* These hold text of the current and the previous menu help messages. */ +static const char *menu_help_message, *prev_menu_help_message; +/* Pane number and item number of the menu item which generated the + last menu help message. */ +static int menu_help_paneno, menu_help_itemno; + +static Lisp_Object Qtty_menu_navigation_map, Qtty_menu_exit; +static Lisp_Object Qtty_menu_prev_item, Qtty_menu_next_item; +static Lisp_Object Qtty_menu_next_menu, Qtty_menu_prev_menu; +static Lisp_Object Qtty_menu_select, Qtty_menu_ignore; +static Lisp_Object Qtty_menu_mouse_movement; + +typedef struct tty_menu_struct +{ + int count; + char **text; + struct tty_menu_struct **submenu; + int *panenumber; /* Also used as enabled flag. */ + int allocated; + int panecount; + int width; + const char **help_text; +} tty_menu; + +/* Create a brand new menu structure. */ + +static tty_menu * +tty_menu_create (void) +{ + tty_menu *menu; + + menu = (tty_menu *) xmalloc (sizeof (tty_menu)); + menu->allocated = menu->count = menu->panecount = menu->width = 0; + return menu; +} + +/* Allocate some (more) memory for MENU ensuring that there is room for one + for item. */ + +static void +tty_menu_make_room (tty_menu *menu) +{ + if (menu->allocated == 0) + { + int count = menu->allocated = 10; + menu->text = (char **) xmalloc (count * sizeof (char *)); + menu->submenu = (tty_menu **) xmalloc (count * sizeof (tty_menu *)); + menu->panenumber = (int *) xmalloc (count * sizeof (int)); + menu->help_text = (const char **) xmalloc (count * sizeof (char *)); + } + else if (menu->allocated == menu->count) + { + int count = menu->allocated = menu->allocated + 10; + menu->text + = (char **) xrealloc (menu->text, count * sizeof (char *)); + menu->submenu + = (tty_menu **) xrealloc (menu->submenu, count * sizeof (tty_menu *)); + menu->panenumber + = (int *) xrealloc (menu->panenumber, count * sizeof (int)); + menu->help_text + = (const char **) xrealloc (menu->help_text, count * sizeof (char *)); + } +} + +/* Search the given menu structure for a given pane number. */ + +static tty_menu * +tty_menu_search_pane (tty_menu *menu, int pane) +{ + int i; + tty_menu *try; + + for (i = 0; i < menu->count; i++) + if (menu->submenu[i]) + { + if (pane == menu->panenumber[i]) + return menu->submenu[i]; + if ((try = tty_menu_search_pane (menu->submenu[i], pane))) + return try; + } + return (tty_menu *) 0; +} + +/* Determine how much screen space a given menu needs. */ + +static void +tty_menu_calc_size (tty_menu *menu, int *width, int *height) +{ + int i, h2, w2, maxsubwidth, maxheight; + + maxsubwidth = menu->width; + maxheight = menu->count; + for (i = 0; i < menu->count; i++) + { + if (menu->submenu[i]) + { + tty_menu_calc_size (menu->submenu[i], &w2, &h2); + if (w2 > maxsubwidth) maxsubwidth = w2; + if (i + h2 > maxheight) maxheight = i + h2; + } + } + *width = maxsubwidth; + *height = maxheight; +} + +static void +mouse_get_xy (int *x, int *y) +{ + struct frame *sf = SELECTED_FRAME (); + Lisp_Object lmx = Qnil, lmy = Qnil, lisp_dummy; + enum scroll_bar_part part_dummy; + Time time_dummy; + + if (FRAME_TERMINAL (sf)->mouse_position_hook) + (*FRAME_TERMINAL (sf)->mouse_position_hook) (&sf, -1, + &lisp_dummy, &part_dummy, + &lmx, &lmy, + &time_dummy); + if (!NILP (lmx)) + { + *x = XINT (lmx); + *y = XINT (lmy); + } +} + +/* Display MENU at (X,Y) using FACES. */ + +static void +tty_menu_display (tty_menu *menu, int x, int y, int pn, int *faces, + int mx, int my, int disp_help) +{ + int i, face, width, enabled, mousehere, row, col; + struct frame *sf = SELECTED_FRAME (); + struct tty_display_info *tty = FRAME_TTY (sf); + + menu_help_message = NULL; + + width = menu->width; + col = cursorX (tty); + row = cursorY (tty); + for (i = 0; i < menu->count; i++) + { + int max_width = width + 2; /* +2 for padding blanks on each side */ + + cursor_to (sf, y + i, x); + if (menu->submenu[i]) + max_width += 2; /* for displaying " >" after the item */ + enabled + = (!menu->submenu[i] && menu->panenumber[i]) || (menu->submenu[i]); + mousehere = (y + i == my && x <= mx && mx < x + max_width); + face = faces[enabled + mousehere * 2]; + /* Display the menu help string for the i-th menu item even if + the menu item is currently disabled. That's what the GUI + code does. */ + if (disp_help && enabled + mousehere * 2 >= 2) + { + menu_help_message = menu->help_text[i]; + menu_help_paneno = pn - 1; + menu_help_itemno = i; + } + display_tty_menu_item (menu->text[i], max_width, face, x, y + i, + menu->submenu[i] != NULL); + } + update_frame_with_menu (sf); + cursor_to (sf, row, col); +} + +/* --------------------------- X Menu emulation ---------------------- */ + +/* Report availability of menus. */ + +int +have_menus_p (void) { return 1; } + +/* Create a new pane and place it on the outer-most level. */ + +static int +tty_menu_add_pane (tty_menu *menu, const char *txt) +{ + int len; + const char *p; + + tty_menu_make_room (menu); + menu->submenu[menu->count] = tty_menu_create (); + menu->text[menu->count] = (char *)txt; + menu->panenumber[menu->count] = ++menu->panecount; + menu->help_text[menu->count] = NULL; + menu->count++; + + /* Update the menu width, if necessary. */ + for (len = 0, p = txt; *p; ) + { + int ch_len; + int ch = STRING_CHAR_AND_LENGTH (p, ch_len); + + len += CHAR_WIDTH (ch); + p += ch_len; + } + + if (len > menu->width) + menu->width = len; + + return menu->panecount; +} + +/* Create a new item in a menu pane. */ + +int +tty_menu_add_selection (tty_menu *menu, int pane, + char *txt, int enable, char const *help_text) +{ + int len; + char *p; + + if (pane) + if (!(menu = tty_menu_search_pane (menu, pane))) + return TTYM_FAILURE; + tty_menu_make_room (menu); + menu->submenu[menu->count] = (tty_menu *) 0; + menu->text[menu->count] = txt; + menu->panenumber[menu->count] = enable; + menu->help_text[menu->count] = help_text; + menu->count++; + + /* Update the menu width, if necessary. */ + for (len = 0, p = txt; *p; ) + { + int ch_len; + int ch = STRING_CHAR_AND_LENGTH (p, ch_len); + + len += CHAR_WIDTH (ch); + p += ch_len; + } + + if (len > menu->width) + menu->width = len; + + return TTYM_SUCCESS; +} + +/* Decide where the menu would be placed if requested at (X,Y). */ + +void +tty_menu_locate (tty_menu *menu, int x, int y, + int *ulx, int *uly, int *width, int *height) +{ + tty_menu_calc_size (menu, width, height); + *ulx = x + 1; + *uly = y; + *width += 2; +} + +struct tty_menu_state +{ + struct glyph_matrix *screen_behind; + tty_menu *menu; + int pane; + int x, y; +}; + +/* Save away the contents of frame F's current frame matrix, and + enable all its rows. Value is a glyph matrix holding the contents + of F's current frame matrix with all its glyph rows enabled. */ + +static struct glyph_matrix * +save_and_enable_current_matrix (struct frame *f) +{ + int i; + struct glyph_matrix *saved = xzalloc (sizeof *saved); + saved->nrows = f->current_matrix->nrows; + saved->rows = xzalloc (saved->nrows * sizeof *saved->rows); + + for (i = 0; i < saved->nrows; ++i) + { + struct glyph_row *from = f->current_matrix->rows + i; + struct glyph_row *to = saved->rows + i; + ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph); + + to->glyphs[TEXT_AREA] = xmalloc (nbytes); + memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes); + to->used[TEXT_AREA] = from->used[TEXT_AREA]; + /* Make sure every row is enabled, or else update_frame will not + redraw them. (Rows that are identical to what is already on + screen will not be redrawn anyway.) */ + to->enabled_p = 1; + to->hash = from->hash; + if (from->used[LEFT_MARGIN_AREA]) + { + nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); + to->glyphs[LEFT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + memcpy (to->glyphs[LEFT_MARGIN_AREA], + from->glyphs[LEFT_MARGIN_AREA], nbytes); + to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; + } + if (from->used[RIGHT_MARGIN_AREA]) + { + nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); + to->glyphs[RIGHT_MARGIN_AREA] = (struct glyph *) xmalloc (nbytes); + memcpy (to->glyphs[RIGHT_MARGIN_AREA], + from->glyphs[RIGHT_MARGIN_AREA], nbytes); + to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; + } + } + + return saved; +} + +/* Restore the contents of frame F's desired frame matrix from SAVED, + and free memory associated with SAVED. */ + +static void +restore_desired_matrix (struct frame *f, struct glyph_matrix *saved) +{ + int i; + + for (i = 0; i < saved->nrows; ++i) + { + struct glyph_row *from = saved->rows + i; + struct glyph_row *to = f->desired_matrix->rows + i; + ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph); + + eassert (to->glyphs[TEXT_AREA] != from->glyphs[TEXT_AREA]); + memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes); + to->used[TEXT_AREA] = from->used[TEXT_AREA]; + to->enabled_p = from->enabled_p; + to->hash = from->hash; + nbytes = from->used[LEFT_MARGIN_AREA] * sizeof (struct glyph); + if (nbytes) + { + eassert (to->glyphs[LEFT_MARGIN_AREA] != from->glyphs[LEFT_MARGIN_AREA]); + memcpy (to->glyphs[LEFT_MARGIN_AREA], + from->glyphs[LEFT_MARGIN_AREA], nbytes); + to->used[LEFT_MARGIN_AREA] = from->used[LEFT_MARGIN_AREA]; + } + else + to->used[LEFT_MARGIN_AREA] = 0; + nbytes = from->used[RIGHT_MARGIN_AREA] * sizeof (struct glyph); + if (nbytes) + { + eassert (to->glyphs[RIGHT_MARGIN_AREA] != from->glyphs[RIGHT_MARGIN_AREA]); + memcpy (to->glyphs[RIGHT_MARGIN_AREA], + from->glyphs[RIGHT_MARGIN_AREA], nbytes); + to->used[RIGHT_MARGIN_AREA] = from->used[RIGHT_MARGIN_AREA]; + } + else + to->used[RIGHT_MARGIN_AREA] = 0; + } +} + +static void +free_saved_screen (struct glyph_matrix *saved) +{ + int i; + + if (!saved) + return; /* already freed */ + + for (i = 0; i < saved->nrows; ++i) + { + struct glyph_row *from = saved->rows + i; + + xfree (from->glyphs[TEXT_AREA]); + if (from->used[LEFT_MARGIN_AREA]) + xfree (from->glyphs[LEFT_MARGIN_AREA]); + if (from->used[RIGHT_MARGIN_AREA]) + xfree (from->glyphs[RIGHT_MARGIN_AREA]); + } + + xfree (saved->rows); + xfree (saved); +} + +/* Update the display of frame F from its saved contents. */ +static void +screen_update (struct frame *f, struct glyph_matrix *mtx) +{ + restore_desired_matrix (f, mtx); + update_frame_with_menu (f); +} + +/* Read user input and return X and Y coordinates where that input + puts us. We only consider mouse movement and click events and + keyboard movement commands; the rest are ignored. + + Value is -1 if C-g was pressed, 1 if an item was selected, 2 or 3 + if we need to move to the next or previous menu-bar menu, zero + otherwise. */ +static int +read_menu_input (struct frame *sf, int *x, int *y, int min_y, int max_y, + bool *first_time) +{ + if (*first_time) + { + *first_time = false; + sf->mouse_moved = 1; + } + else + { + extern Lisp_Object read_menu_command (void); + Lisp_Object cmd; + int usable_input = 1; + int st = 0; + struct tty_display_info *tty = FRAME_TTY (sf); + Lisp_Object saved_mouse_tracking = do_mouse_tracking; + + /* Signal the keyboard reading routines we are displaying a menu + on this terminal. */ + tty->showing_menu = 1; + /* We want mouse movements be reported by read_menu_command. */ + do_mouse_tracking = Qt; + do { + cmd = read_menu_command (); + } while (NILP (cmd)); + tty->showing_menu = 0; + do_mouse_tracking = saved_mouse_tracking; + + if (EQ (cmd, Qt) || EQ (cmd, Qtty_menu_exit)) + return -1; + if (EQ (cmd, Qtty_menu_mouse_movement)) + { + int mx, my; + + mouse_get_xy (&mx, &my); + *x = mx; + *y = my; + } + else if (EQ (cmd, Qtty_menu_next_menu)) + { + usable_input = 0; + st = 2; + } + else if (EQ (cmd, Qtty_menu_prev_menu)) + { + usable_input = 0; + st = 3; + } + else if (EQ (cmd, Qtty_menu_next_item)) + { + if (*y < max_y) + *y += 1; + } + else if (EQ (cmd, Qtty_menu_prev_item)) + { + if (*y > min_y) + *y -= 1; + } + else if (EQ (cmd, Qtty_menu_select)) + st = 1; + else if (!EQ (cmd, Qtty_menu_ignore)) + usable_input = 0; + if (usable_input) + sf->mouse_moved = 1; + return st; + } + return 0; +} + +/* Display menu, wait for user's response, and return that response. */ +static int +tty_menu_activate (tty_menu *menu, int *pane, int *selidx, + int x0, int y0, char **txt, + void (*help_callback)(char const *, int, int), + int kbd_navigation) +{ + struct tty_menu_state *state; + int statecount, x, y, i, b, leave, result, onepane; + int title_faces[4]; /* face to display the menu title */ + int faces[4], buffers_num_deleted = 0; + struct frame *sf = SELECTED_FRAME (); + struct tty_display_info *tty = FRAME_TTY (sf); + bool first_time; + Lisp_Object saved_echo_area_message, selectface; + + /* Don't allow non-positive x0 and y0, lest the menu will wrap + around the display. */ + if (x0 <= 0) + x0 = 1; + if (y0 <= 0) + y0 = 1; + + state = alloca (menu->panecount * sizeof (struct tty_menu_state)); + memset (state, 0, sizeof (*state)); + faces[0] + = lookup_derived_face (sf, intern ("tty-menu-disabled-face"), + DEFAULT_FACE_ID, 1); + faces[1] + = lookup_derived_face (sf, intern ("tty-menu-enabled-face"), + DEFAULT_FACE_ID, 1); + selectface = intern ("tty-menu-selected-face"); + faces[2] = lookup_derived_face (sf, selectface, + faces[0], 1); + faces[3] = lookup_derived_face (sf, selectface, + faces[1], 1); + + /* Make sure the menu title is always displayed with + `tty-menu-selected-face', no matter where the mouse pointer is. */ + for (i = 0; i < 4; i++) + title_faces[i] = faces[3]; + + statecount = 1; + + /* Don't let the title for the "Buffers" popup menu include a + digit (which is ugly). + + This is a terrible kludge, but I think the "Buffers" case is + the only one where the title includes a number, so it doesn't + seem to be necessary to make this more general. */ + if (strncmp (menu->text[0], "Buffers 1", 9) == 0) + { + menu->text[0][7] = '\0'; + buffers_num_deleted = 1; + } + + /* Force update of the current frame, so that the desired and the + current matrices are identical. */ + update_frame_with_menu (sf); + state[0].menu = menu; + state[0].screen_behind = save_and_enable_current_matrix (sf); + + /* Display the menu title. We subtract 1 from x0 and y0 because we + want to interpret them as zero-based column and row coordinates, + and also because we want the first item of the menu, not its + title, to appear at x0,y0. */ + tty_menu_display (menu, x0 - 1, y0 - 1, 1, title_faces, x0 - 1, y0 - 1, 0); + + /* Turn off the cursor. Otherwise it shows through the menu + panes, which is ugly. */ + tty_hide_cursor (tty); + if (buffers_num_deleted) + menu->text[0][7] = ' '; + if ((onepane = menu->count == 1 && menu->submenu[0])) + { + menu->width = menu->submenu[0]->width; + state[0].menu = menu->submenu[0]; + } + else + { + state[0].menu = menu; + } + state[0].x = x0 - 1; + state[0].y = y0; + state[0].pane = onepane; + + x = state[0].x; + y = state[0].y; + first_time = true; + + leave = 0; + while (!leave) + { + int input_status; + int min_y = state[0].y, max_y = min_y + state[0].menu->count - 1; + + input_status = read_menu_input (sf, &x, &y, min_y, max_y, &first_time); + if (input_status) + { + leave = 1; + if (input_status == -1) + { + /* Remove the last help-echo, so that it doesn't + re-appear after "Quit". */ + show_help_echo (Qnil, Qnil, Qnil, Qnil); + result = TTYM_NO_SELECT; + } + else if (input_status == 2) + { + if (kbd_navigation) + result = TTYM_NEXT; + else + leave = 0; + } + else if (input_status == 3) + { + if (kbd_navigation) + result = TTYM_PREV; + else + leave = 0; + } + } + if (sf->mouse_moved && input_status != -1) + { + sf->mouse_moved = 0; + result = TTYM_IA_SELECT; + for (i = 0; i < statecount; i++) + if (state[i].x <= x && x < state[i].x + state[i].menu->width + 2) + { + int dy = y - state[i].y; + if (0 <= dy && dy < state[i].menu->count) + { + if (!state[i].menu->submenu[dy]) + { + if (state[i].menu->panenumber[dy]) + result = TTYM_SUCCESS; + else + result = TTYM_IA_SELECT; + } + *pane = state[i].pane - 1; + *selidx = dy; + /* We hit some part of a menu, so drop extra menus that + have been opened. That does not include an open and + active submenu. */ + if (i != statecount - 2 + || state[i].menu->submenu[dy] != state[i+1].menu) + while (i != statecount - 1) + { + statecount--; + screen_update (sf, state[statecount].screen_behind); + state[statecount].screen_behind = NULL; + } + if (i == statecount - 1 && state[i].menu->submenu[dy]) + { + tty_menu_display (state[i].menu, + state[i].x, + state[i].y, + state[i].pane, + faces, x, y, 1); + state[statecount].menu = state[i].menu->submenu[dy]; + state[statecount].pane = state[i].menu->panenumber[dy]; + state[statecount].screen_behind + = save_and_enable_current_matrix (sf); + state[statecount].x + = state[i].x + state[i].menu->width + 2; + state[statecount].y = y; + statecount++; + } + } + } + tty_menu_display (state[statecount - 1].menu, + state[statecount - 1].x, + state[statecount - 1].y, + state[statecount - 1].pane, + faces, x, y, 1); + tty_hide_cursor (tty); + fflush (tty->output); + } + + /* Display the help-echo message for the currently-selected menu + item. */ + if ((menu_help_message || prev_menu_help_message) + && menu_help_message != prev_menu_help_message) + { + help_callback (menu_help_message, + menu_help_paneno, menu_help_itemno); + tty_hide_cursor (tty); + fflush (tty->output); + prev_menu_help_message = menu_help_message; + } + } + + sf->mouse_moved = 0; + screen_update (sf, state[0].screen_behind); + while (statecount--) + free_saved_screen (state[statecount].screen_behind); + tty_show_cursor (tty); /* turn cursor back on */ + +/* Clean up any mouse events that are waiting inside Emacs event queue. + These events are likely to be generated before the menu was even + displayed, probably because the user pressed and released the button + (which invoked the menu) too quickly. If we don't remove these events, + Emacs will process them after we return and surprise the user. */ + discard_mouse_events (); + if (!kbd_buffer_events_waiting ()) + clear_input_pending (); + SET_FRAME_GARBAGED (sf); + return result; +} + +/* Dispose of a menu. */ + +void +tty_menu_destroy (tty_menu *menu) +{ + int i; + if (menu->allocated) + { + for (i = 0; i < menu->count; i++) + if (menu->submenu[i]) + tty_menu_destroy (menu->submenu[i]); + xfree (menu->text); + xfree (menu->submenu); + xfree (menu->panenumber); + xfree (menu->help_text); + } + xfree (menu); + menu_help_message = prev_menu_help_message = NULL; +} + +/* Show help HELP_STRING, or clear help if HELP_STRING is null. + + PANE is the pane number, and ITEM is the menu item number in + the menu (currently not used). */ + +static void +tty_menu_help_callback (char const *help_string, int pane, int item) +{ + Lisp_Object *first_item; + Lisp_Object pane_name; + Lisp_Object menu_object; + + first_item = XVECTOR (menu_items)->u.contents; + if (EQ (first_item[0], Qt)) + pane_name = first_item[MENU_ITEMS_PANE_NAME]; + else if (EQ (first_item[0], Qquote)) + /* This shouldn't happen, see xmenu_show. */ + pane_name = empty_unibyte_string; + else + pane_name = first_item[MENU_ITEMS_ITEM_NAME]; + + /* (menu-item MENU-NAME PANE-NUMBER) */ + menu_object = list3 (Qmenu_item, pane_name, make_number (pane)); + show_help_echo (help_string ? build_string (help_string) : Qnil, + Qnil, menu_object, make_number (item)); +} + +static void +tty_pop_down_menu (Lisp_Object arg) +{ + tty_menu *menu = XSAVE_POINTER (arg, 0); + + block_input (); + tty_menu_destroy (menu); + unblock_input (); +} + +/* Return the zero-based index of the last menu-bar item on frame F. */ +static int +tty_menu_last_menubar_item (struct frame *f) +{ + int i = 0; + + eassert (FRAME_TERMCAP_P (f) && FRAME_LIVE_P (f)); + if (FRAME_TERMCAP_P (f) && FRAME_LIVE_P (f)) + { + Lisp_Object items = FRAME_MENU_BAR_ITEMS (f); + + while (i < ASIZE (items)) + { + Lisp_Object str; + + str = AREF (items, i + 1); + if (NILP (str)) + break; + i += 4; + } + i -= 4; /* went one too far */ + } + return i; +} + +/* Find in frame F's menu bar the menu item that is next or previous + to the item at X/Y, and return that item's position in X/Y. WHICH + says which one--next or previous--item to look for. X and Y are + measured in character cells. This should only be called on TTY + frames. */ +static void +tty_menu_new_item_coords (struct frame *f, int which, int *x, int *y) +{ + eassert (FRAME_TERMCAP_P (f) && FRAME_LIVE_P (f)); + if (FRAME_TERMCAP_P (f) && FRAME_LIVE_P (f)) + { + Lisp_Object items = FRAME_MENU_BAR_ITEMS (f); + int last_i = tty_menu_last_menubar_item (f); + int i, prev_x; + + /* This loop assumes a single menu-bar line, and will fail to + find an item if it is not in the first line. Note that + make_lispy_event in keyboard.c makes the same assumption. */ + for (i = 0, prev_x = -1; i < ASIZE (items); i += 4) + { + Lisp_Object pos, str; + int ix; + + str = AREF (items, i + 1); + pos = AREF (items, i + 3); + if (NILP (str)) + return; + ix = XINT (pos); + if (ix <= *x + /* We use <= so the blank between 2 items on a TTY is + considered part of the previous item. */ + && *x <= ix + menu_item_width (SSDATA (str))) + { + /* Found current item. Now compute the X coordinate of + the previous or next item. */ + if (which == TTYM_NEXT) + { + if (i < last_i) + *x = XINT (AREF (items, i + 4 + 3)); + else + *x = 0; /* wrap around to the first item */ + } + else if (prev_x < 0) + { + /* Wrap around to the last item. */ + *x = XINT (AREF (items, last_i + 3)); + } + else + *x = prev_x; + return; + } + prev_x = ix; + } + } +} + +Lisp_Object +tty_menu_show (struct frame *f, int x, int y, int for_click, int keymaps, + Lisp_Object title, int kbd_navigation, const char **error_name) +{ + tty_menu *menu; + int pane, selidx, lpane, status; + Lisp_Object entry, pane_prefix; + char *datap; + int ulx, uly, width, height; + int item_x, item_y; + int dispwidth, dispheight; + int i, j, lines, maxlines; + int maxwidth; + int dummy_int; + unsigned int dummy_uint; + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + + if (! FRAME_TERMCAP_P (f)) + emacs_abort (); + + *error_name = 0; + if (menu_items_n_panes == 0) + return Qnil; + + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + { + *error_name = "Empty menu"; + return Qnil; + } + + /* Make the menu on that window. */ + menu = tty_menu_create (); + if (menu == NULL) + { + *error_name = "Can't create menu"; + return Qnil; + } + + /* Don't GC while we prepare and show the menu, because we give the + menu functions pointers to the contents of strings. */ + inhibit_garbage_collection (); + + /* Adjust coordinates to be root-window-relative. */ + item_x = x += f->left_pos; + item_y = y += f->top_pos; + + /* Create all the necessary panes and their items. */ + maxwidth = maxlines = lines = i = 0; + lpane = TTYM_FAILURE; + while (i < menu_items_used) + { + if (EQ (AREF (menu_items, i), Qt)) + { + /* Create a new pane. */ + Lisp_Object pane_name, prefix; + const char *pane_string; + + maxlines = max (maxlines, lines); + lines = 0; + pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + pane_string = (NILP (pane_name) + ? "" : SSDATA (pane_name)); + if (keymaps && !NILP (prefix)) + pane_string++; + + lpane = tty_menu_add_pane (menu, pane_string); + if (lpane == TTYM_FAILURE) + { + tty_menu_destroy (menu); + *error_name = "Can't create pane"; + return Qnil; + } + i += MENU_ITEMS_PANE_LENGTH; + + /* Find the width of the widest item in this pane. */ + j = i; + while (j < menu_items_used) + { + Lisp_Object item; + item = AREF (menu_items, j); + if (EQ (item, Qt)) + break; + if (NILP (item)) + { + j++; + continue; + } + width = SBYTES (item); + if (width > maxwidth) + maxwidth = width; + + j += MENU_ITEMS_ITEM_LENGTH; + } + } + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else + { + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip, help; + char *item_data; + char const *help_string; + + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + help_string = STRINGP (help) ? SSDATA (help) : NULL; + + if (!NILP (descrip)) + { + /* if alloca is fast, use that to make the space, + to reduce gc needs. */ + item_data = (char *) alloca (maxwidth + SBYTES (descrip) + 1); + memcpy (item_data, SSDATA (item_name), SBYTES (item_name)); + for (j = SCHARS (item_name); j < maxwidth; j++) + item_data[j] = ' '; + memcpy (item_data + j, SSDATA (descrip), SBYTES (descrip)); + item_data[j + SBYTES (descrip)] = 0; + } + else + item_data = SSDATA (item_name); + + if (lpane == TTYM_FAILURE + || (tty_menu_add_selection (menu, lpane, item_data, + !NILP (enable), help_string) + == TTYM_FAILURE)) + { + tty_menu_destroy (menu); + *error_name = "Can't add selection to menu"; + return Qnil; + } + i += MENU_ITEMS_ITEM_LENGTH; + lines++; + } + } + + maxlines = max (maxlines, lines); + + /* All set and ready to fly. */ + dispwidth = f->text_cols; + dispheight = f->text_lines; + x = min (x, dispwidth); + y = min (y, dispheight); + x = max (x, 1); + y = max (y, 1); + tty_menu_locate (menu, x, y, &ulx, &uly, &width, &height); + if (ulx+width > dispwidth) + { + x -= (ulx + width) - dispwidth; + ulx = dispwidth - width; + } + if (uly+height > dispheight) + { + y -= (uly + height) - dispheight; + uly = dispheight - height; + } + + if (FRAME_HAS_MINIBUF_P (f) && uly+height > dispheight - 2) + { + /* Move the menu away of the echo area, to avoid overwriting the + menu with help echo messages or vice versa. */ + if (BUFFERP (echo_area_buffer[0]) && WINDOWP (echo_area_window)) + { + y -= WINDOW_TOTAL_LINES (XWINDOW (echo_area_window)) + 1; + uly -= WINDOW_TOTAL_LINES (XWINDOW (echo_area_window)) + 1; + } + else + { + y -= 2; + uly -= 2; + } + } + + if (ulx < 0) x -= ulx; + if (uly < 0) y -= uly; + +#if 0 + /* This code doesn't make sense on a TTY, since it can easily annul + the adjustments above that carefully avoid truncation of the menu + items. I think it was written to fix some problem that only + happens on X11. */ + if (! for_click) + { + /* If position was not given by a mouse click, adjust so upper left + corner of the menu as a whole ends up at given coordinates. This + is what x-popup-menu says in its documentation. */ + x += width/2; + y += 1.5*height/(maxlines+2); + } +#endif + + pane = selidx = 0; + + record_unwind_protect (tty_pop_down_menu, make_save_ptr (menu)); + + specbind (Qoverriding_terminal_local_map, + Fsymbol_value (Qtty_menu_navigation_map)); + status = tty_menu_activate (menu, &pane, &selidx, x, y, &datap, + tty_menu_help_callback, kbd_navigation); + entry = pane_prefix = Qnil; + + switch (status) + { + case TTYM_SUCCESS: + /* Find the item number SELIDX in pane number PANE. */ + i = 0; + while (i < menu_items_used) + { + if (EQ (AREF (menu_items, i), Qt)) + { + if (pane == 0) + pane_prefix + = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + pane--; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + if (pane == -1) + { + if (selidx == 0) + { + entry + = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + if (keymaps != 0) + { + entry = Fcons (entry, Qnil); + if (!NILP (pane_prefix)) + entry = Fcons (pane_prefix, entry); + } + break; + } + selidx--; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } + break; + + case TTYM_NEXT: + case TTYM_PREV: + tty_menu_new_item_coords (f, status, &item_x, &item_y); + entry = Fcons (make_number (item_x), make_number (item_y)); + break; + + case TTYM_FAILURE: + *error_name = "Can't activate menu"; + case TTYM_IA_SELECT: + break; + case TTYM_NO_SELECT: + /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means + the menu was invoked with a mouse event as POSITION). */ + if (! for_click) + Fsignal (Qquit, Qnil); + break; + } + + unbind_to (specpdl_count, Qnil); + + return entry; +} + +#endif /* HAVE_MENUS && !MSDOS */ + + #ifndef MSDOS /*********************************************************************** Initialization @@ -3514,4 +4625,14 @@ encode_terminal_src = NULL; encode_terminal_dst = NULL; + + DEFSYM (Qtty_menu_next_item, "tty-menu-next-item"); + DEFSYM (Qtty_menu_prev_item, "tty-menu-prev-item"); + DEFSYM (Qtty_menu_next_menu, "tty-menu-next-menu"); + DEFSYM (Qtty_menu_prev_menu, "tty-menu-prev-menu"); + DEFSYM (Qtty_menu_select, "tty-menu-select"); + DEFSYM (Qtty_menu_ignore, "tty-menu-ignore"); + DEFSYM (Qtty_menu_exit, "tty-menu-exit"); + DEFSYM (Qtty_menu_mouse_movement, "tty-menu-mouse-movement"); + DEFSYM (Qtty_menu_navigation_map, "tty-menu-navigation-map"); } === modified file 'src/termchar.h' --- src/termchar.h 2013-09-11 08:24:05 +0000 +++ src/termchar.h 2013-09-26 07:37:16 +0000 @@ -194,6 +194,9 @@ /* Nonzero means use ^S/^Q for flow control. */ unsigned flow_control : 1; + + /* Non-zero means we are displaying a TTY menu on this tty. */ + unsigned showing_menu : 1; }; /* A chain of structures for all tty devices currently in use. */ === modified file 'src/termhooks.h' --- src/termhooks.h 2013-09-20 15:34:36 +0000 +++ src/termhooks.h 2013-09-26 07:37:16 +0000 @@ -656,6 +656,14 @@ extern void close_gpm (int gpm_fd); #endif +#ifdef WINDOWSNT +extern int cursorX (struct tty_display_info *); +extern int cursorY (struct tty_display_info *); +#else +#define cursorX(t) curX(t) +#define cursorY(t) curY(t) +#endif + INLINE_HEADER_END #endif /* EMACS_TERMHOOKS_H */ === modified file 'src/w32console.c' --- src/w32console.c 2013-09-23 03:30:55 +0000 +++ src/w32console.c 2013-09-26 07:37:16 +0000 @@ -62,6 +62,7 @@ static WORD char_attr_normal; static DWORD prev_console_mode; +static CONSOLE_CURSOR_INFO console_cursor_info; #ifndef USE_SEPARATE_SCREEN static CONSOLE_CURSOR_INFO prev_console_cursor; #endif @@ -95,6 +96,22 @@ SetConsoleCursorPosition (cur_screen, cursor_coords); } +void +w32con_hide_cursor (void) +{ + GetConsoleCursorInfo (cur_screen, &console_cursor_info); + console_cursor_info.bVisible = FALSE; + SetConsoleCursorInfo (cur_screen, &console_cursor_info); +} + +void +w32con_show_cursor (void) +{ + GetConsoleCursorInfo (cur_screen, &console_cursor_info); + console_cursor_info.bVisible = TRUE; + SetConsoleCursorInfo (cur_screen, &console_cursor_info); +} + /* Clear from cursor to end of screen. */ static void w32con_clear_to_end (struct frame *f) @@ -552,6 +569,21 @@ } +/* Report the current cursor position. The following two functions + are used in term.c's tty menu code, so they are not really + "stubs". */ +int +cursorX (struct tty_display_info *tty) +{ + return cursor_coords.X; +} + +int +cursorY (struct tty_display_info *tty) +{ + return cursor_coords.Y; +} + /*********************************************************************** Faces ***********************************************************************/ === modified file 'src/w32fns.c' --- src/w32fns.c 2013-09-15 08:28:30 +0000 +++ src/w32fns.c 2013-09-26 07:37:16 +0000 @@ -5467,7 +5467,10 @@ f = SELECTED_FRAME (); if (!FRAME_W32_P (f)) - return; + { + unblock_input (); + return; + } w32_show_hourglass (f); unblock_input (); === modified file 'src/w32inevt.c' --- src/w32inevt.c 2013-08-03 03:29:03 +0000 +++ src/w32inevt.c 2013-09-21 14:53:04 +0000 @@ -712,12 +712,17 @@ while (nev > 0) { struct input_event inev; + /* Having a separate variable with this value makes + debugging easier, as otherwise the compiler might + rearrange the switch below in a way that makes it hard to + track the event type. */ + unsigned evtype = queue_ptr->EventType; EVENT_INIT (inev); inev.kind = NO_EVENT; inev.arg = Qnil; - switch (queue_ptr->EventType) + switch (evtype) { case KEY_EVENT: add = key_event (&queue_ptr->Event.KeyEvent, &inev, &isdead); === modified file 'src/w32menu.c' --- src/w32menu.c 2013-09-24 06:43:20 +0000 +++ src/w32menu.c 2013-09-29 18:38:56 +0000 @@ -115,129 +115,34 @@ void w32_free_menu_strings (HWND); #ifdef HAVE_MENUS - -DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, - doc: /* Pop up a dialog box and return user's selection. -POSITION specifies which frame to use. -This is normally a mouse button event or a window or frame. -If POSITION is t, it means to use the frame the mouse is on. -The dialog box appears in the middle of the specified frame. - -CONTENTS specifies the alternatives to display in the dialog box. -It is a list of the form (TITLE ITEM1 ITEM2...). -Each ITEM is a cons cell (STRING . VALUE). -The return value is VALUE from the chosen item. - -An ITEM may also be just a string--that makes a nonselectable item. -An ITEM may also be nil--that means to put all preceding items -on the left of the dialog box and all following items on the right. -\(By default, approximately half appear on each side.) - -If HEADER is non-nil, the frame title for the box is "Information", -otherwise it is "Question". */) - (Lisp_Object position, Lisp_Object contents, Lisp_Object header) +#ifdef HAVE_DIALOGS +Lisp_Object +w32_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) { - struct frame *f = NULL; - Lisp_Object window; - - /* Decode the first argument: find the window or frame to use. */ - if (EQ (position, Qt) - || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) - || EQ (XCAR (position), Qtool_bar)))) - { -#if 0 /* Using the frame the mouse is on may not be right. */ - /* Use the mouse's current position. */ - struct frame *new_f = SELECTED_FRAME (); - Lisp_Object bar_window; - enum scroll_bar_part part; - Time time; - Lisp_Object x, y; - - (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); - - if (new_f != 0) - XSETFRAME (window, new_f); - else - window = selected_window; -#endif - window = selected_window; - } - else if (CONSP (position)) - { - Lisp_Object tem = XCAR (position); - if (CONSP (tem)) - window = Fcar (XCDR (position)); - else - { - tem = Fcar (XCDR (position)); /* EVENT_START (position) */ - window = Fcar (tem); /* POSN_WINDOW (tem) */ - } - } - else if (WINDOWP (position) || FRAMEP (position)) - window = position; - else - window = Qnil; - - /* Decode where to put the menu. */ - - if (FRAMEP (window)) - f = XFRAME (window); - else if (WINDOWP (window)) - { - CHECK_LIVE_WINDOW (window); - f = XFRAME (WINDOW_FRAME (XWINDOW (window))); - } - else - /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, - but I don't want to make one now. */ - CHECK_WINDOW (window); + Lisp_Object title; + char *error_name; + Lisp_Object selection; check_window_system (f); -#ifndef HAVE_DIALOGS - - { - /* Handle simple Yes/No choices as MessageBox popups. */ - if (is_simple_dialog (contents)) - return simple_dialog_show (f, contents, header); - else - { - /* Display a menu with these alternatives - in the middle of frame F. */ - Lisp_Object x, y, frame, newpos; - XSETFRAME (frame, f); - XSETINT (x, FRAME_PIXEL_WIDTH (f) / 2); - XSETINT (y, FRAME_PIXEL_HEIGHT (f) / 2); - newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); - return Fx_popup_menu (newpos, - Fcons (Fcar (contents), Fcons (contents, Qnil))); - } - } -#else /* HAVE_DIALOGS */ - { - Lisp_Object title; - char *error_name; - Lisp_Object selection; - - /* Decode the dialog items from what was specified. */ - title = Fcar (contents); - CHECK_STRING (title); - - list_of_panes (Fcons (contents, Qnil)); - - /* Display them in a dialog box. */ - block_input (); - selection = w32_dialog_show (f, 0, title, header, &error_name); - unblock_input (); - - discard_menu_items (); - FRAME_DISPLAY_INFO (f)->grabbed = 0; - - if (error_name) error (error_name); - return selection; - } + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title); + + list_of_panes (Fcons (contents, Qnil)); + + /* Display them in a dialog box. */ + block_input (); + selection = w32_dialog_show (f, 0, title, header, &error_name); + unblock_input (); + + discard_menu_items (); + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (error_name) error (error_name); + return selection; +} #endif /* HAVE_DIALOGS */ -} /* Activate the menu bar of frame F. This is called from keyboard.c when it gets the @@ -682,6 +587,8 @@ return Qnil; } + block_input (); + /* Create a tree of widget_value objects representing the panes and their items. */ wv = xmalloc_widget_value (); @@ -940,6 +847,7 @@ if (!NILP (subprefix_stack[j])) entry = Fcons (subprefix_stack[j], entry); } + unblock_input (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -947,9 +855,13 @@ } } else if (!for_click) - /* Make "Cancel" equivalent to C-g. */ - Fsignal (Qquit, Qnil); + { + unblock_input (); + /* Make "Cancel" equivalent to C-g. */ + Fsignal (Qquit, Qnil); + } + unblock_input (); return Qnil; } @@ -1717,9 +1629,6 @@ DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); defsubr (&Smenu_or_popup_active_p); -#ifdef HAVE_MENUS - defsubr (&Sx_popup_dialog); -#endif } /* === modified file 'src/w32term.h' --- src/w32term.h 2013-09-19 07:48:53 +0000 +++ src/w32term.h 2013-09-29 18:38:56 +0000 @@ -264,6 +264,10 @@ extern Lisp_Object x_get_focus_frame (struct frame *); +/* w32console.c */ +extern void w32con_hide_cursor (void); +extern void w32con_show_cursor (void); + #define PIX_TYPE COLORREF @@ -794,6 +798,10 @@ #define GUI_SDATA(x) ((guichar_t*) SDATA (x)) +#if defined HAVE_DIALOGS +extern Lisp_Object w32_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +#endif + extern void syms_of_w32term (void); extern void syms_of_w32menu (void); extern void syms_of_w32fns (void); === modified file 'src/window.c' --- src/window.c 2013-10-02 12:08:27 +0000 +++ src/window.c 2013-10-08 17:49:20 +0000 @@ -5540,18 +5540,26 @@ || data->frame_cols != previous_frame_cols) change_frame_size (f, data->frame_lines, data->frame_cols, 0, 0, 0); -#if defined (HAVE_WINDOW_SYSTEM) || defined (MSDOS) +#ifdef HAVE_MENUS if (data->frame_menu_bar_lines != previous_frame_menu_bar_lines) - x_set_menu_bar_lines (f, make_number (data->frame_menu_bar_lines), - make_number (0)); + { +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + x_set_menu_bar_lines (f, make_number (data->frame_menu_bar_lines), + make_number (0)); + else /* TTY or MSDOS */ +#endif + set_menu_bar_lines (f, make_number (data->frame_menu_bar_lines), + make_number (0)); + } +#endif #ifdef HAVE_WINDOW_SYSTEM if (data->frame_tool_bar_lines != previous_frame_tool_bar_lines) x_set_tool_bar_lines (f, make_number (data->frame_tool_bar_lines), make_number (0)); #endif -#endif /* "Swap out" point from the selected window's buffer into the window itself. (Normally the pointm of the selected @@ -5738,16 +5746,25 @@ || previous_frame_cols != FRAME_COLS (f)) change_frame_size (f, previous_frame_lines, previous_frame_cols, 0, 0, 0); -#if defined (HAVE_WINDOW_SYSTEM) || defined (MSDOS) +#ifdef HAVE_MENUS if (previous_frame_menu_bar_lines != FRAME_MENU_BAR_LINES (f)) - x_set_menu_bar_lines (f, make_number (previous_frame_menu_bar_lines), - make_number (0)); + { +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + x_set_menu_bar_lines (f, + make_number (previous_frame_menu_bar_lines), + make_number (0)); + else /* TTY or MSDOS */ +#endif + set_menu_bar_lines (f, make_number (previous_frame_menu_bar_lines), + make_number (0)); + } +#endif #ifdef HAVE_WINDOW_SYSTEM if (previous_frame_tool_bar_lines != FRAME_TOOL_BAR_LINES (f)) x_set_tool_bar_lines (f, make_number (previous_frame_tool_bar_lines), make_number (0)); #endif -#endif /* Now, free glyph matrices in windows that were not reused. */ for (i = n = 0; i < n_leaf_windows; ++i) === modified file 'src/xdisp.c' --- src/xdisp.c 2013-10-08 14:56:15 +0000 +++ src/xdisp.c 2013-10-08 17:49:20 +0000 @@ -20584,7 +20584,128 @@ compute_line_metrics (&it); } - +#ifdef HAVE_MENUS +/* Deep copy of a glyph row, including the glyphs. */ +static void +deep_copy_glyph_row (struct glyph_row *to, struct glyph_row *from) +{ + int area, i, sum_used = 0; + struct glyph *pointers[1 + LAST_AREA]; + + /* Save glyph pointers of TO. */ + memcpy (pointers, to->glyphs, sizeof to->glyphs); + + /* Do a structure assignment. */ + *to = *from; + + /* Restore original pointers of TO. */ + memcpy (to->glyphs, pointers, sizeof to->glyphs); + + /* Count how many glyphs to copy and update glyph pointers. */ + for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area) + { + if (area > LEFT_MARGIN_AREA) + { + eassert (from->glyphs[area] - from->glyphs[area - 1] + == from->used[area - 1]); + to->glyphs[area] = to->glyphs[area - 1] + to->used[area - 1]; + } + sum_used += from->used[area]; + } + + /* Copy the glyphs. */ + eassert (sum_used <= to->glyphs[LAST_AREA] - to->glyphs[LEFT_MARGIN_AREA]); + for (i = 0; i < sum_used; i++) + to->glyphs[LEFT_MARGIN_AREA][i] = from->glyphs[LEFT_MARGIN_AREA][i]; +} + +/* Display one menu item on a TTY, by overwriting the glyphs in the + frame F's desired glyph matrix with glyphs produced from the menu + item text. Called from term.c to display TTY drop-down menus one + item at a time. + + ITEM_TEXT is the menu item text as a C string. + + FACE_ID is the face ID to be used for this menu item. FACE_ID + could specify one of 3 faces: a face for an enabled item, a face + for a disabled item, or a face for a selected item. + + X and Y are coordinates of the first glyph in the frame's desired + matrix to be overwritten by the menu item. Since this is a TTY, Y + is the zero-based number of the glyph row and X is the zero-based + glyph number in the row, starting from left, where to start + displaying the item. + + SUBMENU non-zero means this menu item drops down a submenu, which + should be indicated by displaying a proper visual cue after the + item text. */ + +void +display_tty_menu_item (const char *item_text, int width, int face_id, + int x, int y, int submenu) +{ + struct it it; + struct frame *f = SELECTED_FRAME (); + struct window *w = XWINDOW (f->selected_window); + int saved_used, saved_truncated, saved_width, saved_reversed; + struct glyph_row *row; + size_t item_len = strlen (item_text); + + eassert (FRAME_TERMCAP_P (f)); + + init_iterator (&it, w, -1, -1, f->desired_matrix->rows + y, MENU_FACE_ID); + it.first_visible_x = 0; + it.last_visible_x = FRAME_COLS (f) - 1; + row = it.glyph_row; + /* Start with the row contents from the current matrix. */ + deep_copy_glyph_row (row, f->current_matrix->rows + y); + saved_width = row->full_width_p; + row->full_width_p = 1; + saved_reversed = row->reversed_p; + row->reversed_p = 0; + row->enabled_p = 1; + + /* Arrange for the menu item glyphs to start at (X,Y) and have the + desired face. */ + it.current_x = it.hpos = x; + it.current_y = it.vpos = y; + saved_used = row->used[TEXT_AREA]; + saved_truncated = row->truncated_on_right_p; + row->used[TEXT_AREA] = x; + it.face_id = face_id; + it.line_wrap = TRUNCATE; + + /* FIXME: This should be controlled by a user option. See the + comments in redisplay_tool_bar and display_mode_line about this. + Also, if paragraph_embedding could ever be R2L, changes will be + needed to avoid shifting to the right the row characters in + term.c:append_glyph. */ + it.paragraph_embedding = L2R; + + /* Pad with a space on the left. */ + display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1); + width--; + /* Display the menu item, pad with spaces to WIDTH. */ + if (submenu) + { + display_string (item_text, Qnil, Qnil, 0, 0, &it, + item_len, 0, FRAME_COLS (f) - 1, -1); + width -= item_len; + /* Indicate with " >" that there's a submenu. */ + display_string (" >", Qnil, Qnil, 0, 0, &it, width, 0, + FRAME_COLS (f) - 1, -1); + } + else + display_string (item_text, Qnil, Qnil, 0, 0, &it, + width, 0, FRAME_COLS (f) - 1, -1); + + row->used[TEXT_AREA] = max (saved_used, row->used[TEXT_AREA]); + row->truncated_on_right_p = saved_truncated; + row->hash = row_hash (row); + row->full_width_p = saved_width; + row->reversed_p = saved_reversed; +} +#endif /* HAVE_MENUS */ /*********************************************************************** Mode Line === modified file 'src/xmenu.c' --- src/xmenu.c 2013-09-24 06:43:20 +0000 +++ src/xmenu.c 2013-09-29 18:38:56 +0000 @@ -192,149 +192,6 @@ #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_MENUS - -DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, - doc: /* Pop up a dialog box and return user's selection. -POSITION specifies which frame to use. -This is normally a mouse button event or a window or frame. -If POSITION is t, it means to use the frame the mouse is on. -The dialog box appears in the middle of the specified frame. - -CONTENTS specifies the alternatives to display in the dialog box. -It is a list of the form (DIALOG ITEM1 ITEM2...). -Each ITEM is a cons cell (STRING . VALUE). -The return value is VALUE from the chosen item. - -An ITEM may also be just a string--that makes a nonselectable item. -An ITEM may also be nil--that means to put all preceding items -on the left of the dialog box and all following items on the right. -\(By default, approximately half appear on each side.) - -If HEADER is non-nil, the frame title for the box is "Information", -otherwise it is "Question". - -If the user gets rid of the dialog box without making a valid choice, -for instance using the window manager, then this produces a quit and -`x-popup-dialog' does not return. */) - (Lisp_Object position, Lisp_Object contents, Lisp_Object header) -{ - struct frame *f = NULL; - Lisp_Object window; - - /* Decode the first argument: find the window or frame to use. */ - if (EQ (position, Qt) - || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) - || EQ (XCAR (position), Qtool_bar)))) - { -#if 0 /* Using the frame the mouse is on may not be right. */ - /* Use the mouse's current position. */ - struct frame *new_f = SELECTED_FRAME (); - Lisp_Object bar_window; - enum scroll_bar_part part; - Time time; - Lisp_Object x, y; - - (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); - - if (new_f != 0) - XSETFRAME (window, new_f); - else - window = selected_window; -#endif - window = selected_window; - } - else if (CONSP (position)) - { - Lisp_Object tem = XCAR (position); - if (CONSP (tem)) - window = Fcar (XCDR (position)); - else - { - tem = Fcar (XCDR (position)); /* EVENT_START (position) */ - window = Fcar (tem); /* POSN_WINDOW (tem) */ - } - } - else if (WINDOWP (position) || FRAMEP (position)) - window = position; - else - window = Qnil; - - /* Decode where to put the menu. */ - - if (FRAMEP (window)) - f = XFRAME (window); - else if (WINDOWP (window)) - { - CHECK_LIVE_WINDOW (window); - f = XFRAME (WINDOW_FRAME (XWINDOW (window))); - } - else - /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, - but I don't want to make one now. */ - CHECK_WINDOW (window); - - check_window_system (f); - - /* Force a redisplay before showing the dialog. If a frame is created - just before showing the dialog, its contents may not have been fully - drawn, as this depends on timing of events from the X server. Redisplay - is not done when a dialog is shown. If redisplay could be done in the - X event loop (i.e. the X event loop does not run in a signal handler) - this would not be needed. - - Do this before creating the widget value that points to Lisp - string contents, because Fredisplay may GC and relocate them. */ - Fredisplay (Qt); - -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) - /* Display a menu with these alternatives - in the middle of frame F. */ - { - Lisp_Object x, y, frame, newpos; - XSETFRAME (frame, f); - XSETINT (x, FRAME_PIXEL_WIDTH (f) / 2); - XSETINT (y, FRAME_PIXEL_HEIGHT (f) / 2); - newpos = list2 (list2 (x, y), frame); - - return Fx_popup_menu (newpos, - list2 (Fcar (contents), contents)); - } -#else - { - Lisp_Object title; - const char *error_name; - Lisp_Object selection; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); - - /* Decode the dialog items from what was specified. */ - title = Fcar (contents); - CHECK_STRING (title); - record_unwind_protect_void (unuse_menu_items); - - if (NILP (Fcar (Fcdr (contents)))) - /* No buttons specified, add an "Ok" button so users can pop down - the dialog. Also, the lesstif/motif version crashes if there are - no buttons. */ - contents = list2 (title, Fcons (build_string ("Ok"), Qt)); - - list_of_panes (list1 (contents)); - - /* Display them in a dialog box. */ - block_input (); - selection = xdialog_show (f, 0, title, header, &error_name); - unblock_input (); - - unbind_to (specpdl_count, Qnil); - discard_menu_items (); - - if (error_name) error ("%s", error_name); - return selection; - } -#endif -} - - #ifndef MSDOS #if defined USE_GTK || defined USE_MOTIF @@ -1618,6 +1475,8 @@ return Qnil; } + block_input (); + /* Create a tree of widget_value objects representing the panes and their items. */ wv = xmalloc_widget_value (); @@ -1857,6 +1716,7 @@ if (!NILP (subprefix_stack[j])) entry = Fcons (subprefix_stack[j], entry); } + unblock_input (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -1864,9 +1724,13 @@ } } else if (!for_click) - /* Make "Cancel" equivalent to C-g. */ - Fsignal (Qquit, Qnil); + { + unblock_input (); + /* Make "Cancel" equivalent to C-g. */ + Fsignal (Qquit, Qnil); + } + unblock_input (); return Qnil; } @@ -2163,6 +2027,41 @@ return Qnil; } +Lisp_Object +xw_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) +{ + Lisp_Object title; + const char *error_name; + Lisp_Object selection; + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + + check_window_system (f); + + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title); + record_unwind_protect_void (unuse_menu_items); + + if (NILP (Fcar (Fcdr (contents)))) + /* No buttons specified, add an "Ok" button so users can pop down + the dialog. Also, the lesstif/motif version crashes if there are + no buttons. */ + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); + + list_of_panes (list1 (contents)); + + /* Display them in a dialog box. */ + block_input (); + selection = xdialog_show (f, 0, title, header, &error_name); + unblock_input (); + + unbind_to (specpdl_count, Qnil); + discard_menu_items (); + + if (error_name) error ("%s", error_name); + return selection; +} + #else /* not USE_X_TOOLKIT && not USE_GTK */ /* The frame of the last activated non-toolkit menu bar. @@ -2261,6 +2160,8 @@ return Qnil; } + block_input (); + /* Figure out which root window F is on. */ XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root, &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, @@ -2271,6 +2172,7 @@ if (menu == NULL) { *error_name = "Can't create menu"; + unblock_input (); return Qnil; } @@ -2314,6 +2216,7 @@ { XMenuDestroy (FRAME_X_DISPLAY (f), menu); *error_name = "Can't create pane"; + unblock_input (); return Qnil; } i += MENU_ITEMS_PANE_LENGTH; @@ -2378,6 +2281,7 @@ { XMenuDestroy (FRAME_X_DISPLAY (f), menu); *error_name = "Can't add selection to menu"; + unblock_input (); return Qnil; } i += MENU_ITEMS_ITEM_LENGTH; @@ -2504,10 +2408,14 @@ /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means the menu was invoked with a mouse event as POSITION). */ if (! for_click) - Fsignal (Qquit, Qnil); + { + unblock_input (); + Fsignal (Qquit, Qnil); + } break; } + unblock_input (); unbind_to (specpdl_count, Qnil); return entry; @@ -2515,8 +2423,6 @@ #endif /* not USE_X_TOOLKIT */ -#endif /* HAVE_MENUS */ - #ifndef MSDOS /* Detect if a dialog or menu has been posted. MSDOS has its own implementation on msdos.c. */ @@ -2558,8 +2464,4 @@ Ffset (intern_c_string ("accelerate-menu"), intern_c_string (Sx_menu_bar_open_internal.symbol_name)); #endif - -#ifdef HAVE_MENUS - defsubr (&Sx_popup_dialog); -#endif } === modified file 'src/xterm.h' --- src/xterm.h 2013-09-19 07:48:53 +0000 +++ src/xterm.h 2013-09-29 18:38:56 +0000 @@ -1035,6 +1035,10 @@ /* Defined in xmenu.c */ +#if defined USE_X_TOOLKIT || defined USE_GTK +extern Lisp_Object xw_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +#endif + #if defined USE_GTK || defined USE_MOTIF extern void x_menu_set_in_use (int); #endif ------------------------------------------------------------ revno: 114581 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 10:57:18 -0400 message: * lisp/emacs-lisp/lisp-mode.el: Font-lock cl-lib constructs. (lisp-el-font-lock-keywords, lisp-el-font-lock-keywords-1) (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords) (lisp-cl-font-lock-keywords-1, lisp-cl-font-lock-keywords-2): New constants. (lisp-mode-variables): New `elisp' argument. (emacs-lisp-mode): Use it. * lisp/font-lock.el (lisp-font-lock-keywords, lisp-font-lock-keywords-1) (lisp-font-lock-keywords-2): Move to lisp-mode.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 06:17:49 +0000 +++ lisp/ChangeLog 2013-10-08 14:57:18 +0000 @@ -1,5 +1,15 @@ 2013-10-08 Stefan Monnier + * emacs-lisp/lisp-mode.el: Font-lock cl-lib constructs. + (lisp-el-font-lock-keywords, lisp-el-font-lock-keywords-1) + (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords) + (lisp-cl-font-lock-keywords-1, lisp-cl-font-lock-keywords-2): + New constants. + (lisp-mode-variables): New `elisp' argument. + (emacs-lisp-mode): Use it. + * font-lock.el (lisp-font-lock-keywords, lisp-font-lock-keywords-1) + (lisp-font-lock-keywords-2): Move to lisp-mode.el. + * indent.el: Use lexical-binding. (indent-region): Add progress reporter. (tab-stop-list): Make it implicitly extend to infinity by repeating the === modified file 'lisp/emacs-lisp/lisp-mode.el' --- lisp/emacs-lisp/lisp-mode.el 2013-10-07 05:11:50 +0000 +++ lisp/emacs-lisp/lisp-mode.el 2013-10-08 14:57:18 +0000 @@ -153,6 +153,242 @@ (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") + +;;;; Font-lock support. + +(pcase-let + ((`(,vdefs ,tdefs + ,el-defs-re ,cl-defs-re + ,el-kws-re ,cl-kws-re + ,el-errs-re ,cl-errs-re) + (eval-when-compile + (let ((lisp-fdefs '("defmacro" "defsubst" "defun")) + (lisp-vdefs '("defvar")) + (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" + "prog2" "lambda" "unwind-protect" "condition-case" + "when" "unless" "with-output-to-string" + "ignore-errors" "dotimes" "dolist" "declare")) + (lisp-errs '("warn" "error" "signal")) + ;; Elisp constructs. FIXME: update dynamically from obarray. + (el-fdefs '("defadvice" "defalias" + "define-derived-mode" "define-minor-mode" + "define-generic-mode" "define-global-minor-mode" + "define-globalized-minor-mode" "define-skeleton" + "define-widget")) + (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" + "defface")) + (el-tdefs '("defgroup" "deftheme")) + (el-kw '("while-no-input" "letrec" "pcase" "pcase-let" + "pcase-let*" "save-restriction" "save-excursion" + "save-selected-window" + ;; "eval-after-load" "eval-next-after-load" + "save-window-excursion" "save-current-buffer" + "save-match-data" "combine-after-change-calls" + "condition-case-unless-debug" "track-mouse" + "eval-and-compile" "eval-when-compile" "with-case-table" + "with-category-table" "with-coding-priority" + "with-current-buffer" "with-demoted-errors" + "with-electric-help" "with-eval-after-load" + "with-local-quit" "with-no-warnings" + "with-output-to-temp-buffer" "with-selected-window" + "with-selected-frame" "with-silent-modifications" + "with-syntax-table" "with-temp-buffer" "with-temp-file" + "with-temp-message" "with-timeout" + "with-timeout-handler")) + (el-errs '("user-error")) + ;; Common-Lisp constructs supported by EIEIO. FIXME: namespace. + (eieio-fdefs '("defgeneric" "defmethod")) + (eieio-tdefs '("defclass")) + (eieio-kw '("with-slots")) + ;; Common-Lisp constructs supported by cl-lib. + (cl-lib-fdefs '("defmacro" "defsubst" "defun")) + (cl-lib-tdefs '("defstruct" "deftype")) + (cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase" + "etypecase" "ccase" "ctypecase" "loop" "do" "do*" + "the" "locally" "proclaim" "declaim" "letf" "go" + ;; "lexical-let" "lexical-let*" + "symbol-macrolet" "flet" "destructuring-bind" + "labels" "macrolet" "tagbody" "multiple-value-bind" + "block" "return" "return-from")) + (cl-lib-errs '("assert" "check-type")) + ;; Common-Lisp constructs not supported by cl-lib. + (cl-fdefs '("defsetf" "define-method-combination" + "define-condition" "define-setf-expander" + ;; "define-function"?? + "define-compiler-macro" "define-modify-macro")) + (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter")) + (cl-tdefs '("defpackage" "defstruct" "deftype")) + (cl-kw '("prog" "prog*" "handler-case" "handler-bind" + "in-package" "restart-case" ;; "inline" + "restart-bind" "break" "multiple-value-prog1" + "compiler-let" "with-accessors" "with-compilation-unit" + "with-condition-restarts" "with-hash-table-iterator" + "with-input-from-string" "with-open-file" + "with-open-stream" "with-package-iterator" + "with-simple-restart" "with-standard-io-syntax")) + (cl-errs '("abort" "cerror"))) + + (list (append lisp-vdefs el-vdefs cl-vdefs) + (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs + (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs)) + + ;; Elisp and Common Lisp definers. + (regexp-opt (append lisp-fdefs lisp-vdefs + el-fdefs el-vdefs el-tdefs + (mapcar (lambda (s) (concat "cl-" s)) + (append cl-lib-fdefs cl-lib-tdefs)) + eieio-fdefs eieio-tdefs) + t) + (regexp-opt (append lisp-fdefs lisp-vdefs + cl-lib-fdefs cl-lib-tdefs + eieio-fdefs eieio-tdefs + cl-fdefs cl-vdefs cl-tdefs) + t) + + ;; Elisp and Common Lisp keywords. + (regexp-opt (append + lisp-kw el-kw eieio-kw + (cons "go" (mapcar (lambda (s) (concat "cl-" s)) + (remove "go" cl-lib-kw)))) + t) + (regexp-opt (append lisp-kw el-kw eieio-kw + (cons "go" (mapcar (lambda (s) (concat "cl-" s)) + (remove "go" cl-kw)))) + t) + + ;; Elisp and Common Lisp "errors". + (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s)) + cl-lib-errs) + lisp-errs el-errs) + t) + (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t)))))) + + (dolist (v vdefs) + (put (intern v) 'lisp-define-type 'var)) + (dolist (v tdefs) + (put (intern v) 'lisp-define-type 'type)) + + (define-obsolete-variable-alias 'lisp-font-lock-keywords-1 + 'lisp-el-font-lock-keywords-1 "24.4") + (defconst lisp-el-font-lock-keywords-1 + `( ;; Definitions. + (,(concat "(" el-defs-re "\\_>" + ;; Any whitespace and defined object. + "[ \t'\(]*" + "\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) + (t font-lock-function-name-face))) + nil t)) + ;; Emacs Lisp autoload cookies. Supports the slightly different + ;; forms used by mh-e, calendar, etc. + ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)) + "Subdued level highlighting for Emacs Lisp mode.") + + (defconst lisp-cl-font-lock-keywords-1 + `( ;; Definitions. + (,(concat "(" cl-defs-re "\\_>" + ;; Any whitespace and defined object. + "[ \t'\(]*" + "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) + (cond ((eq type 'var) font-lock-variable-name-face) + ((eq type 'type) font-lock-type-face) + (t font-lock-function-name-face))) + nil t))) + "Subdued level highlighting for Lisp modes.") + + (define-obsolete-variable-alias 'lisp-font-lock-keywords-2 + 'lisp-el-font-lock-keywords-2 "24.4") + (defconst lisp-el-font-lock-keywords-2 + (append + lisp-el-font-lock-keywords-1 + `( ;; Regexp negated char group. + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) + ;; Control structures. Common Lisp forms. + (,(concat "(" el-kws-re "\\_>") . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" + "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + (,(concat "(" el-errs-re "\\_>") + (1 font-lock-warning-face)) + ;; Words inside \\[] tend to be for `substitute-command-keys'. + ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" + (1 font-lock-constant-face prepend)) + ;; Words inside `' tend to be symbol names. + ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" + (1 font-lock-constant-face prepend)) + ;; Constant values. + ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) + ;; ELisp regexp grouping constructs + (,(lambda (bound) + (catch 'found + ;; The following loop is needed to continue searching after matches + ;; that do not occur in strings. The associated regexp matches one + ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to + ;; avoid highlighting, for example, `\\(' in `\\\\('. + (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) + (unless (match-beginning 2) + (let ((face (get-text-property (1- (point)) 'face))) + (when (or (and (listp face) + (memq 'font-lock-string-face face)) + (eq 'font-lock-string-face face)) + (throw 'found t))))))) + (1 'font-lock-regexp-grouping-backslash prepend) + (3 'font-lock-regexp-grouping-construct prepend)) + ;; This is too general -- rms. + ;; A user complained that he has functions whose names start with `do' + ;; and that they get the wrong color. + ;; ;; CL `with-' and `do-' constructs + ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + )) + "Gaudy level highlighting for Emacs Lisp mode.") + + (defconst lisp-cl-font-lock-keywords-2 + (append + lisp-cl-font-lock-keywords-1 + `( ;; Regexp negated char group. + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) + ;; Control structures. Common Lisp forms. + (,(concat "(" cl-kws-re "\\_>") . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" + "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + (,(concat "(" cl-errs-re "\\_>") + (1 font-lock-warning-face)) + ;; Words inside `' tend to be symbol names. + ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" + (1 font-lock-constant-face prepend)) + ;; Constant values. + ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) + ;; This is too general -- rms. + ;; A user complained that he has functions whose names start with `do' + ;; and that they get the wrong color. + ;; ;; CL `with-' and `do-' constructs + ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + )) + "Gaudy level highlighting for Lisp modes.")) + +(define-obsolete-variable-alias 'lisp-font-lock-keywords + 'lisp-el-font-lock-keywords "24.4") +(defvar lisp-el-font-lock-keywords lisp-el-font-lock-keywords-1 + "Default expressions to highlight in Emacs Lisp mode.") +(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 + "Default expressions to highlight in Lisp modes.") + (defun lisp-font-lock-syntactic-face-function (state) (if (nth 3 state) ;; This might be a (doc)string or a |...| symbol. @@ -190,7 +426,8 @@ font-lock-string-face)))) font-lock-comment-face)) -(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive) +(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive + elisp) "Common initialization routine for lisp modes. The LISP-SYNTAX argument is used by code in inf-lisp.el and is \(uselessly) passed from pp.el, chistory.el, gnus-kill.el and @@ -227,9 +464,12 @@ (setq-local multibyte-syntax-as-symbol t) (setq-local syntax-begin-function 'beginning-of-defun) (setq font-lock-defaults - `((lisp-font-lock-keywords - lisp-font-lock-keywords-1 - lisp-font-lock-keywords-2) + `(,(if elisp '(lisp-el-font-lock-keywords + lisp-el-font-lock-keywords-1 + lisp-el-font-lock-keywords-2) + '(lisp-cl-font-lock-keywords + lisp-cl-font-lock-keywords-1 + lisp-cl-font-lock-keywords-2)) nil ,keywords-case-insensitive nil nil (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function @@ -466,7 +706,7 @@ Entry to this mode calls the value of `emacs-lisp-mode-hook' if that value is non-nil." :group 'lisp - (lisp-mode-variables) + (lisp-mode-variables nil nil 'elisp) (setq imenu-case-fold-search nil) (add-hook 'completion-at-point-functions 'lisp-completion-at-point nil 'local)) === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2013-06-21 06:37:44 +0000 +++ lisp/font-lock.el 2013-10-08 14:57:18 +0000 @@ -2240,131 +2240,6 @@ for C preprocessor directives. This definition is for the other modes in which C preprocessor directives are used. e.g. `asm-mode' and `ld-script-mode'.") - - -;; Lisp. - -(defconst lisp-font-lock-keywords-1 - (eval-when-compile - `(;; Definitions. - (,(concat "(\\(def\\(" - ;; Function declarations. - "\\(advice\\|alias\\|generic\\|macro\\*?\\|method\\|" - "setf\\|subst\\*?\\|un\\*?\\|" - "ine-\\(condition\\|" - "\\(?:derived\\|\\(?:global\\(?:ized\\)?-\\)?minor\\|generic\\)-mode\\|" - "method-combination\\|setf-expander\\|skeleton\\|widget\\|" - "function\\|\\(compiler\\|modify\\|symbol\\)-macro\\)\\)\\|" - ;; Variable declarations. - "\\(const\\(ant\\)?\\|custom\\|varalias\\|face\\|parameter\\|var\\(?:-local\\)?\\)\\|" - ;; Structure declarations. - "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)" - "\\)\\)\\_>" - ;; Any whitespace and defined object. - "[ \t'\(]*" - "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (9 (cond ((match-beginning 3) font-lock-function-name-face) - ((match-beginning 6) font-lock-variable-name-face) - (t font-lock-type-face)) - nil t)) - ;; Emacs Lisp autoload cookies. Supports the slightly different - ;; forms used by mh-e, calendar, etc. - ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend) - ;; Regexp negated char group. - ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) - "Subdued level highlighting for Lisp modes.") - -(defconst lisp-font-lock-keywords-2 - (append lisp-font-lock-keywords-1 - (eval-when-compile - `(;; Control structures. Emacs Lisp forms. - (,(concat - "(" (regexp-opt - '("cond" "if" "while" "while-no-input" "let" "let*" "letrec" - "pcase" "pcase-let" "pcase-let*" "prog" "progn" "progv" - "prog1" "prog2" "prog*" "inline" "lambda" - "save-restriction" "save-excursion" "save-selected-window" - "save-window-excursion" "save-match-data" "save-current-buffer" - "combine-after-change-calls" "unwind-protect" - "condition-case" "condition-case-unless-debug" - "track-mouse" "eval-after-load" "eval-and-compile" - "eval-when-compile" "eval-when" "eval-next-after-load" - "with-case-table" "with-category-table" "with-coding-priority" - "with-current-buffer" "with-demoted-errors" - "with-electric-help" "with-eval-after-load" - "with-local-quit" "with-no-warnings" - "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-selected-frame" - "with-silent-modifications" "with-syntax-table" - "with-temp-buffer" "with-temp-file" "with-temp-message" - "with-timeout" "with-timeout-handler") t) - "\\_>") - . 1) - ;; Control structures. Common Lisp forms. - (,(concat - "(" (regexp-opt - '("when" "unless" "case" "ecase" "typecase" "etypecase" - "ccase" "ctypecase" "handler-case" "handler-bind" - "restart-bind" "restart-case" "in-package" - "break" "ignore-errors" - "loop" "do" "do*" "dotimes" "dolist" "the" "locally" - "proclaim" "declaim" "declare" "symbol-macrolet" "letf" - "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" - "destructuring-bind" "macrolet" "tagbody" "block" "go" - "multiple-value-bind" "multiple-value-prog1" - "return" "return-from" - "with-accessors" "with-compilation-unit" - "with-condition-restarts" "with-hash-table-iterator" - "with-input-from-string" "with-open-file" - "with-open-stream" "with-output-to-string" - "with-package-iterator" "with-simple-restart" - "with-slots" "with-standard-io-syntax") t) - "\\_>") - . 1) - ;; Exit/Feature symbols as constants. - (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" - "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-constant-face nil t)) - ;; Erroneous structures. - ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|\\(?:user-\\)?error\\|signal\\)\\_>" 1 font-lock-warning-face) - ;; Words inside \\[] tend to be for `substitute-command-keys'. - ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" - (1 font-lock-constant-face prepend)) - ;; Words inside `' tend to be symbol names. - ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'" - (1 font-lock-constant-face prepend)) - ;; Constant values. - ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face) - ;; ELisp and CLisp `&' keywords as types. - ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face) - ;; ELisp regexp grouping constructs - ((lambda (bound) - (catch 'found - ;; The following loop is needed to continue searching after matches - ;; that do not occur in strings. The associated regexp matches one - ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to - ;; avoid highlighting, for example, `\\(' in `\\\\('. - (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) - (unless (match-beginning 2) - (let ((face (get-text-property (1- (point)) 'face))) - (when (or (and (listp face) - (memq 'font-lock-string-face face)) - (eq 'font-lock-string-face face)) - (throw 'found t))))))) - (1 'font-lock-regexp-grouping-backslash prepend) - (3 'font-lock-regexp-grouping-construct prepend)) - ;; This is too general -- rms. - ;; A user complained that he has functions whose names start with `do' - ;; and that they get the wrong color. - ;; ;; CL `with-' and `do-' constructs - ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) - ))) - "Gaudy level highlighting for Lisp modes.") - -(defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 - "Default expressions to highlight in Lisp modes.") (provide 'font-lock) ------------------------------------------------------------ revno: 114580 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-10-08 18:56:15 +0400 message: * dispnew.c (set_window_update_flags): Add buffer arg. Adjust comment. (redraw_frame, update_frame): Adjust users. * dispextern.h (set_window_update_flags): Adjust prototype. * xdisp.c (redisplay_internal): When updating all frames with zero windows_or_buffers_changed, assume that only the windows that shows current buffer should be really updated. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 06:40:09 +0000 +++ src/ChangeLog 2013-10-08 14:56:15 +0000 @@ -1,5 +1,14 @@ 2013-10-08 Dmitry Antipov + * dispnew.c (set_window_update_flags): Add buffer arg. Adjust comment. + (redraw_frame, update_frame): Adjust users. + * dispextern.h (set_window_update_flags): Adjust prototype. + * xdisp.c (redisplay_internal): When updating all frames with zero + windows_or_buffers_changed, assume that only the windows that shows + current buffer should be really updated. + +2013-10-08 Dmitry Antipov + Do not allocate huge temporary memory areas and objects while encoding for file I/O, thus reducing an enormous memory usage for large buffers. See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html. === modified file 'src/dispextern.h' --- src/dispextern.h 2013-09-24 05:42:30 +0000 +++ src/dispextern.h 2013-10-08 14:56:15 +0000 @@ -3460,7 +3460,7 @@ void clear_glyph_matrix_rows (struct glyph_matrix *, int, int); void clear_glyph_row (struct glyph_row *); void prepare_desired_row (struct glyph_row *); -void set_window_update_flags (struct window *, bool); +void set_window_update_flags (struct window *, struct buffer *, bool); void update_single_window (struct window *, bool); void do_pending_window_change (bool); void change_frame_size (struct frame *, int, int, bool, bool, bool); === modified file 'src/dispnew.c' --- src/dispnew.c 2013-09-24 15:29:27 +0000 +++ src/dispnew.c 2013-10-08 14:56:15 +0000 @@ -2910,7 +2910,7 @@ /* Mark all windows as inaccurate, so that every window will have its redisplay done. */ mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0); - set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), 1); + set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), NULL, 1); f->garbaged = 0; } @@ -3041,7 +3041,7 @@ do_pause: /* Reset flags indicating that a window should be updated. */ - set_window_update_flags (root_window, 0); + set_window_update_flags (root_window, NULL, 0); display_completed = !paused_p; return paused_p; @@ -3820,17 +3820,18 @@ } -/* Set WINDOW->must_be_updated_p to ON_P for all windows in the window - tree rooted at W. */ +/* If B is NULL, set WINDOW->must_be_updated_p to ON_P for all windows in + the window tree rooted at W. Otherwise set WINDOW->must_be_updated_p + to ON_P only for windows that displays B. */ void -set_window_update_flags (struct window *w, bool on_p) +set_window_update_flags (struct window *w, struct buffer *b, bool on_p) { while (w) { if (WINDOWP (w->contents)) - set_window_update_flags (XWINDOW (w->contents), on_p); - else + set_window_update_flags (XWINDOW (w->contents), b, on_p); + else if (!(b && b != XBUFFER (w->contents))) w->must_be_updated_p = on_p; w = NILP (w->next) ? 0 : XWINDOW (w->next); === modified file 'src/xdisp.c' --- src/xdisp.c 2013-10-07 15:11:17 +0000 +++ src/xdisp.c 2013-10-08 14:56:15 +0000 @@ -13437,8 +13437,13 @@ unrequest_sigio (); STOP_POLLING; - /* Update the display. */ - set_window_update_flags (XWINDOW (f->root_window), 1); + /* Mark windows on frame F to update. If we decide to + update all frames but windows_or_buffers_changed is + zero, we assume that only the windows that shows + current buffer should be really updated. */ + set_window_update_flags + (XWINDOW (f->root_window), + (windows_or_buffers_changed ? NULL : current_buffer), 1); pending |= update_frame (f, 0, 0); f->cursor_type_changed = 0; f->updated_p = 1; ------------------------------------------------------------ revno: 114579 committer: Glenn Morris branch nick: trunk timestamp: Tue 2013-10-08 06:17:43 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/Makefile.in' --- autogen/Makefile.in 2013-10-05 10:17:33 +0000 +++ autogen/Makefile.in 2013-10-08 10:17:43 +0000 @@ -36,7 +36,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=dup --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings memrchr mktime pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings # Copyright (C) 2002-2013 Free Software Foundation, Inc. # @@ -59,7 +59,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -112,10 +112,11 @@ @BUILDING_FOR_WINDOWSNT_TRUE@ $(STDBOOL_H) $(STDDEF_H) \ @BUILDING_FOR_WINDOWSNT_TRUE@ $(STDINT_H) @BUILDING_FOR_WINDOWSNT_TRUE@am__append_4 = alloca.in.h byteswap.in.h \ -@BUILDING_FOR_WINDOWSNT_TRUE@ close-stream.h md5.h sha1.h \ -@BUILDING_FOR_WINDOWSNT_TRUE@ sha256.h sha512.h dosname.h \ -@BUILDING_FOR_WINDOWSNT_TRUE@ ftoastr.c ftoastr.h dup2.c \ -@BUILDING_FOR_WINDOWSNT_TRUE@ errno.in.h euidaccess.c \ +@BUILDING_FOR_WINDOWSNT_TRUE@ close-stream.h count-one-bits.h \ +@BUILDING_FOR_WINDOWSNT_TRUE@ count-trailing-zeros.h md5.h \ +@BUILDING_FOR_WINDOWSNT_TRUE@ sha1.h sha256.h sha512.h \ +@BUILDING_FOR_WINDOWSNT_TRUE@ dosname.h ftoastr.c ftoastr.h \ +@BUILDING_FOR_WINDOWSNT_TRUE@ dup2.c errno.in.h euidaccess.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ execinfo.c execinfo.in.h \ @BUILDING_FOR_WINDOWSNT_TRUE@ at-func.c faccessat.c fdatasync.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ fdopendir.c filemode.h fpending.c \ @@ -192,16 +193,17 @@ @BUILDING_FOR_WINDOWSNT_FALSE@am__append_9 = alloca.in.h allocator.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ openat-priv.h openat-proc.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ byteswap.in.h careadlinkat.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ close-stream.h md5.h sha1.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ sha256.h sha512.h dirent.in.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ dosname.h ftoastr.c ftoastr.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ dup2.c errno.in.h euidaccess.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ execinfo.c execinfo.in.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ at-func.c faccessat.c fcntl.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fcntl.in.h fdatasync.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fdopendir.c filemode.h \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fpending.c fpending.h at-func.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ fstatat.c fsync.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ close-stream.h count-one-bits.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ count-trailing-zeros.h md5.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ sha1.h sha256.h sha512.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ dirent.in.h dosname.h ftoastr.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ ftoastr.h dup2.c errno.in.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ euidaccess.c execinfo.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ execinfo.in.h at-func.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ faccessat.c fcntl.c fcntl.in.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ fdatasync.c fdopendir.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ filemode.h fpending.c fpending.h \ +@BUILDING_FOR_WINDOWSNT_FALSE@ at-func.c fstatat.c fsync.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ getdtablesize.c getgroups.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ getloadavg.c getopt.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ getopt.in.h getopt1.c \ @@ -243,10 +245,13 @@ $(top_srcdir)/m4/acl.m4 $(top_srcdir)/m4/alloca.m4 \ $(top_srcdir)/m4/byteswap.m4 $(top_srcdir)/m4/c-strtod.m4 \ $(top_srcdir)/m4/clock_time.m4 \ - $(top_srcdir)/m4/close-stream.m4 $(top_srcdir)/m4/dirent_h.m4 \ - $(top_srcdir)/m4/dup2.m4 $(top_srcdir)/m4/environ.m4 \ - $(top_srcdir)/m4/errno_h.m4 $(top_srcdir)/m4/euidaccess.m4 \ - $(top_srcdir)/m4/execinfo.m4 $(top_srcdir)/m4/extensions.m4 \ + $(top_srcdir)/m4/close-stream.m4 \ + $(top_srcdir)/m4/count-one-bits.m4 \ + $(top_srcdir)/m4/count-trailing-zeros.m4 \ + $(top_srcdir)/m4/dirent_h.m4 $(top_srcdir)/m4/dup2.m4 \ + $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/errno_h.m4 \ + $(top_srcdir)/m4/euidaccess.m4 $(top_srcdir)/m4/execinfo.m4 \ + $(top_srcdir)/m4/extensions.m4 \ $(top_srcdir)/m4/extern-inline.m4 \ $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl.m4 \ $(top_srcdir)/m4/fcntl_h.m4 $(top_srcdir)/m4/fdatasync.m4 \ @@ -303,7 +308,8 @@ am__DEPENDENCIES_1 = am__libgnu_a_SOURCES_DIST = allocator.c binary-io.h binary-io.c \ c-ctype.h c-ctype.c c-strcase.h c-strcasecmp.c c-strncasecmp.c \ - careadlinkat.c close-stream.c md5.c sha1.c sha256.c sha512.c \ + careadlinkat.c close-stream.c count-one-bits.c \ + count-trailing-zeros.c md5.c sha1.c sha256.c sha512.c \ dtoastr.c dtotimespec.c filemode.c gettext.h gettime.c pipe2.c \ acl-errno-valid.c file-has-acl.c qcopy-acl.c qset-acl.c \ stat-time.c strftime.c tempname.c timespec.c timespec-add.c \ @@ -319,6 +325,8 @@ @BUILDING_FOR_WINDOWSNT_FALSE@ c-strncasecmp.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ careadlinkat.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ close-stream.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_FALSE@ count-one-bits.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_FALSE@ count-trailing-zeros.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ md5.$(OBJEXT) sha1.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ sha256.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_FALSE@ sha512.$(OBJEXT) \ @@ -346,6 +354,8 @@ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strcasecmp.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strncasecmp.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ close-stream.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_TRUE@ count-one-bits.$(OBJEXT) \ +@BUILDING_FOR_WINDOWSNT_TRUE@ count-trailing-zeros.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ md5.$(OBJEXT) sha1.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ sha256.$(OBJEXT) sha512.$(OBJEXT) \ @BUILDING_FOR_WINDOWSNT_TRUE@ dtoastr.$(OBJEXT) \ @@ -1260,7 +1270,9 @@ @BUILDING_FOR_WINDOWSNT_FALSE@ c-ctype.h c-ctype.c c-strcase.h \ @BUILDING_FOR_WINDOWSNT_FALSE@ c-strcasecmp.c c-strncasecmp.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ careadlinkat.c close-stream.c \ -@BUILDING_FOR_WINDOWSNT_FALSE@ md5.c sha1.c sha256.c sha512.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ count-one-bits.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ count-trailing-zeros.c md5.c \ +@BUILDING_FOR_WINDOWSNT_FALSE@ sha1.c sha256.c sha512.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ dtoastr.c dtotimespec.c \ @BUILDING_FOR_WINDOWSNT_FALSE@ filemode.c $(am__append_10) \ @BUILDING_FOR_WINDOWSNT_FALSE@ gettime.c pipe2.c \ @@ -1274,7 +1286,9 @@ @BUILDING_FOR_WINDOWSNT_TRUE@libgnu_a_SOURCES = c-ctype.h c-ctype.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strcase.h c-strcasecmp.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ c-strncasecmp.c close-stream.c \ -@BUILDING_FOR_WINDOWSNT_TRUE@ md5.c sha1.c sha256.c sha512.c \ +@BUILDING_FOR_WINDOWSNT_TRUE@ count-one-bits.c \ +@BUILDING_FOR_WINDOWSNT_TRUE@ count-trailing-zeros.c md5.c \ +@BUILDING_FOR_WINDOWSNT_TRUE@ sha1.c sha256.c sha512.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ dtoastr.c dtotimespec.c \ @BUILDING_FOR_WINDOWSNT_TRUE@ filemode.c $(am__append_5) \ @BUILDING_FOR_WINDOWSNT_TRUE@ gettime.c acl-errno-valid.c \ @@ -1397,6 +1411,8 @@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close-stream.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count-one-bits.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count-trailing-zeros.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@ === modified file 'autogen/aclocal.m4' --- autogen/aclocal.m4 2013-10-04 10:17:40 +0000 +++ autogen/aclocal.m4 2013-10-08 10:17:43 +0000 @@ -991,6 +991,8 @@ m4_include([m4/c-strtod.m4]) m4_include([m4/clock_time.m4]) m4_include([m4/close-stream.m4]) +m4_include([m4/count-one-bits.m4]) +m4_include([m4/count-trailing-zeros.m4]) m4_include([m4/dirent_h.m4]) m4_include([m4/dup2.m4]) m4_include([m4/environ.m4]) === modified file 'autogen/configure' --- autogen/configure 2013-10-04 10:17:40 +0000 +++ autogen/configure 2013-10-08 10:17:43 +0000 @@ -7296,6 +7296,8 @@ # Code from module careadlinkat: # Code from module clock-time: # Code from module close-stream: + # Code from module count-one-bits: + # Code from module count-trailing-zeros: # Code from module crypto/md5: # Code from module crypto/sha1: # Code from module crypto/sha256: @@ -17863,6 +17865,63 @@ + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 +$as_echo_n "checking for unsigned long long int... " >&6; } +if test "${ac_cv_type_unsigned_long_long_int+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_type_unsigned_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* For now, do not test the preprocessor; as of 2007 there are too many + implementations with broken preprocessors. Perhaps this can + be revisited in 2012. In the meantime, code should not expect + #if to work with literals wider than 32 bits. */ + /* Test literals. */ + long long int ll = 9223372036854775807ll; + long long int nll = -9223372036854775807LL; + unsigned long long int ull = 18446744073709551615ULL; + /* Test constant expressions. */ + typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) + ? 1 : -1)]; + typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 + ? 1 : -1)]; + int i = 63; +int +main () +{ +/* Test availability of runtime routines for shift and division. */ + long long int llmax = 9223372036854775807ll; + unsigned long long int ullmax = 18446744073709551615ull; + return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) + | (llmax / ll) | (llmax % ll) + | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) + | (ullmax / ull) | (ullmax % ull)); + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +else + ac_cv_type_unsigned_long_long_int=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_unsigned_long_long_int" >&5 +$as_echo "$ac_cv_type_unsigned_long_long_int" >&6; } + if test $ac_cv_type_unsigned_long_long_int = yes; then + +$as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 $as_echo_n "checking whether byte ordering is bigendian... " >&6; } if test "${ac_cv_c_bigendian+set}" = set; then : @@ -19976,63 +20035,6 @@ - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 -$as_echo_n "checking for unsigned long long int... " >&6; } -if test "${ac_cv_type_unsigned_long_long_int+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_type_unsigned_long_long_int=yes - if test "x${ac_cv_prog_cc_c99-no}" = xno; then - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - /* For now, do not test the preprocessor; as of 2007 there are too many - implementations with broken preprocessors. Perhaps this can - be revisited in 2012. In the meantime, code should not expect - #if to work with literals wider than 32 bits. */ - /* Test literals. */ - long long int ll = 9223372036854775807ll; - long long int nll = -9223372036854775807LL; - unsigned long long int ull = 18446744073709551615ULL; - /* Test constant expressions. */ - typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) - ? 1 : -1)]; - typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 - ? 1 : -1)]; - int i = 63; -int -main () -{ -/* Test availability of runtime routines for shift and division. */ - long long int llmax = 9223372036854775807ll; - unsigned long long int ullmax = 18446744073709551615ull; - return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) - | (llmax / ll) | (llmax % ll) - | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) - | (ullmax / ull) | (ullmax % ull)); - ; - return 0; -} - -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - -else - ac_cv_type_unsigned_long_long_int=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_unsigned_long_long_int" >&5 -$as_echo "$ac_cv_type_unsigned_long_long_int" >&6; } - if test $ac_cv_type_unsigned_long_long_int = yes; then - -$as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h - - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 $as_echo_n "checking for long long int... " >&6; } @@ -22537,6 +22539,12 @@ + + + + + + : ------------------------------------------------------------ revno: 114578 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-10-08 10:40:09 +0400 message: Do not allocate huge temporary memory areas and objects while encoding for file I/O, thus reducing an enormous memory usage for large buffers. See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html. * coding.h (struct coding_system): New member raw_destination. * coding.c (setup_coding_system): Initialize it to zero. (encode_coding_object): If raw_destination is set, do not create dst_object. Add comment. * fileio.c (toplevel): New constant E_WRITE_MAX. (e_write): Do not encode more than E_WRITE_MAX characters per one loop iteration. Use raw_destination if E_WRITE_MAX characters is encoded. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 06:12:40 +0000 +++ src/ChangeLog 2013-10-08 06:40:09 +0000 @@ -1,3 +1,16 @@ +2013-10-08 Dmitry Antipov + + Do not allocate huge temporary memory areas and objects while encoding + for file I/O, thus reducing an enormous memory usage for large buffers. + See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html. + * coding.h (struct coding_system): New member raw_destination. + * coding.c (setup_coding_system): Initialize it to zero. + (encode_coding_object): If raw_destination is set, do not create + dst_object. Add comment. + * fileio.c (toplevel): New constant E_WRITE_MAX. + (e_write): Do not encode more than E_WRITE_MAX characters per one loop + iteration. Use raw_destination if E_WRITE_MAX characters is encoded. + 2013-10-08 Jan Djärv * nsterm.m (windowDidExitFullScreen:): === modified file 'src/coding.c' --- src/coding.c 2013-08-26 05:20:59 +0000 +++ src/coding.c 2013-10-08 06:40:09 +0000 @@ -5761,6 +5761,7 @@ coding->safe_charsets = SDATA (val); coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs)); coding->carryover_bytes = 0; + coding->raw_destination = 0; coding_type = CODING_ATTR_TYPE (attrs); if (EQ (coding_type, Qundecided)) @@ -8352,6 +8353,11 @@ { if (BUFFERP (coding->dst_object)) coding->dst_object = Fbuffer_string (); + else if (coding->raw_destination) + /* This is used to avoid creating huge Lisp string. + NOTE: caller who sets `raw_destination' is also + responsible for freeing `destination' buffer. */ + coding->dst_object = Qnil; else { coding->dst_object === modified file 'src/coding.h' --- src/coding.h 2013-08-30 12:17:44 +0000 +++ src/coding.h 2013-10-08 06:40:09 +0000 @@ -512,6 +512,10 @@ `charbuf', but at `src_object'. */ unsigned chars_at_source : 1; + /* Nonzero if the result of conversion is in `destination' + buffer rather than in `dst_object'. */ + unsigned raw_destination : 1; + /* Set to 1 if charbuf contains an annotation. */ unsigned annotated : 1; === modified file 'src/fileio.c' --- src/fileio.c 2013-09-11 05:03:23 +0000 +++ src/fileio.c 2013-10-08 06:40:09 +0000 @@ -5263,6 +5263,10 @@ return 1; } +/* Maximum number of characters that the next + function encodes per one loop iteration. */ + +enum { E_WRITE_MAX = 8 * 1024 * 1024 }; /* Write text in the range START and END into descriptor DESC, encoding them with coding system CODING. If STRING is nil, START @@ -5289,9 +5293,16 @@ coding->src_multibyte = SCHARS (string) < SBYTES (string); if (CODING_REQUIRE_ENCODING (coding)) { - encode_coding_object (coding, string, - start, string_char_to_byte (string, start), - end, string_char_to_byte (string, end), Qt); + ptrdiff_t nchars = min (end - start, E_WRITE_MAX); + + /* Avoid creating huge Lisp string in encode_coding_object. */ + if (nchars == E_WRITE_MAX) + coding->raw_destination = 1; + + encode_coding_object + (coding, string, start, string_char_to_byte (string, start), + start + nchars, string_char_to_byte (string, start + nchars), + Qt); } else { @@ -5308,8 +5319,15 @@ coding->src_multibyte = (end - start) < (end_byte - start_byte); if (CODING_REQUIRE_ENCODING (coding)) { - encode_coding_object (coding, Fcurrent_buffer (), - start, start_byte, end, end_byte, Qt); + ptrdiff_t nchars = min (end - start, E_WRITE_MAX); + + /* Likewise. */ + if (nchars == E_WRITE_MAX) + coding->raw_destination = 1; + + encode_coding_object + (coding, Fcurrent_buffer (), start, start_byte, + start + nchars, CHAR_TO_BYTE (start + nchars), Qt); } else { @@ -5330,11 +5348,19 @@ if (coding->produced > 0) { - char *buf = (STRINGP (coding->dst_object) - ? SSDATA (coding->dst_object) - : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)); + char *buf = (coding->raw_destination ? (char *) coding->destination + : (STRINGP (coding->dst_object) + ? SSDATA (coding->dst_object) + : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); coding->produced -= emacs_write_sig (desc, buf, coding->produced); + if (coding->raw_destination) + { + /* We're responsible for freeing this, see + encode_coding_object to check why. */ + xfree (coding->destination); + coding->raw_destination = 0; + } if (coding->produced) return 0; } ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.