Now on revision 104864. ------------------------------------------------------------ revno: 104864 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Sat 2011-07-02 14:27:53 +0200 message: * disp-table.el (display-table-print-array): New function. (describe-display-table): Use it to print the vectors more pretty (Bug#8859). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-07-02 10:36:48 +0000 +++ lisp/ChangeLog 2011-07-02 12:27:53 +0000 @@ -1,3 +1,9 @@ +2011-07-02 Lars Magne Ingebrigtsen + + * disp-table.el (display-table-print-array): New function. + (describe-display-table): Use it to print the vectors more pretty + (Bug#8859). + 2011-07-02 Martin Rudalics * window.el (window-state-get-1): Don't assign clone numbers. === modified file 'lisp/disp-table.el' --- lisp/disp-table.el 2011-01-26 08:36:39 +0000 +++ lisp/disp-table.el 2011-07-02 12:27:53 +0000 @@ -94,9 +94,27 @@ (while (< i 256) (aset vector i (aref dt i)) (setq i (1+ i))) - (describe-vector vector)) + (describe-vector + vector 'display-table-print-array)) (help-mode)))) +(defun display-table-print-array (desc) + (insert "[") + (let ((column (current-column)) + (width (window-width)) + string) + (dotimes (i (length desc)) + (setq string (format "%s" (aref desc i))) + (cond + ((>= (+ (current-column) (length string) 1) + width) + (insert "\n") + (insert (make-string column ? ))) + ((> i 0) + (insert " "))) + (insert string))) + (insert "]\n")) + ;;;###autoload (defun describe-current-display-table () "Describe the display table in use in the selected window and buffer." ------------------------------------------------------------ revno: 104863 committer: martin rudalics branch nick: trunk timestamp: Sat 2011-07-02 12:36:48 +0200 message: Remove clone-number support. Provide clone-of parameter in window states. * window.h (window): Remove clone_number slot. * window.c (Fwindow_clone_number, Fset_window_clone_number): Remove. (make_parent_window, make_window, saved_window) (Fset_window_configuration, save_window_save): Don't deal with clone numbers. * buffer.c (Qclone_number): Remove declaration. (sort_overlays, overlay_strings): Don't deal with clone numbers. * window.el (window-state-get-1): Don't assign clone numbers. Add clone-of item to list of window parameters. (window-state-put-2): Don't process clone numbers. (display-buffer-alist): Fix doc-string. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-07-02 04:27:41 +0000 +++ lisp/ChangeLog 2011-07-02 10:36:48 +0000 @@ -1,3 +1,10 @@ +2011-07-02 Martin Rudalics + + * window.el (window-state-get-1): Don't assign clone numbers. + Add clone-of item to list of window parameters. + (window-state-put-2): Don't process clone numbers. + (display-buffer-alist): Fix doc-string. + 2011-07-02 Stefan Monnier * subr.el (remq): Don't allocate if it's not needed. === modified file 'lisp/window.el' --- lisp/window.el 2011-07-01 06:24:00 +0000 +++ lisp/window.el 2011-07-02 10:36:48 +0000 @@ -3542,7 +3542,6 @@ (window-list-no-nils type (unless (window-next-sibling window) (cons 'last t)) - (cons 'clone-number (window-clone-number window)) (cons 'total-height (window-total-size window)) (cons 'total-width (window-total-size window t)) (cons 'normal-height (window-normal-size window)) @@ -3554,6 +3553,9 @@ (unless (memq (car parameter) window-state-ignored-parameters) (setq list (cons parameter list)))) + (unless (window-parameter window 'clone-of) + ;; Make a clone-of parameter. + (setq list (cons (cons 'clone-of window) list))) (when list (cons 'parameters list))) (when buffer @@ -3694,13 +3696,10 @@ "Helper function for `window-state-put'." (dolist (item window-state-put-list) (let ((window (car item)) - (clone-number (cdr (assq 'clone-number item))) (splits (cdr (assq 'splits item))) (nest (cdr (assq 'nest item))) (parameters (cdr (assq 'parameters item))) (state (cdr (assq 'buffer item)))) - ;; Put in clone-number. - (when clone-number (set-window-clone-number window clone-number)) (when splits (set-window-splits window splits)) (when nest (set-window-nest window nest)) ;; Process parameters. @@ -4100,7 +4099,7 @@ function specified in the second element of the list is responsible for displaying the buffer. `display-buffer' calls this function with the buffer as first argument and the remaining -elements of the list as the other arguments. +elements of the list as the second. The function should choose or create a window, display the buffer in it, and return the window. It is also responsible for giving === modified file 'src/ChangeLog' --- src/ChangeLog 2011-07-02 04:27:41 +0000 +++ src/ChangeLog 2011-07-02 10:36:48 +0000 @@ -1,3 +1,14 @@ +2011-07-02 Martin Rudalics + + * window.h (window): Remove clone_number slot. + * window.c (Fwindow_clone_number, Fset_window_clone_number): + Remove. + (make_parent_window, make_window, saved_window) + (Fset_window_configuration, save_window_save): Don't deal with + clone numbers. + * buffer.c (Qclone_number): Remove declaration. + (sort_overlays, overlay_strings): Don't deal with clone numbers. + 2011-07-02 Stefan Monnier Add multiple inheritance to keymaps. === modified file 'src/buffer.c' --- src/buffer.c 2011-06-27 09:27:44 +0000 +++ src/buffer.c 2011-07-02 10:36:48 +0000 @@ -146,7 +146,7 @@ Lisp_Object Qpriority, Qbefore_string, Qafter_string; -static Lisp_Object Qclone_number, Qevaporate; +static Lisp_Object Qevaporate; Lisp_Object Qmodification_hooks; Lisp_Object Qinsert_in_front_hooks; @@ -2900,13 +2900,10 @@ overlays that are limited to some other window. */ if (w) { - Lisp_Object window, clone_number; + Lisp_Object window; window = Foverlay_get (overlay, Qwindow); - clone_number = Foverlay_get (overlay, Qclone_number); - if (WINDOWP (window) && XWINDOW (window) != w - && (! NUMBERP (clone_number) - || XFASTINT (clone_number) != XFASTINT (w->clone_number))) + if (WINDOWP (window) && XWINDOW (window) != w) continue; } @@ -3035,7 +3032,7 @@ EMACS_INT overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr) { - Lisp_Object overlay, window, clone_number, str; + Lisp_Object overlay, window, str; struct Lisp_Overlay *ov; EMACS_INT startpos, endpos; int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); @@ -3054,12 +3051,8 @@ if (endpos != pos && startpos != pos) continue; window = Foverlay_get (overlay, Qwindow); - clone_number = Foverlay_get (overlay, Qclone_number); - if (WINDOWP (window) && XWINDOW (window) != w - && (! NUMBERP (clone_number) - || XFASTINT (clone_number) != XFASTINT (w->clone_number))) + if (WINDOWP (window) && XWINDOW (window) != w) continue; - if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) record_overlay_string (&overlay_heads, str, @@ -3086,10 +3079,7 @@ if (endpos != pos && startpos != pos) continue; window = Foverlay_get (overlay, Qwindow); - clone_number = Foverlay_get (overlay, Qclone_number); - if (WINDOWP (window) && XWINDOW (window) != w - && (! NUMBERP (clone_number) - || XFASTINT (clone_number) != XFASTINT (w->clone_number))) + if (WINDOWP (window) && XWINDOW (window) != w) continue; if (startpos == pos && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))) @@ -5229,7 +5219,6 @@ DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks"); DEFSYM (Qget_file_buffer, "get-file-buffer"); DEFSYM (Qpriority, "priority"); - DEFSYM (Qclone_number, "clone-number"); DEFSYM (Qbefore_string, "before-string"); DEFSYM (Qafter_string, "after-string"); DEFSYM (Qfirst_change_hook, "first-change-hook"); === modified file 'src/window.c' --- src/window.c 2011-06-29 12:06:08 +0000 +++ src/window.c 2011-07-02 10:36:48 +0000 @@ -408,14 +408,6 @@ return select_window (window, norecord, 0); } -DEFUN ("window-clone-number", Fwindow_clone_number, Swindow_clone_number, 0, 1, 0, - doc: /* Return WINDOW's clone number. -WINDOW can be any window and defaults to the selected one. */) - (Lisp_Object window) -{ - return decode_any_window (window)->clone_number; -} - DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, doc: /* Return the buffer that WINDOW is displaying. WINDOW can be any window and defaults to the selected one. @@ -3087,18 +3079,6 @@ unbind_to (count, Qnil); } -DEFUN ("set-window-clone-number", Fset_window_clone_number, Sset_window_clone_number, 2, 2, 0, - doc: /* Set WINDOW's clone number to CLONE-NUMBER. -WINDOW can be any window and defaults to the selected one. */) - (Lisp_Object window, Lisp_Object clone_number) -{ - register struct window *w = decode_any_window (window); - - CHECK_NUMBER (clone_number); - w->clone_number = clone_number; - return w->clone_number; -} - DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 3, 0, doc: /* Make WINDOW display BUFFER-OR-NAME as its contents. WINDOW has to be a live window and defaults to the selected one. @@ -3289,7 +3269,6 @@ ++sequence_number; XSETFASTINT (p->sequence_number, sequence_number); - XSETFASTINT (p->clone_number, sequence_number); replace_window (window, parent, 1); @@ -3335,7 +3314,6 @@ XSETFASTINT (w->use_time, 0); ++sequence_number; XSETFASTINT (w->sequence_number, sequence_number); - XSETFASTINT (w->clone_number, sequence_number); w->temslot = w->last_modified = w->last_overlay_modified = Qnil; XSETFASTINT (w->last_point, 0); w->last_had_star = w->vertical_scroll_bar = Qnil; @@ -5348,8 +5326,7 @@ { struct vectorlike_header header; - Lisp_Object window, clone_number; - Lisp_Object buffer, start, pointm, mark; + Lisp_Object window, buffer, start, pointm, mark; Lisp_Object left_col, top_line, total_cols, total_lines; Lisp_Object normal_cols, normal_lines; Lisp_Object hscroll, min_hscroll; @@ -5568,7 +5545,6 @@ } } - w->clone_number = p->clone_number; /* If we squirreled away the buffer in the window's height, restore it now. */ if (BUFFERP (w->total_lines)) @@ -5851,7 +5827,6 @@ XSETFASTINT (w->temslot, i); i++; p->window = window; - p->clone_number = w->clone_number; p->buffer = w->buffer; p->left_col = w->left_col; p->top_line = w->top_line; @@ -6596,7 +6571,6 @@ defsubr (&Sset_frame_selected_window); defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_line_height); - defsubr (&Swindow_clone_number); defsubr (&Swindow_buffer); defsubr (&Swindow_parent); defsubr (&Swindow_top_child); @@ -6646,7 +6620,6 @@ defsubr (&Sdelete_window_internal); defsubr (&Sresize_mini_window_internal); defsubr (&Sset_window_buffer); - defsubr (&Sset_window_clone_number); defsubr (&Srun_window_configuration_change_hook); defsubr (&Sselect_window); defsubr (&Sforce_window_update); === modified file 'src/window.h' --- src/window.h 2011-06-11 10:11:07 +0000 +++ src/window.h 2011-07-02 10:36:48 +0000 @@ -165,10 +165,6 @@ /* Unique number of window assigned when it was created. */ Lisp_Object sequence_number; - /* Sequence number of window this window was cloned from. Identic - to sequence number if window was not cloned. */ - Lisp_Object clone_number; - /* No permanent meaning; used by save-window-excursion's bookkeeping. */ Lisp_Object temslot; ------------------------------------------------------------ revno: 104862 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-07-02 06:23:45 -0400 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/dired.el' --- lisp/dired.el 2011-07-01 11:56:36 +0000 +++ lisp/dired.el 2011-07-02 10:23:45 +0000 @@ -3628,16 +3628,16 @@ ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "7efcfe4f9e0913ae4a87be014010c27f") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "65e65633e08c3e4b4a4b1c735f2f48b8") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. (That's the mark set by \\[set-mark-command], not by Dired's \\[dired-mark] command.) -The prompted-for file is the first file given to `diff'. +The prompted-for FILE is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, -which is options for `diff'. +which is the string of command switches for `diff'. \(fn FILE &optional SWITCHES)" t nil) @@ -4080,8 +4080,9 @@ (autoload 'dired-show-file-type "dired-aux" "\ Print the type of FILE, according to the `file' command. -If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is -true then the type of the file linked to by FILE is printed instead. +If you give a prefix to this command, and FILE is a symbolic +link, then the type of the file linked to by FILE is printed +instead. \(fn FILE &optional DEREF-SYMLINKS)" t nil) ------------------------------------------------------------ revno: 104861 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-07-02 06:18:42 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/configure' --- autogen/configure 2011-07-01 10:19:04 +0000 +++ autogen/configure 2011-07-02 10:18:42 +0000 @@ -11265,8 +11265,8 @@ $as_echo "#define HAVE_GCONF 1" >>confdefs.h - SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" - SETTINGS_LIBS="$GSETTINGS_LIBS" + SETTINGS_CFLAGS="$GCONF_CFLAGS" + SETTINGS_LIBS="$GCONF_LIBS" fi fi ------------------------------------------------------------ revno: 104860 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2011-07-02 00:27:41 -0400 message: Add multiple inheritance to keymaps. * src/keymap.c (Fmake_composed_keymap): New function. (Fset_keymap_parent): Simplify. (fix_submap_inheritance): Remove. (access_keymap_1): New function extracted from access_keymap to handle embedded parents and handle lists of maps. (access_keymap): Use it. (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap) (Fcopy_keymap): Handle embedded parents. (Fcommand_remapping, define_as_prefix): Simplify. (Fkey_binding): Simplify. (syms_of_keymap): Move minibuffer-local-completion-map, minibuffer-local-filename-completion-map, minibuffer-local-must-match-map, and minibuffer-local-filename-must-match-map to Elisp. (syms_of_keymap): Defsubr make-composed-keymap. * src/keyboard.c (menu_bar_items): Use map_keymap_canonical. (parse_menu_item): Trivial simplification. * lisp/subr.el (remq): Don't allocate if it's not needed. (keymap--menu-item-binding, keymap--menu-item-with-binding) (keymap--merge-bindings): New functions. (keymap-canonicalize): Use them to refine the canonicalization. * lisp/minibuffer.el (minibuffer-local-completion-map) (minibuffer-local-must-match-map): Move initialization from C. (minibuffer-local-filename-completion-map): Move initialization from C; don't inherit from anything here. (minibuffer-local-filename-must-match-map): Make obsolete. (completing-read-default): Use make-composed-keymap to combine minibuffer-local-filename-completion-map with either minibuffer-local-must-match-map or minibuffer-local-filename-completion-map. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-07-01 09:54:39 +0000 +++ etc/NEWS 2011-07-02 04:27:41 +0000 @@ -111,6 +111,10 @@ *** `completing-read' can be customized using the new variable `completing-read-function'. +*** minibuffer-local-filename-must-match-map is not used any more. +Instead, the bindings in minibuffer-local-filename-completion-map are combined +with minibuffer-local-must-match-map. + ** auto-mode-case-fold is now enabled by default. ** smtpmail changes @@ -1094,6 +1098,7 @@ --- ** rx.el has a new `group-n' construct for explicitly numbered groups. +** keymaps can inherit from multiple parents. * Changes in Emacs 24.1 on non-free operating systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-07-01 18:21:09 +0000 +++ lisp/ChangeLog 2011-07-02 04:27:41 +0000 @@ -1,3 +1,19 @@ +2011-07-02 Stefan Monnier + + * subr.el (remq): Don't allocate if it's not needed. + (keymap--menu-item-binding, keymap--menu-item-with-binding) + (keymap--merge-bindings): New functions. + (keymap-canonicalize): Use them to refine the canonicalization. + * minibuffer.el (minibuffer-local-completion-map) + (minibuffer-local-must-match-map): Move initialization from C. + (minibuffer-local-filename-completion-map): Move initialization from C; + don't inherit from anything here. + (minibuffer-local-filename-must-match-map): Make obsolete. + (completing-read-default): Use make-composed-keymap to combine + minibuffer-local-filename-completion-map with either + minibuffer-local-must-match-map or + minibuffer-local-filename-completion-map. + 2011-07-01 Glenn Morris * type-break.el (type-break-time-sum): Use dolist. === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-06-23 03:35:05 +0000 +++ lisp/minibuffer.el 2011-07-02 04:27:41 +0000 @@ -1634,30 +1634,43 @@ ;;; Key bindings. -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") - (let ((map minibuffer-local-map)) (define-key map "\C-g" 'abort-recursive-edit) (define-key map "\r" 'exit-minibuffer) (define-key map "\n" 'exit-minibuffer)) -(let ((map minibuffer-local-completion-map)) - (define-key map "\t" 'minibuffer-complete) - ;; M-TAB is already abused for many other purposes, so we should find - ;; another binding for it. - ;; (define-key map "\e\t" 'minibuffer-force-complete) - (define-key map " " 'minibuffer-complete-word) - (define-key map "?" 'minibuffer-completion-help)) - -(let ((map minibuffer-local-must-match-map)) - (define-key map "\r" 'minibuffer-complete-and-exit) - (define-key map "\n" 'minibuffer-complete-and-exit)) - -(let ((map minibuffer-local-filename-completion-map)) - (define-key map " " nil)) -(let ((map minibuffer-local-filename-must-match-map)) - (define-key map " " nil)) +(defvar minibuffer-local-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\t" 'minibuffer-complete) + ;; M-TAB is already abused for many other purposes, so we should find + ;; another binding for it. + ;; (define-key map "\e\t" 'minibuffer-force-complete) + (define-key map " " 'minibuffer-complete-word) + (define-key map "?" 'minibuffer-completion-help) + map) + "Local keymap for minibuffer input with completion.") + +(defvar minibuffer-local-must-match-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-completion-map) + (define-key map "\r" 'minibuffer-complete-and-exit) + (define-key map "\n" 'minibuffer-complete-and-exit) + map) + "Local keymap for minibuffer input with completion, for exact match.") + +(defvar minibuffer-local-filename-completion-map + (let ((map (make-sparse-keymap))) + (define-key map " " nil) + map) + "Local keymap for minibuffer input with completion for filenames. +Gets combined either with `minibuffer-local-completion-map' or +with `minibuffer-local-must-match-map'.") + +(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) +(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") +(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map + 'minibuffer-local-filename-must-match-map "23.1") (let ((map minibuffer-local-ns-map)) (define-key map " " 'exit-minibuffer) @@ -2732,13 +2745,22 @@ (minibuffer-completion-predicate predicate) (minibuffer-completion-confirm (unless (eq require-match t) require-match)) - (keymap (if require-match - (if (memq minibuffer-completing-file-name '(nil lambda)) + (base-keymap (if require-match minibuffer-local-must-match-map - minibuffer-local-filename-must-match-map) - (if (memq minibuffer-completing-file-name '(nil lambda)) - minibuffer-local-completion-map - minibuffer-local-filename-completion-map))) + minibuffer-local-completion-map)) + (keymap (if (memq minibuffer-completing-file-name '(nil lambda)) + base-keymap + ;; Layer minibuffer-local-filename-completion-map + ;; on top of the base map. + ;; Use make-composed-keymap so that set-keymap-parent + ;; doesn't modify minibuffer-local-filename-completion-map. + (let ((map (make-composed-keymap + minibuffer-local-filename-completion-map))) + ;; Set base-keymap as the parent, so that nil bindings + ;; in minibuffer-local-filename-completion-map can + ;; override bindings in base-keymap. + (set-keymap-parent map base-keymap) + map))) (result (read-from-minibuffer prompt initial-input keymap nil hist def inherit-input-method))) (when (and (equal result "") def) === modified file 'lisp/subr.el' --- lisp/subr.el 2011-06-21 08:55:22 +0000 +++ lisp/subr.el 2011-07-02 04:27:41 +0000 @@ -490,6 +490,7 @@ "Return LIST with all occurrences of ELT removed. The comparison is done with `eq'. Contrary to `delq', this does not use side-effects, and the argument LIST is not modified." + (while (eq elt (car list)) (setq list (cdr list))) (if (memq elt list) (delq elt (copy-sequence list)) list)) @@ -591,31 +592,88 @@ (dolist (p list) (funcall function (car p) (cdr p))))) +(defun keymap--menu-item-binding (val) + "Return the binding part of a menu-item." + (cond + ((not (consp val)) val) ;Not a menu-item. + ((eq 'menu-item (car val)) + (let* ((binding (nth 2 val)) + (plist (nthcdr 3 val)) + (filter (plist-get plist :filter))) + (if filter (funcall filter binding) + binding))) + ((and (consp (cdr val)) (stringp (cadr val))) + (cddr val)) + ((stringp (car val)) + (cdr val)) + (t val))) ;Not a menu-item either. + +(defun keymap--menu-item-with-binding (item binding) + "Build a menu-item like ITEM but with its binding changed to BINDING." + (cond + ((eq 'menu-item (car item)) + (setq item (copy-sequence item)) + (let ((tail (nthcdr 2 item))) + (setcar tail binding) + ;; Remove any potential filter. + (if (plist-get (cdr tail) :filter) + (setcdr tail (plist-put (cdr tail) :filter nil)))) + item) + ((and (consp (cdr item)) (stringp (cadr item))) + (cons (car item) (cons (cadr item) binding))) + (t (cons (car item) binding)))) + +(defun keymap--merge-bindings (val1 val2) + "Merge bindings VAL1 and VAL2." + (let ((map1 (keymap--menu-item-binding val1)) + (map2 (keymap--menu-item-binding val2))) + (if (not (and (keymapp map1) (keymapp map2))) + ;; There's nothing to merge: val1 takes precedence. + val1 + (let ((map (list 'keymap map1 map2)) + (item (if (keymapp val1) (if (keymapp val2) nil val2) val1))) + (keymap--menu-item-with-binding item map))))) + (defun keymap-canonicalize (map) - "Return an equivalent keymap, without inheritance." + "Return a simpler equivalent keymap. +This resolves inheritance and redefinitions. The returned keymap +should behave identically to a copy of KEYMAP w.r.t `lookup-key' +and use in active keymaps and menus. +Subkeymaps may be modified but are not canonicalized." + ;; FIXME: Problem with the difference between a nil binding + ;; that hides a binding in an inherited map and a nil binding that's ignored + ;; to let some further binding visible. Currently a nil binding hides all. + ;; FIXME: we may want to carefully (re)order elements in case they're + ;; menu-entries. (let ((bindings ()) (ranges ()) (prompt (keymap-prompt map))) (while (keymapp map) - (setq map (map-keymap-internal + (setq map (map-keymap ;; -internal (lambda (key item) (if (consp key) ;; Treat char-ranges specially. (push (cons key item) ranges) (push (cons key item) bindings))) map))) + ;; Create the new map. (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt)) (dolist (binding ranges) - ;; Treat char-ranges specially. + ;; Treat char-ranges specially. FIXME: need to merge as well. (define-key map (vector (car binding)) (cdr binding))) + ;; Process the bindings starting from the end. (dolist (binding (prog1 bindings (setq bindings ()))) (let* ((key (car binding)) (item (cdr binding)) (oldbind (assq key bindings))) - ;; Newer bindings override older. - (if oldbind (setq bindings (delq oldbind bindings))) - (when item ;nil bindings just hide older ones. - (push binding bindings)))) + (push (if (not oldbind) + ;; The normal case: no duplicate bindings. + binding + ;; This is the second binding for this key. + (setq bindings (delq oldbind bindings)) + (cons key (keymap--merge-bindings (cdr binding) + (cdr oldbind)))) + bindings))) (nconc map bindings))) (put 'keyboard-translate-table 'char-table-extra-slots 0) === modified file 'src/ChangeLog' --- src/ChangeLog 2011-07-01 17:53:59 +0000 +++ src/ChangeLog 2011-07-02 04:27:41 +0000 @@ -1,3 +1,24 @@ +2011-07-02 Stefan Monnier + + Add multiple inheritance to keymaps. + * keymap.c (Fmake_composed_keymap): New function. + (Fset_keymap_parent): Simplify. + (fix_submap_inheritance): Remove. + (access_keymap_1): New function extracted from access_keymap to handle + embedded parents and handle lists of maps. + (access_keymap): Use it. + (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap) + (Fcopy_keymap): Handle embedded parents. + (Fcommand_remapping, define_as_prefix): Simplify. + (Fkey_binding): Simplify. + (syms_of_keymap): Move minibuffer-local-completion-map, + minibuffer-local-filename-completion-map, + minibuffer-local-must-match-map, and + minibuffer-local-filename-must-match-map to Elisp. + (syms_of_keymap): Defsubr make-composed-keymap. + * keyboard.c (menu_bar_items): Use map_keymap_canonical. + (parse_menu_item): Trivial simplification. + 2011-07-01 Glenn Morris * Makefile.in (SETTINGS_LIBS): Fix typo. === modified file 'src/keyboard.c' --- src/keyboard.c 2011-06-20 06:07:16 +0000 +++ src/keyboard.c 2011-07-02 04:27:41 +0000 @@ -7470,7 +7470,7 @@ if (CONSP (def)) { menu_bar_one_keymap_changed_items = Qnil; - map_keymap (def, menu_bar_item, Qnil, NULL, 1); + map_keymap_canonical (def, menu_bar_item, Qnil, NULL); } } @@ -7811,7 +7811,7 @@ /* If we got no definition, this item is just unselectable text which is OK in a submenu but not in the menubar. */ if (NILP (def)) - return (inmenubar ? 0 : 1); + return (!inmenubar); /* See if this is a separate pane or a submenu. */ def = AREF (item_properties, ITEM_PROPERTY_DEF); === modified file 'src/keymap.c' --- src/keymap.c 2011-06-24 21:25:22 +0000 +++ src/keymap.c 2011-07-02 04:27:41 +0000 @@ -16,6 +16,27 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +/* Old BUGS: + - [M-C-a] != [?\M-\C-a] + - [M-f2] != [?\e f2]. + - (define-key map [menu-bar foo] ) does not always place + at the head of the menu (if `foo' was already bound earlier and + then unbound, for example). + TODO: + - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak) + - Think about the various defaulting that's currently hard-coded in + keyboard.c (uppercase->lowercase, char->charset, button-events, ...) + and make it more generic. Maybe we should allow mappings of the + form (PREDICATE . BINDING) as generalization of the default binding, + tho probably a cleaner way to attack this is to allow functional + keymaps (i.e. keymaps that are implemented as functions that implement + a few different methods like `lookup', `map', ...). + - Make [a] equivalent to [?a]. + BEWARE: + - map-keymap should work meaningfully even if entries are added/removed + to the keymap while iterating through it: + start - removed <= visited <= start + added + */ #include #include @@ -73,7 +94,6 @@ static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); -static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); static void describe_command (Lisp_Object, Lisp_Object); @@ -130,6 +150,17 @@ return Fcons (Qkeymap, Qnil); } +DEFUN ("make-composed-keymap", Fmake_composed_keymap, Smake_composed_keymap, + 0, MANY, 0, + doc: /* Construct and return a new keymap composed of KEYMAPS. +When looking up a key in the returned map, the key is looked in each +keymap in turn until a binding is found. +usage: (make-composed-keymap &rest KEYMAPS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + return Fcons (Qkeymap, Flist (nargs, args)); +} + /* This function is used for installing the standard key bindings at initialization time. @@ -174,6 +205,12 @@ Lisp_Object tem = XCAR (map); if (STRINGP (tem)) return tem; + else if (KEYMAPP (tem)) + { + tem = Fkeymap_prompt (tem); + if (!NILP (tem)) + return tem; + } map = XCDR (map); } return Qnil; @@ -300,23 +337,16 @@ { Lisp_Object list, prev; struct gcpro gcpro1, gcpro2; - int i; - /* Force a keymap flush for the next call to where-is. - Since this can be called from within where-is, we don't set where_is_cache - directly but only where_is_cache_keymaps, since where_is_cache shouldn't - be changed during where-is, while where_is_cache_keymaps is only used at - the very beginning of where-is and can thus be changed here without any - adverse effect. - This is a very minor correctness (rather than safety) issue. */ - where_is_cache_keymaps = Qt; + /* Flush any reverse-map cache. */ + where_is_cache = Qnil; where_is_cache_keymaps = Qt; GCPRO2 (keymap, parent); keymap = get_keymap (keymap, 1, 1); if (!NILP (parent)) { - parent = get_keymap (parent, 1, 1); + parent = get_keymap (parent, 1, 0); /* Check for cycles. */ if (keymap_memberp (keymap, parent)) @@ -332,121 +362,35 @@ If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - /* If we already have the right parent, return now - so that we avoid the loops below. */ - if (EQ (XCDR (prev), parent)) - RETURN_UNGCPRO (parent); - CHECK_IMPURE (prev); XSETCDR (prev, parent); - break; + RETURN_UNGCPRO (parent); } prev = list; } - - /* Scan through for submaps, and set their parents too. */ - - for (list = XCDR (keymap); CONSP (list); list = XCDR (list)) - { - /* Stop the scan when we come to the parent. */ - if (EQ (XCAR (list), Qkeymap)) - break; - - /* If this element holds a prefix map, deal with it. */ - if (CONSP (XCAR (list)) - && CONSP (XCDR (XCAR (list)))) - fix_submap_inheritance (keymap, XCAR (XCAR (list)), - XCDR (XCAR (list))); - - if (VECTORP (XCAR (list))) - for (i = 0; i < ASIZE (XCAR (list)); i++) - if (CONSP (XVECTOR (XCAR (list))->contents[i])) - fix_submap_inheritance (keymap, make_number (i), - XVECTOR (XCAR (list))->contents[i]); - - if (CHAR_TABLE_P (XCAR (list))) - { - map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap); - } - } - - RETURN_UNGCPRO (parent); -} - -/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition. - if EVENT is also a prefix in MAP's parent, - make sure that SUBMAP inherits that definition as its own parent. */ - -static void -fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap) -{ - Lisp_Object map_parent, parent_entry; - - /* SUBMAP is a cons that we found as a key binding. - Discard the other things found in a menu key binding. */ - - submap = get_keymap (get_keyelt (submap, 0), 0, 0); - - /* If it isn't a keymap now, there's no work to do. */ - if (!CONSP (submap)) - return; - - map_parent = keymap_parent (map, 0); - if (!NILP (map_parent)) - parent_entry = - get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0); - else - parent_entry = Qnil; - - /* If MAP's parent has something other than a keymap, - our own submap shadows it completely. */ - if (!CONSP (parent_entry)) - return; - - if (! EQ (parent_entry, submap)) - { - Lisp_Object submap_parent; - submap_parent = submap; - while (1) - { - Lisp_Object tem; - - tem = keymap_parent (submap_parent, 0); - - if (KEYMAPP (tem)) - { - if (keymap_memberp (tem, parent_entry)) - /* Fset_keymap_parent could create a cycle. */ - return; - submap_parent = tem; - } - else - break; - } - Fset_keymap_parent (submap_parent, parent_entry); - } } + /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single event, not a sequence. + MAP must be a keymap or a list of keymaps. + If T_OK is non-zero, bindings for Qt are treated as default bindings; any key left unmentioned by other tables and bindings is given the binding of Qt. If T_OK is zero, bindings for Qt are not treated specially. - If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */ + If NOINHERIT, don't accept a subkeymap found in an inherited keymap. + + Returns Qunbound if no binding was found (and returns Qnil if a nil + binding was found). */ Lisp_Object -access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload) +access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload) { - Lisp_Object val; - - /* Qunbound in VAL means we have found no binding yet. */ - val = Qunbound; - /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ @@ -461,21 +405,21 @@ with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); - /* Handle the special meta -> esc mapping. */ + /* Handle the special meta -> esc mapping. */ if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier) { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ struct gcpro gcpro1; - Lisp_Object event_meta_map; + Lisp_Object event_meta_binding, event_meta_map; GCPRO1 (map); /* A strange value in which Meta is set would cause infinite recursion. Protect against that. */ if (XINT (meta_prefix_char) & CHAR_META) meta_prefix_char = make_number (27); - event_meta_map = get_keymap (access_keymap (map, meta_prefix_char, - t_ok, noinherit, autoload), - 0, autoload); + event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok, + noinherit, autoload); + event_meta_map = get_keymap (event_meta_binding, 0, autoload); UNGCPRO; if (CONSP (event_meta_map)) { @@ -486,8 +430,8 @@ /* Set IDX to t, so that we only find a default binding. */ idx = Qt; else - /* We know there is no binding. */ - return Qnil; + /* An explicit nil binding, or no binding at all. */ + return NILP (event_meta_binding) ? Qnil : Qunbound; } /* t_binding is where we put a default binding that applies, @@ -495,25 +439,52 @@ for this key sequence. */ { Lisp_Object tail; - Lisp_Object t_binding = Qnil; + Lisp_Object t_binding = Qunbound; + Lisp_Object retval = Qunbound; + Lisp_Object retval_tail = Qnil; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO4 (map, tail, idx, t_binding); + GCPRO4 (tail, idx, t_binding, retval); - for (tail = XCDR (map); + for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map; (CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail))); tail = XCDR (tail)) { - Lisp_Object binding; + /* Qunbound in VAL means we have found no binding. */ + Lisp_Object val = Qunbound; + Lisp_Object binding = XCAR (tail); + Lisp_Object submap = get_keymap (binding, 0, autoload); - binding = XCAR (tail); - if (SYMBOLP (binding)) - { - /* If NOINHERIT, stop finding prefix definitions - after we pass a second occurrence of the `keymap' symbol. */ - if (noinherit && EQ (binding, Qkeymap)) - RETURN_UNGCPRO (Qnil); + if (EQ (binding, Qkeymap)) + { + if (noinherit || NILP (retval)) + /* If NOINHERIT, stop here, the rest is inherited. */ + break; + else if (!EQ (retval, Qunbound)) + { + Lisp_Object parent_entry; + eassert (KEYMAPP (retval)); + parent_entry + = get_keymap (access_keymap_1 (tail, idx, + t_ok, 0, autoload), + 0, autoload); + if (KEYMAPP (parent_entry)) + { + if (CONSP (retval_tail)) + XSETCDR (retval_tail, parent_entry); + else + { + retval_tail = Fcons (retval, parent_entry); + retval = Fcons (Qkeymap, retval_tail); + } + } + break; + } + } + else if (CONSP (submap)) + { + val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload); } else if (CONSP (binding)) { @@ -556,23 +527,47 @@ (i.e. it shadows any parent binding but not bindings in keymaps of lower precedence). */ val = Qnil; + val = get_keyelt (val, autoload); - if (KEYMAPP (val)) - fix_submap_inheritance (map, idx, val); - RETURN_UNGCPRO (val); + + if (!KEYMAPP (val)) + { + if (NILP (retval) || EQ (retval, Qunbound)) + retval = val; + if (!NILP (val)) + break; /* Shadows everything that follows. */ + } + else if (NILP (retval) || EQ (retval, Qunbound)) + retval = val; + else if (CONSP (retval_tail)) + { + XSETCDR (retval_tail, Fcons (val, Qnil)); + retval_tail = XCDR (retval_tail); + } + else + { + retval_tail = Fcons (val, Qnil); + retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); + } } QUIT; } UNGCPRO; - return get_keyelt (t_binding, autoload); + return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; } } +Lisp_Object +access_keymap (Lisp_Object map, Lisp_Object idx, + int t_ok, int noinherit, int autoload) +{ + Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload); + return EQ (val, Qunbound) ? Qnil : val; +} + static void map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data) { - /* We should maybe try to detect bindings shadowed by previous - ones and things like that. */ if (EQ (val, Qt)) val = Qnil; (*fun) (key, val, args, data); @@ -583,8 +578,8 @@ { if (!NILP (val)) { - map_keymap_function_t fun = - (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; + map_keymap_function_t fun + = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ @@ -612,7 +607,9 @@ { Lisp_Object binding = XCAR (tail); - if (CONSP (binding)) + if (KEYMAPP (binding)) /* An embedded parent. */ + break; + else if (CONSP (binding)) map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data); else if (VECTORP (binding)) { @@ -644,7 +641,7 @@ call2 (fun, key, val); } -/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well. +/* Same as map_keymap_internal, but traverses parent keymaps as well. A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */ void map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload) @@ -654,8 +651,15 @@ map = get_keymap (map, 1, autoload); while (CONSP (map)) { - map = map_keymap_internal (map, fun, args, data); - map = get_keymap (map, 0, autoload); + if (KEYMAPP (XCAR (map))) + { + map_keymap (XCAR (map), fun, args, data, autoload); + map = XCDR (map); + } + else + map = map_keymap_internal (map, fun, args, data); + if (!CONSP (map)) + map = get_keymap (map, 0, autoload); } UNGCPRO; } @@ -791,16 +795,10 @@ } /* If the contents are (KEYMAP . ELEMENT), go indirect. */ + else if (KEYMAPP (XCAR (object))) + error ("Wow, indirect keymap entry!!"); else - { - struct gcpro gcpro1; - Lisp_Object map; - GCPRO1 (object); - map = get_keymap (Fcar_safe (object), 0, autoload); - UNGCPRO; - return (!CONSP (map) ? object /* Invalid keymap */ - : access_keymap (map, Fcdr (object), 0, 0, autoload)); - } + return object; } } @@ -811,6 +809,9 @@ where_is_cache = Qnil; where_is_cache_keymaps = Qt; + if (EQ (idx, Qkeymap)) + error ("`keymap' is reserved for embedded parent maps"); + /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ if (CONSP (def) && PURE_P (def) @@ -903,7 +904,16 @@ } else if (CONSP (elt)) { - if (EQ (idx, XCAR (elt))) + if (EQ (Qkeymap, XCAR (elt))) + { /* A sub keymap. This might be due to a lookup that found + two matching bindings (maybe because of a sub keymap). + It almost never happens (since the second binding normally + only happens in the inherited part of the keymap), but + if it does, we want to update the sub-keymap since the + main one might be temporary (built by access_keymap). */ + tail = insertion_point = elt; + } + else if (EQ (idx, XCAR (elt))) { CHECK_IMPURE (elt); XSETCDR (elt, def); @@ -1068,7 +1078,13 @@ ASET (elt, i, copy_keymap_item (AREF (elt, i))); } else if (CONSP (elt)) - elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); + { + if (EQ (XCAR (elt), Qkeymap)) + /* This is a sub keymap. */ + elt = Fcopy_keymap (elt); + else + elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); + } XSETCDR (tail, Fcons (elt, Qnil)); tail = XCDR (tail); keymap = XCDR (keymap); @@ -1234,23 +1250,15 @@ ASET (command_remapping_vector, 1, command); if (NILP (keymaps)) - return Fkey_binding (command_remapping_vector, Qnil, Qt, position); + command = Fkey_binding (command_remapping_vector, Qnil, Qt, position); else - { - Lisp_Object maps, binding; - - for (maps = keymaps; CONSP (maps); maps = XCDR (maps)) - { - binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil); - if (!NILP (binding) && !INTEGERP (binding)) - return binding; - } - return Qnil; - } + command = Flookup_key (Fcons (Qkeymap, keymaps), + command_remapping_vector, Qnil); + return INTEGERP (command) ? Qnil : command; } /* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function if it autoloads a keymap. */ +/* GC is possible in this function. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. @@ -1325,10 +1333,6 @@ Lisp_Object cmd; cmd = Fmake_sparse_keymap (Qnil); - /* If this key is defined as a prefix in an inherited keymap, - make it a prefix in this map, and make its definition - inherit the other prefix definition. */ - cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0)); store_in_keymap (keymap, c, cmd); return cmd; @@ -1530,7 +1534,7 @@ { int count = SPECPDL_INDEX (); - Lisp_Object keymaps; + Lisp_Object keymaps = Fcons (current_global_map, Qnil); /* If a mouse click position is given, our variables are based on the buffer clicked on, not the current buffer. So we may have to @@ -1560,12 +1564,11 @@ } } - keymaps = Fcons (current_global_map, Qnil); - if (!NILP (olp)) { if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); + keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), + keymaps); /* The doc said that overriding-terminal-local-map should override overriding-local-map. The code used them both, but it seems clearer to use just one. rms, jan 2005. */ @@ -1576,23 +1579,19 @@ { Lisp_Object *maps; int nmaps, i; - - Lisp_Object keymap, local_map; - EMACS_INT pt; - - pt = INTEGERP (position) ? XINT (position) + EMACS_INT pt + = INTEGERP (position) ? XINT (position) : MARKERP (position) ? marker_position (position) : PT; - - /* Get the buffer local maps, possibly overriden by text or - overlay properties */ - - local_map = get_local_map (pt, current_buffer, Qlocal_map); - keymap = get_local_map (pt, current_buffer, Qkeymap); + /* This usually returns the buffer's local map, + but that can be overridden by a `local-map' property. */ + Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map); + /* This returns nil unless there is a `keymap' property. */ + Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap); if (CONSP (position)) { - Lisp_Object string; + Lisp_Object string = POSN_STRING (position); /* For a mouse click, get the local text-property keymap of the place clicked on, rather than point. */ @@ -1619,8 +1618,7 @@ consider `local-map' and `keymap' properties of that string. */ - if (string = POSN_STRING (position), - (CONSP (string) && STRINGP (XCAR (string)))) + if (CONSP (string) && STRINGP (XCAR (string))) { Lisp_Object pos, map; @@ -1691,12 +1689,7 @@ */) (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position) { - Lisp_Object *maps, value; - int nmaps, i; - struct gcpro gcpro1, gcpro2; - int count = SPECPDL_INDEX (); - - GCPRO2 (key, position); + Lisp_Object value; if (NILP (position) && VECTORP (key)) { @@ -1715,145 +1708,9 @@ } } - /* Key sequences beginning with mouse clicks - are read using the keymaps of the buffer clicked on, not - the current buffer. So we may have to switch the buffer - here. */ - - if (CONSP (position)) - { - Lisp_Object window; - - window = POSN_WINDOW (position); - - if (WINDOWP (window) - && BUFFERP (XWINDOW (window)->buffer) - && XBUFFER (XWINDOW (window)->buffer) != current_buffer) - { - /* Arrange to go back to the original buffer once we're done - processing the key sequence. We don't use - save_excursion_{save,restore} here, in analogy to - `read-key-sequence' to avoid saving point. Maybe this - would not be a problem here, but it is easier to keep - things the same. - */ - - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - - set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); - } - } - - if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - { - value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map), - key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - else if (! NILP (Voverriding_local_map)) - { - value = Flookup_key (Voverriding_local_map, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - else - { - Lisp_Object keymap, local_map; - EMACS_INT pt; - - pt = INTEGERP (position) ? XINT (position) - : MARKERP (position) ? marker_position (position) - : PT; - - local_map = get_local_map (pt, current_buffer, Qlocal_map); - keymap = get_local_map (pt, current_buffer, Qkeymap); - - if (CONSP (position)) - { - Lisp_Object string; - - /* For a mouse click, get the local text-property keymap - of the place clicked on, rather than point. */ - - if (POSN_INBUFFER_P (position)) - { - Lisp_Object pos; - - pos = POSN_BUFFER_POSN (position); - if (INTEGERP (pos) - && XINT (pos) >= BEG && XINT (pos) <= Z) - { - local_map = get_local_map (XINT (pos), - current_buffer, Qlocal_map); - - keymap = get_local_map (XINT (pos), - current_buffer, Qkeymap); - } - } - - /* If on a mode line string with a local keymap, - or for a click on a string, i.e. overlay string or a - string displayed via the `display' property, - consider `local-map' and `keymap' properties of - that string. */ - - if (string = POSN_STRING (position), - (CONSP (string) && STRINGP (XCAR (string)))) - { - Lisp_Object pos, map; - - pos = XCDR (string); - string = XCAR (string); - if (INTEGERP (pos) - && XINT (pos) >= 0 - && XINT (pos) < SCHARS (string)) - { - map = Fget_text_property (pos, Qlocal_map, string); - if (!NILP (map)) - local_map = map; - - map = Fget_text_property (pos, Qkeymap, string); - if (!NILP (map)) - keymap = map; - } - } - - } - - if (! NILP (keymap)) - { - value = Flookup_key (keymap, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - - nmaps = current_minor_maps (0, &maps); - /* Note that all these maps are GCPRO'd - in the places where we found them. */ - - for (i = 0; i < nmaps; i++) - if (! NILP (maps[i])) - { - value = Flookup_key (maps[i], key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - - if (! NILP (local_map)) - { - value = Flookup_key (local_map, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - } - - value = Flookup_key (current_global_map, key, accept_default); - - done: - unbind_to (count, Qnil); - - UNGCPRO; + value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)), + key, accept_default); + if (NILP (value) || INTEGERP (value)) return Qnil; @@ -3829,31 +3686,6 @@ Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map); - DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map, - doc: /* Local keymap for minibuffer input with completion. */); - Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map); - - DEFVAR_LISP ("minibuffer-local-filename-completion-map", - Vminibuffer_local_filename_completion_map, - doc: /* Local keymap for minibuffer input with completion for filenames. */); - Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_filename_completion_map, - Vminibuffer_local_completion_map); - - - DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map, - doc: /* Local keymap for minibuffer input with completion, for exact match. */); - Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_must_match_map, - Vminibuffer_local_completion_map); - - DEFVAR_LISP ("minibuffer-local-filename-must-match-map", - Vminibuffer_local_filename_must_match_map, - doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */); - Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_filename_must_match_map, - Vminibuffer_local_must_match_map); DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist, doc: /* Alist of keymaps to use for minor modes. @@ -3922,6 +3754,7 @@ defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); + defsubr (&Smake_composed_keymap); defsubr (&Smap_keymap_internal); defsubr (&Smap_keymap); defsubr (&Scopy_keymap); ------------------------------------------------------------ revno: 104859 committer: Glenn Morris branch nick: trunk timestamp: Fri 2011-07-01 14:21:09 -0400 message: * lisp/type-break.el (type-break-time-sum): Use dolist. This avoids using a free variable. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-07-01 18:13:17 +0000 +++ lisp/ChangeLog 2011-07-01 18:21:09 +0000 @@ -1,5 +1,7 @@ 2011-07-01 Glenn Morris + * type-break.el (type-break-time-sum): Use dolist. + * textmodes/flyspell.el (flyspell-word-search-backward): Replace CL function. === modified file 'lisp/type-break.el' --- lisp/type-break.el 2011-07-01 04:36:40 +0000 +++ lisp/type-break.el 2011-07-01 18:21:09 +0000 @@ -1009,13 +1009,10 @@ ;; "low" bits and format the time incorrectly. (defun type-break-time-sum (&rest tmlist) (let ((sum '(0 0 0))) - (while tmlist - (setq tem (car tmlist)) - (setq tmlist (cdr tmlist)) + (dolist (tem tmlist sum) (setq sum (time-add sum (if (integerp tem) (list (floor tem 65536) (mod tem 65536)) - tem)))) - sum)) + tem)))))) (defun type-break-time-stamp (&optional when) (if (fboundp 'format-time-string)