# HG changeset patch # User Gerd Moellmann # Date 939306843 0 # Node ID 5a88e84b63a4f11d5a07da8611f33e7a0d48073e # Parent 812005e9c20e2cce025eed4f490848d4faa06b8c New file. Override some standard Emacs functions diff -r 812005e9c20e -r 5a88e84b63a4 lisp/progmodes/ada-support.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ada-support.el Thu Oct 07 14:34:03 1999 +0000 @@ -0,0 +1,103 @@ +;; @(#) ada-support.el --- Override some standard Emacs functions + +;; Copyright (C) 1994-1999 Free Software Foundation, Inc. + +;; Author: Emmanuel Briot +;; Maintainer: Emmanuel Briot +;; Ada Core Technologies's version: $Revision: 1.3 $ +;; Keywords: languages ada xref + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;;; This file overrides some functions that are defined in Emacs/XEmacs, +;;; since some of them have known bugs in old versions. +;;; This is intended as a support package for older Emacs versions, and +;;; should not be needed for the latest version of Emacs (currently 20.4) +;;; where these bugs have been fixed + + + +;;; Some functions have been renamed from one version to the other +;;; `easy-menu-create-keymaps' has been renamed `easy-menu-create-menu' +;;; from Emacs >= 20.3 +;;; Do nothing for XEmacs + +(unless (or (ada-check-emacs-version 20 3) + (not (ada-check-emacs-version 1 1 t))) + + (if (and (not (fboundp 'easy-menu-create-menu)) + (fboundp 'easy-menu-create-keymaps)) + (defun easy-menu-create-menu (menu-name menu-items) + "Alias redefined in ada-support.el" + (easy-menu-create-keymaps menu-name menu-items)))) + + + +;;; A fix for Emacs <= 20.3 +;;; Imenu does not support name overriding in submenus (the first such name +;;; is always selected, whichever the user actually chose). +;;; This has been fixed in Emacs 20.4 +;;; Fix was: use assq instead of assoc in the submenus + +(unless (ada-check-emacs-version 20 4) + + (defun imenu--mouse-menu (index-alist event &optional title) + "Overrides the default imenu--mouse-menu from imenu.el, that has a bug. +The default one does not know anything about overriding in submenus, since +it is using assoc instead of assq" + (set 'index-alist (imenu--split-submenus index-alist)) + (let* ((menu (imenu--split-menu index-alist + (or title (buffer-name)))) + position) + (set 'menu (imenu--create-keymap-1 (car menu) + (if (< 1 (length (cdr menu))) + (cdr menu) + (cdr (car (cdr menu)))))) + (set 'position (x-popup-menu event menu)) + (cond ((eq position nil) + position) + ;; If one call to x-popup-menu handled the nested menus, + ;; find the result by looking down the menus here. + ((and (listp position) + (numberp (car position)) + (stringp (nth (1- (length position)) position))) + (let ((final menu)) + (while position + (set 'final (assq (car position) final)) + (set 'position (cdr position))) + (or (string= (car final) (car imenu--rescan-item)) + (nthcdr 3 final)))) + ;; If x-popup-menu went just one level and found a leaf item, + ;; return the INDEX-ALIST element for that. + ((and (consp position) + (stringp (car position)) + (null (cdr position))) + (or (string= (car position) (car imenu--rescan-item)) + (assq (car position) index-alist))) + ;; If x-popup-menu went just one level + ;; and found a non-leaf item (a submenu), + ;; recurse to handle the rest. + ((listp position) + (imenu--mouse-menu position event + (if title + (concat title imenu-level-separator + (car (rassq position index-alist))) + (car (rassq position index-alist)))))))) + ) + +(provide 'ada-support) \ No newline at end of file