Mercurial > hg > xemacs-beta

comparison lisp/modeline.el @ 280:7df0dd720c89 r21-0b38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b38
author cvs
date Mon, 13 Aug 2007 10:32:22 +0200
parents 8efd647ea9ca
children 558f606b08ae
comparison
equal deleted inserted replaced
279:c20b2fb5bb0a 280:7df0dd720c89
72 (let ((done nil) 72 (let ((done nil)
73 (depress-line (event-y event)) 73 (depress-line (event-y event))
74 (start-event-frame (event-frame event)) 74 (start-event-frame (event-frame event))
75 (start-event-window (event-window event)) 75 (start-event-window (event-window event))
76 (start-nwindows (count-windows t)) 76 (start-nwindows (count-windows t))
77 (hscroll-delta (face-width 'modeline)) 77 ;; (hscroll-delta (face-width 'modeline))
78 ;; (start-hscroll (modeline-hscroll (event-window event))) 78 ;; (start-hscroll (modeline-hscroll (event-window event)))
79 (start-x-pixel (event-x-pixel event)) 79 (start-x-pixel (event-x-pixel event))
80 (last-timestamp 0) 80 (last-timestamp 0)
81 default-line-height 81 default-line-height
82 modeline-height 82 modeline-height
311 ;; (setq minor-mode-alist 311 ;; (setq minor-mode-alist
312 ;; (purecopy 312 ;; (purecopy
313 ;; (append minor-mode-alist 313 ;; (append minor-mode-alist
314 ;; '((isearch-mode isearch-mode)))))) 314 ;; '((isearch-mode isearch-mode))))))
315 315
316 (defvar place)
317 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) 316 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
318 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. 317 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
319 318
320 TOGGLE is a symbol whose value as a variable specifies whether the 319 TOGGLE is a symbol whose value as a variable specifies whether the
321 minor mode is active. 320 minor mode is active.
322
323 If TOGGLE has the `:menu-tag' property set to a string, that string
324 will be used as the label on the `modeline-minor-mode-menu' instead
325 of TOGGLE's symbol-name.
326
327 TOGGLE may have an `:included' property, which determines whether a
328 menu button will be shown for this minor mode in the
329 `modeline-minor-mode-menu'. This should be either a boolean
330 variable, or an expression evaluating to t or nil. \(See the
331 documentation of `current-menubar' for more information.)
332
333 It may have an `:active' property also, as documented in
334 `current-menubar'.
335 321
336 NAME is the name that should appear in the modeline. It should either 322 NAME is the name that should appear in the modeline. It should either
337 be a string beginning with a space, or a symbol with a similar string 323 be a string beginning with a space, or a symbol with a similar string
338 as its value. 324 as its value.
339 325
347 the mode on and off; this affects what happens when button2 is pressed 333 the mode on and off; this affects what happens when button2 is pressed
348 on the mode, and when button3 is pressed somewhere in the list of 334 on the mode, and when button3 is pressed somewhere in the list of
349 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, 335 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,
350 TOGGLE is used as the toggle function. 336 TOGGLE is used as the toggle function.
351 337
352 Example: (put 'view-minor-mode :menu-tag \"View (minor)\") 338 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
353 (put 'view-minor-mode :included '(buffer-file-name)) 339 (let* ((add-elt #'(lambda (elt sym)
354 (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" 340 (let (place)
355 (let (el place 341 (cond ((null after) ; add to front
356 (add-elt #'(lambda (elt sym) 342 (push elt (symbol-value sym)))
357 (cond ((null after) ; add to front 343 ((and (not (eq after t))
358 (set sym (cons elt (symbol-value sym)))) 344 (setq place (memq (assq after
359 ((and (not (eq after t)) 345 (symbol-value sym))
360 (setq place (memq (assq after 346 (symbol-value sym))))
361 (symbol-value sym)) 347 (push elt (cdr place)))
362 (symbol-value sym)))) 348 (t
363 (setq elt (cons elt (cdr place))) 349 (set sym (append (symbol-value sym)
364 (setcdr place elt)) 350 (list elt))))))
365 (t 351 (symbol-value sym)))
366 (set sym (append (symbol-value sym) (list elt)))) 352 el toggle-keymap)
367 )
368 (symbol-value sym)))
369 toggle-keymap)
370 (if toggle-fun 353 (if toggle-fun
371 (if (not (commandp toggle-fun)) 354 (check-argument-type 'commandp toggle-fun)
372 (error "not an interactive function: %S" toggle-fun)) 355 (when (commandp toggle)
373 (if (commandp toggle) 356 (setq toggle-fun toggle)))
374 (setq toggle-fun toggle))) 357 (when (and toggle-fun name)
375 (if (and toggle-fun name) 358 (setq toggle-keymap (make-sparse-keymap
376 (progn 359 (intern (concat "modeline-minor-"
377 (setq toggle-keymap (make-sparse-keymap 360 (symbol-name toggle)
378 (intern (concat "modeline-minor-" 361 "-map"))))
379 (symbol-name toggle) 362 (define-key toggle-keymap 'button2
380 "-map")))) 363 ;; defeat the DUMB-ASS byte-compiler, which tries to
381 (define-key toggle-keymap 'button2 364 ;; expand the macro at compile time and fucks up.
382 ;; defeat the DUMB-ASS byte-compiler, which tries to 365 (eval '(make-modeline-command-wrapper toggle-fun)))
383 ;; expand the macro at compile time and fucks up. 366 (put toggle 'modeline-toggle-function toggle-fun))
384 (eval '(make-modeline-command-wrapper toggle-fun))) 367 (when name
385 (put toggle 'modeline-toggle-function toggle-fun))) 368 (let ((hacked-name
386 (and name 369 (if toggle-keymap
387 (let ((hacked-name 370 (cons (let ((extent (make-extent nil nil)))
388 (if toggle-keymap 371 (set-extent-keymap extent toggle-keymap)
389 (cons (let ((extent (make-extent nil nil))) 372 (set-extent-property
390 (set-extent-keymap extent toggle-keymap) 373 extent 'help-echo
391 (set-extent-property 374 (concat "button2 turns off "
392 extent 'help-echo 375 (if (symbolp toggle-fun)
393 (concat "button2 turns off " 376 (symbol-name toggle-fun)
394 (if (symbolp toggle-fun) 377 (symbol-name toggle))))
395 (symbol-name toggle-fun) 378 extent)
396 (symbol-name toggle)))) 379 (cons modeline-mousable-minor-mode-extent name))
397 extent) 380 name)))
398 (cons 381 (if (setq el (assq toggle minor-mode-alist))
399 modeline-mousable-minor-mode-extent 382 (setcdr el (list hacked-name))
400 name)) 383 (funcall add-elt
401 name))) 384 (list toggle hacked-name)
402 (if (setq el (assq toggle minor-mode-alist)) 385 'minor-mode-alist))))
403 (setcdr el (list hacked-name)) 386 (when keymap
404 (funcall add-elt 387 (if (setq el (assq toggle minor-mode-map-alist))
405 (list toggle hacked-name) 388 (setcdr el keymap)
406 'minor-mode-alist)))) 389 (funcall add-elt
407 (and keymap 390 (cons toggle keymap)
408 (if (setq el (assq toggle minor-mode-map-alist)) 391 'minor-mode-map-alist)))))
409 (setcdr el keymap) 392
410 (funcall add-elt
411 (cons toggle keymap)
412 'minor-mode-map-alist)))
413 ))
414
415 ;; gettext anyone?
416 (put 'abbrev-mode :menu-tag "Abbreviation Expansion") 393 (put 'abbrev-mode :menu-tag "Abbreviation Expansion")
417 (add-minor-mode 'abbrev-mode " Abbrev") 394 (add-minor-mode 'abbrev-mode " Abbrev")
418 ;; only when visiting a file... 395 ;; only when visiting a file...
419 (add-minor-mode 'overwrite-mode 'overwrite-mode) 396 (add-minor-mode 'overwrite-mode 'overwrite-mode)
420 (put 'auto-fill-function :menu-tag "Auto Fill") 397 (put 'auto-fill-function :menu-tag "Auto Fill")
421 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode) 398 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode)
422 399
423 ;; what's the meaning of `####' vs `FIXME' or ...? 400 (put 'defining-kbd-macro :menu-tag "Keyboard Macro")
424 ;; not really a minor mode... and it doesn't work right anyway. 401 (add-minor-mode 'defining-kbd-macro " Def" nil nil
425 ;;(put 'defining-kbd-macro :menu-tag "Defining kbd macro") 402 (lambda ()
426 ;;(add-minor-mode 'defining-kbd-macro " Def") FIXME 403 (interactive)
404 (if defining-kbd-macro
405 ;; #### 1 means to disregard the last event.
406 ;; This is needed because the last recorded
407 ;; event is usually the mouse event that invoked
408 ;; the menu item (and this function), and having
409 ;; it in the macro causes problems.
410 (end-kbd-macro nil 1)
411 (start-kbd-macro nil))))
427 412
428 (defun modeline-minor-mode-menu (event) 413 (defun modeline-minor-mode-menu (event)
429 "The menu that pops up when you press `button3' inside the 414 "The menu that pops up when you press `button3' inside the
430 parentheses on the modeline." 415 parentheses on the modeline."
431 (interactive "e") 416 (interactive "e")
432 (save-excursion 417 (save-excursion
433 (set-buffer (event-buffer event)) 418 (set-buffer (event-buffer event))
434 (popup-menu-and-execute-in-window 419 (popup-menu-and-execute-in-window
435 (cons "Minor Mode Toggles" 420 (cons
436 (apply 'nconc 421 "Minor Mode Toggles"
437 (mapcar 422 (sort
438 #'(lambda (x) 423 (delq nil (mapcar
439 (let* ((toggle-sym (car x)) 424 #'(lambda (x)
440 (menu-tag (get toggle-sym :menu-tag nil)) 425 (let* ((toggle-sym (car x))
441 (toggle-fun 426 (toggle-fun (or (get toggle-sym
442 (or (get toggle-sym 427 'modeline-toggle-function)
443 'modeline-toggle-function) 428 (and (commandp toggle-sym)
444 (and (fboundp toggle-sym) 429 toggle-sym)))
445 (commandp toggle-sym) 430 (menu-tag (or (get toggle-sym :menu-tag nil)
446 toggle-sym)))) 431 (symbol-name (if (symbolp toggle-fun)
447 (if (not toggle-fun) nil 432 toggle-fun
448 (list (vector 433 toggle-sym))
449 (or (and (stringp menu-tag) 434 ;; Here a function should
450 menu-tag) 435 ;; maybe be invoked to
451 (setq menu-tag (capitalize 436 ;; beautify the symbol's
452 (replace-in-string 437 ;; menu appearance.
453 (replace-in-string 438 )))
454 (replace-in-string (if (symbolp toggle-fun) 439 (and toggle-fun
455 (symbol-name toggle-fun) 440 (vector menu-tag
456 (symbol-name toggle-sym)) 441 toggle-fun
457 "-" " ") 442 ;; The following two are wrong
458 "minor" " (minor)") 443 ;; because of possible name
459 " mode" "")))) 444 ;; clashes.
460 toggle-fun 445 ;:active (get toggle-sym :active t)
461 :active (get toggle-sym :active t) 446 ;:included (get toggle-sym :included t)
462 :included (get toggle-sym :included t) 447 :style 'toggle
463 :style 'toggle 448 :selected (and (boundp toggle-sym)
464 :selected (and (boundp toggle-sym) 449 toggle-sym)))))
465 toggle-sym)))))) 450 minor-mode-alist))
466 minor-mode-alist))) 451 (lambda (e1 e2)
452 (string< (aref e1 0) (aref e2 0)))))
467 event))) 453 event)))
468 454
469 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) 455 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
470 "Keymap consulted for mouse-clicks on the minor-mode modeline list.") 456 "Keymap consulted for mouse-clicks on the minor-mode modeline list.")
471 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) 457 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu)
538 (cons modeline-buffer-id-right-extent (purecopy " %17b"))) 524 (cons modeline-buffer-id-right-extent (purecopy " %17b")))
539 "Modeline control for identifying the buffer being displayed. 525 "Modeline control for identifying the buffer being displayed.
540 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things 526 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things
541 other than ordinary files may change this (e.g. Info, Dired,...)") 527 other than ordinary files may change this (e.g. Info, Dired,...)")
542 (make-variable-buffer-local 'modeline-buffer-identification) 528 (make-variable-buffer-local 'modeline-buffer-identification)
529
530 (defvar modeline-line-number-map
531 (make-sparse-keymap 'modeline-line-number-map)
532 "Keymap consulted for mouse-clicks on the line number in the modeline.")
533
534 (define-key modeline-line-number-map 'button2 'goto-line)
535
536 (defvar modeline-line-number-extent (make-extent nil nil)
537 "Extent covering the modeline-line-number string.")
538 (set-extent-face modeline-line-number-extent 'modeline-mousable)
539 (set-extent-keymap modeline-line-number-extent modeline-line-number-map)
540 (set-extent-property modeline-line-number-extent 'help-echo
541 "button2 to goto a specific line")
542
543 (put 'line-number-mode :menu-tag "Line Number")
544 (add-minor-mode 'line-number-mode "")
545 (put 'column-number-mode :menu-tag "Column Number")
546 (add-minor-mode 'column-number-mode "")
543 547
544 (defconst modeline-process nil 548 (defconst modeline-process nil
545 "Modeline control for displaying info on process status. 549 "Modeline control for displaying info on process status.
546 Normally nil in most modes, since there is no process to display.") 550 Normally nil in most modes, since there is no process to display.")
547 (make-variable-buffer-local 'modeline-process) 551 (make-variable-buffer-local 'modeline-process)
585 (purecopy " %[(") 589 (purecopy " %[(")
586 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) 590 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
587 (cons modeline-narrowed-extent "%n") 591 (cons modeline-narrowed-extent "%n")
588 'modeline-process 592 'modeline-process
589 (purecopy ")%]----") 593 (purecopy ")%]----")
590 (purecopy '(line-number-mode "L%l--")) 594 (cons modeline-line-number-extent (list 'line-number-mode (purecopy "L%l--")))
591 (purecopy '(column-number-mode "C%c--")) 595 (purecopy '(column-number-mode "C%c--"))
592 (purecopy '(-3 . "%p")) 596 (purecopy '(-3 . "%p"))
593 (purecopy "-%-"))) 597 (purecopy "-%-")))
594 598
595 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be 599 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be