Re: "Overwrite" toggle in the Edit menu

[Richard Stallman]

    But trying this, the "hot spot" for mouse-3 in the mode line isn't
    consistent: It works on the mode name, on the Abbrev indicator, but
    not on the Ovwrt indicator (haven't tried other combinations). 

I noticed this a week ago and started implementing a new feature
to make it work reliably.  It almost works, but has a strange bug:
the mouse menu completely stopped working.  That is strange  because
the keymaps seem to be set up correctly, and the help-echo property does
work through the new mechanism.

Here are the changes.  Can anyone debug this problem?



*** bindings.el.~1.96.~ Tue Jan 22 17:46:46 2002
--- bindings.el Wed Feb  6 10:18:47 2002
***************
*** 252,258 ****
    (setq-default mode-line-modes
      (list
       (propertize "   %[(" 'help-echo help-echo)
!      '(:eval (mode-line-mode-name)) 'mode-line-process 'minor-mode-alist
       (propertize "%n" 'help-echo "mouse-2: widen"
                 'local-map (make-mode-line-mouse-map
                             'mouse-2 #'mode-line-widen))
--- 252,260 ----
    (setq-default mode-line-modes
      (list
       (propertize "   %[(" 'help-echo help-echo)
!      '(:propertize ("" mode-name mode-line-process minor-mode-alist)
!                  help-echo "mouse-3: minor mode menu"
!                  local-map mode-line-minor-mode-keymap)
       (propertize "%n" 'help-echo "mouse-2: widen"
                 'local-map (make-mode-line-mouse-map
                             'mouse-2 #'mode-line-widen))
***************
*** 267,276 ****
  Keymap for what is displayed by `mode-line-buffer-identification'.")
  
  (defvar mode-line-minor-mode-keymap nil "\
! Keymap for what is displayed by `mode-line-mode-name'.")
! 
! (defvar mode-line-mode-menu-keymap nil "\
! Keymap for mode operations menu in the mode line.")
  
  (defun last-buffer () "\
  Return the last non-hidden buffer in the buffer list."
--- 269,275 ----
  Keymap for what is displayed by `mode-line-buffer-identification'.")
  
  (defvar mode-line-minor-mode-keymap nil "\
! Keymap to display on major and minor modes.")
  
  (defun last-buffer () "\
  Return the last non-hidden buffer in the buffer list."
***************
*** 316,374 ****
        (if binding
          (call-interactively binding)))))
  
- (defvar mode-line-copied-mode-name nil
-   "A copy of `mode-name', with `help-echo' and `local-map' properties added.")
- 
- (defun mode-line-mode-name () "\
- Return a string to display in the mode line for the current mode name."
-   (when (stringp mode-name)
-     (if (equal mode-name mode-line-copied-mode-name)
-       mode-line-copied-mode-name
-       (setq mode-line-copied-mode-name
-           (propertize mode-name
-                       'local-map mode-line-minor-mode-keymap 
-                       'help-echo "mouse-3: minor mode menu"))))
-   mode-line-copied-mode-name)
- 
  (defmacro bound-and-true-p (var)
    "Return the value of symbol VAR if it is bound, else nil."
    `(and (boundp (quote ,var)) ,var))
  
  (define-key mode-line-mode-menu [overwrite-mode]
!   `(menu-item ,(purecopy "Overwrite") overwrite-mode
              :button (:toggle . overwrite-mode)))
  (define-key mode-line-mode-menu [outline-minor-mode]
!   `(menu-item ,(purecopy "Outline") outline-minor-mode
              :button (:toggle . (bound-and-true-p outline-minor-mode))))
  (define-key mode-line-mode-menu [line-number-mode]
    `(menu-item ,(purecopy "Line number") line-number-mode
              :button (:toggle . line-number-mode)))
  (define-key mode-line-mode-menu [highlight-changes-mode]
!   `(menu-item ,(purecopy "Highlight changes") highlight-changes-mode
              :button (:toggle . highlight-changes-mode)))
  (define-key mode-line-mode-menu [glasses-mode]
!   `(menu-item ,(purecopy "Glasses") glasses-mode
              :button (:toggle . (bound-and-true-p glasses-mode))))
  (define-key mode-line-mode-menu [hide-ifdef-mode]
!   `(menu-item ,(purecopy "Hide ifdef") hide-ifdef-mode
              :button (:toggle . (bound-and-true-p hide-ifdef-mode))))
  (define-key mode-line-mode-menu [font-lock-mode]
    `(menu-item ,(purecopy "Font-lock") font-lock-mode
              :button (:toggle . font-lock-mode)))
  (define-key mode-line-mode-menu [flyspell-mode]
!   `(menu-item ,(purecopy "Flyspell") flyspell-mode
              :button (:toggle . (bound-and-true-p flyspell-mode))))
  (define-key mode-line-mode-menu [column-number-mode]
    `(menu-item ,(purecopy "Column number") column-number-mode
              :button (:toggle . column-number-mode)))
  (define-key mode-line-mode-menu [auto-fill-mode]
!   `(menu-item ,(purecopy "Auto-fill") auto-fill-mode
              :button (:toggle . auto-fill-function)))
  (define-key mode-line-mode-menu [auto-revert-mode]
!   `(menu-item ,(purecopy "Auto revert") auto-revert-mode
              :button (:toggle . auto-revert-mode)))
  (define-key mode-line-mode-menu [abbrev-mode]
!   `(menu-item ,(purecopy "Abbrev") abbrev-mode
              :button (:toggle . abbrev-mode)))
  
  (defun mode-line-mode-menu (event)
--- 315,359 ----
        (if binding
          (call-interactively binding)))))
  
  (defmacro bound-and-true-p (var)
    "Return the value of symbol VAR if it is bound, else nil."
    `(and (boundp (quote ,var)) ,var))
  
  (define-key mode-line-mode-menu [overwrite-mode]
!   `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode
              :button (:toggle . overwrite-mode)))
  (define-key mode-line-mode-menu [outline-minor-mode]
!   `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode
              :button (:toggle . (bound-and-true-p outline-minor-mode))))
  (define-key mode-line-mode-menu [line-number-mode]
    `(menu-item ,(purecopy "Line number") line-number-mode
              :button (:toggle . line-number-mode)))
  (define-key mode-line-mode-menu [highlight-changes-mode]
!   `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode
              :button (:toggle . highlight-changes-mode)))
  (define-key mode-line-mode-menu [glasses-mode]
!   `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode
              :button (:toggle . (bound-and-true-p glasses-mode))))
  (define-key mode-line-mode-menu [hide-ifdef-mode]
!   `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
              :button (:toggle . (bound-and-true-p hide-ifdef-mode))))
  (define-key mode-line-mode-menu [font-lock-mode]
    `(menu-item ,(purecopy "Font-lock") font-lock-mode
              :button (:toggle . font-lock-mode)))
  (define-key mode-line-mode-menu [flyspell-mode]
!   `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode
              :button (:toggle . (bound-and-true-p flyspell-mode))))
  (define-key mode-line-mode-menu [column-number-mode]
    `(menu-item ,(purecopy "Column number") column-number-mode
              :button (:toggle . column-number-mode)))
  (define-key mode-line-mode-menu [auto-fill-mode]
!   `(menu-item ,(purecopy "Auto-fill (Fill)") auto-fill-mode
              :button (:toggle . auto-fill-function)))
  (define-key mode-line-mode-menu [auto-revert-mode]
!   `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
              :button (:toggle . auto-revert-mode)))
  (define-key mode-line-mode-menu [abbrev-mode]
!   `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode
              :button (:toggle . abbrev-mode)))
  
  (defun mode-line-mode-menu (event)
***************
*** 420,434 ****
  ;; Don't use purecopy here--some people want to change these strings.
  (setq minor-mode-alist
        (list
!        (list 'abbrev-mode
!            (propertize " Abbrev"
!                        'help-echo (purecopy "mouse-3: minor mode menu")
!                        'local-map mode-line-minor-mode-keymap))
         '(overwrite-mode overwrite-mode)
!        (list 'auto-fill-function
!            (propertize " Fill"
!                        'help-echo (purecopy "mouse-3: minor mode menu")
!                        'local-map mode-line-minor-mode-keymap))
         ;; not really a minor mode...
         '(defining-kbd-macro " Def")))
  
--- 405,413 ----
  ;; Don't use purecopy here--some people want to change these strings.
  (setq minor-mode-alist
        (list
!        (list 'abbrev-mode " Abbrev")
         '(overwrite-mode overwrite-mode)
!        (list 'auto-fill-function " Fill")
         ;; not really a minor mode...
         '(defining-kbd-macro " Def")))
  

cd ~/emacs/src/
diff -c /home/rms/emacs/src/xdisp.c.\~1.723.\~ /home/rms/emacs/src/xdisp.c
*** /home/rms/emacs/src/xdisp.c.~1.723.~        Sat Jan 26 18:01:19 2002
--- /home/rms/emacs/src/xdisp.c Sat Feb  9 04:06:22 2002
***************
*** 220,226 ****
  Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions;
  Lisp_Object Qredisplay_end_trigger_functions;
  Lisp_Object Qinhibit_point_motion_hooks;
! Lisp_Object QCeval, Qwhen, QCfile, QCdata;
  Lisp_Object Qfontified;
  Lisp_Object Qgrow_only;
  Lisp_Object Qinhibit_eval_during_redisplay;
--- 220,226 ----
  Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions;
  Lisp_Object Qredisplay_end_trigger_functions;
  Lisp_Object Qinhibit_point_motion_hooks;
! Lisp_Object QCeval, Qwhen, QCfile, QCdata, QCpropertize;
  Lisp_Object Qfontified;
  Lisp_Object Qgrow_only;
  Lisp_Object Qinhibit_eval_during_redisplay;
***************
*** 746,752 ****
  static int display_line P_ ((struct it *));
  static int display_mode_lines P_ ((struct window *));
  static int display_mode_line P_ ((struct window *, enum face_id, 
Lisp_Object));
! static int display_mode_element P_ ((struct it *, int, int, int, 
Lisp_Object));
  static char *decode_mode_spec P_ ((struct window *, int, int, int, int *));
  static void display_menu_bar P_ ((struct window *));
  static int display_count_lines P_ ((int, int, int, int, int *));
--- 746,752 ----
  static int display_line P_ ((struct it *));
  static int display_mode_lines P_ ((struct window *));
  static int display_mode_line P_ ((struct window *, enum face_id, 
Lisp_Object));
! static int display_mode_element P_ ((struct it *, int, int, int, Lisp_Object, 
Lisp_Object));
  static char *decode_mode_spec P_ ((struct window *, int, int, int, int *));
  static void display_menu_bar P_ ((struct window *));
  static int display_count_lines P_ ((int, int, int, int, int *));
***************
*** 7247,7253 ****
        frame_title_ptr = frame_title_buf;
        init_iterator (&it, XWINDOW (f->selected_window), -1, -1,
                     NULL, DEFAULT_FACE_ID);
!       display_mode_element (&it, 0, -1, -1, fmt);
        len = frame_title_ptr - frame_title_buf;
        frame_title_ptr = NULL;
        set_buffer_internal_1 (obuf);
--- 7249,7255 ----
        frame_title_ptr = frame_title_buf;
        init_iterator (&it, XWINDOW (f->selected_window), -1, -1,
                     NULL, DEFAULT_FACE_ID);
!       display_mode_element (&it, 0, -1, -1, fmt, Qnil);
        len = frame_title_ptr - frame_title_buf;
        frame_title_ptr = NULL;
        set_buffer_internal_1 (obuf);
***************
*** 13431,13437 ****
  
    if (WINDOW_WANTS_MODELINE_P (w))
      {
!       display_mode_line (w, MODE_LINE_FACE_ID,
                         current_buffer->mode_line_format);
        ++n;
      }
--- 13433,13440 ----
  
    if (WINDOW_WANTS_MODELINE_P (w))
      {
!       /* Select mode line face based on the real selected window.  */
!       display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (old_selected_window),
                         current_buffer->mode_line_format);
        ++n;
      }
***************
*** 13474,13480 ****
       kboard-local variables in the mode_line_format will get the right
       values.  */
    push_frame_kboard (it.f);
!   display_mode_element (&it, 0, 0, 0, format);
    pop_frame_kboard ();
  
    /* Fill up with spaces.  */
--- 13477,13483 ----
       kboard-local variables in the mode_line_format will get the right
       values.  */
    push_frame_kboard (it.f);
!   display_mode_element (&it, 0, 0, 0, format, Qnil);
    pop_frame_kboard ();
  
    /* Fill up with spaces.  */
***************
*** 13500,13505 ****
--- 13503,13509 ----
    return it.glyph_row->height;
  }
  
+ Lisp_Object mode_line_proptrans_alist;
  
  /* Contribute ELT to the mode line for window IT->w.  How it
     translates into text depends on its data type.
***************
*** 13517,13529 ****
     Returns the hpos of the end of the text generated by ELT.  */
  
  static int
! display_mode_element (it, depth, field_width, precision, elt)
       struct it *it;
       int depth;
       int field_width, precision;
!      Lisp_Object elt;
  {
    int n = 0, field, prec;
  
   tail_recurse:
    if (depth > 10)
--- 13521,13534 ----
     Returns the hpos of the end of the text generated by ELT.  */
  
  static int
! display_mode_element (it, depth, field_width, precision, elt, props)
       struct it *it;
       int depth;
       int field_width, precision;
!      Lisp_Object elt, props;
  {
    int n = 0, field, prec;
+   int literal = 0;
  
   tail_recurse:
    if (depth > 10)
***************
*** 13540,13545 ****
--- 13545,13582 ----
        unsigned char *this = XSTRING (elt)->data;
        unsigned char *lisp_string = this;
  
+       if (!NILP (props))
+         {
+           Lisp_Object oprops, aelt;
+           oprops = Ftext_properties_at (make_number (0), elt);
+           if (NILP (Fequal (props, oprops)))
+             {
+               aelt = Fassoc (elt, mode_line_proptrans_alist);
+               if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
+                 elt = XCAR (aelt);
+               else
+                 {
+                   elt = Fcopy_sequence (elt);
+                   Fset_text_properties (0, Flength (elt), props, elt);
+                   mode_line_proptrans_alist
+                     = Fcons (Fcons (elt, props),
+                              mode_line_proptrans_alist);
+                 }
+             }
+         }
+ 
+       if (literal)
+         {
+           prec = precision - n;
+           if (frame_title_ptr)
+             n += store_frame_title (XSTRING (elt)->data, -1, prec);
+           else
+             n += display_string (NULL, elt, Qnil, 0, 0, it,
+                                  0, prec, 0, STRING_MULTIBYTE (elt));
+ 
+           break;
+         }
+ 
        while ((precision <= 0 || n < precision)
               && *this
               && (frame_title_ptr
***************
*** 13592,13598 ****
                
                if (c == 'M')
                  n += display_mode_element (it, depth, field, prec,
!                                            Vglobal_mode_string);
                else if (c != 0)
                  {
                    int multibyte;
--- 13629,13635 ----
                
                if (c == 'M')
                  n += display_mode_element (it, depth, field, prec,
!                                            Vglobal_mode_string, props);
                else if (c != 0)
                  {
                    int multibyte;
***************
*** 13656,13670 ****
            /* If value is a string, output that string literally:
               don't check for % within it.  */
            if (STRINGP (tem))
!             {
!               prec = precision - n;
!               if (frame_title_ptr)
!                 n += store_frame_title (XSTRING (tem)->data, -1, prec);
!               else
!                 n += display_string (NULL, tem, Qnil, 0, 0, it,
!                                      0, prec, 0, STRING_MULTIBYTE (tem));
!             }
!           else if (!EQ (tem, elt))
              {
                /* Give up right away for nil or t.  */
                elt = tem;
--- 13693,13701 ----
            /* If value is a string, output that string literally:
               don't check for % within it.  */
            if (STRINGP (tem))
!             literal = 1;
! 
!           if (!EQ (tem, elt))
              {
                /* Give up right away for nil or t.  */
                elt = tem;
***************
*** 13678,13684 ****
        {
        register Lisp_Object car, tem;
  
!       /* A cons cell: three distinct cases.
           If first element is a string or a cons, process all the elements
           and effectively concatenate them.
           If first element is a negative number, truncate displaying cdr to
--- 13709,13716 ----
        {
        register Lisp_Object car, tem;
  
!       /* A cons cell: five distinct cases.
!          If first element is :eval or :propertize, do something special.
           If first element is a string or a cons, process all the elements
           and effectively concatenate them.
           If first element is a negative number, truncate displaying cdr to
***************
*** 13687,13704 ****
           If first element is a symbol, process the cadr or caddr recursively
           according to whether the symbol's value is non-nil or nil.  */
        car = XCAR (elt);
!       if (EQ (car, QCeval) && CONSP (XCDR (elt)))
          {
            /* An element of the form (:eval FORM) means evaluate FORM
               and use the result as mode line elements.  */
-           struct gcpro gcpro1;
-           Lisp_Object spec;
  
!           spec = safe_eval (XCAR (XCDR (elt)));
!           GCPRO1 (spec);
!           n += display_mode_element (it, depth, field_width - n,
!                                      precision - n, spec);
!           UNGCPRO;
          }
        else if (SYMBOLP (car))
          {
--- 13719,13747 ----
           If first element is a symbol, process the cadr or caddr recursively
           according to whether the symbol's value is non-nil or nil.  */
        car = XCAR (elt);
!       if (EQ (car, QCeval))
          {
            /* An element of the form (:eval FORM) means evaluate FORM
               and use the result as mode line elements.  */
  
!           if (CONSP (XCDR (elt)))
!             {
!               Lisp_Object spec;
!               spec = safe_eval (XCAR (XCDR (elt)));
!               n += display_mode_element (it, depth, field_width - n,
!                                          precision - n, spec, props);
!             }
!         }
!       else if (EQ (car, QCpropertize))
!         {
!           if (CONSP (XCDR (elt)))
!             {
!               /* An element of the form (:propertize ELT PROPS...)
!                  means display ELT but applying properties PROPS.  */
!               n += display_mode_element (it, depth, field_width - n,
!                                          precision - n, XCAR (XCDR (elt)),
!                                          XCDR (XCDR (elt)));
!             }
          }
        else if (SYMBOLP (car))
          {
***************
*** 13763,13769 ****
                   && (precision <= 0 || n < precision))
              {
                n += display_mode_element (it, depth, field_width - n,
!                                          precision - n, XCAR (elt));
                elt = XCDR (elt);
              }
          }
--- 13806,13812 ----
                   && (precision <= 0 || n < precision))
              {
                n += display_mode_element (it, depth, field_width - n,
!                                          precision - n, XCAR (elt), props);
                elt = XCDR (elt);
              }
          }
***************
*** 14722,14727 ****
--- 14765,14772 ----
    staticpro (&QCrelative_height);
    QCeval = intern (":eval");
    staticpro (&QCeval);
+   QCpropertize = intern (":propertize");
+   staticpro (&QCpropertize);
    Qwhen = intern ("when");
    staticpro (&Qwhen);
    QCfile = intern (":file");
***************
*** 14766,14771 ****
--- 14811,14819 ----
  
    Vmessages_buffer_name = build_string ("*Messages*");
    staticpro (&Vmessages_buffer_name);
+ 
+   mode_line_proptrans_alist = Qnil;
+   staticpro (&mode_line_proptrans_alist);
    
    DEFVAR_LISP ("show-trailing-whitespace", &Vshow_trailing_whitespace,
      doc: /* Non-nil means highlight trailing whitespace.

Diff finished at Mon Feb 11 05:36:09