Mercurial > hg > xemacs-beta
diff lisp/modeline.el @ 280:7df0dd720c89 r21-0b38
Import from CVS: tag r21-0b38
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:32:22 +0200 |
parents | 8efd647ea9ca |
children | 558f606b08ae |
line wrap: on
line diff
--- a/lisp/modeline.el Mon Aug 13 10:31:30 2007 +0200 +++ b/lisp/modeline.el Mon Aug 13 10:32:22 2007 +0200 @@ -74,7 +74,7 @@ (start-event-frame (event-frame event)) (start-event-window (event-window event)) (start-nwindows (count-windows t)) - (hscroll-delta (face-width 'modeline)) +;; (hscroll-delta (face-width 'modeline)) ;; (start-hscroll (modeline-hscroll (event-window event))) (start-x-pixel (event-x-pixel event)) (last-timestamp 0) @@ -313,26 +313,12 @@ ;; (append minor-mode-alist ;; '((isearch-mode isearch-mode)))))) -(defvar place) (defun add-minor-mode (toggle name &optional keymap after toggle-fun) "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. TOGGLE is a symbol whose value as a variable specifies whether the minor mode is active. - If TOGGLE has the `:menu-tag' property set to a string, that string - will be used as the label on the `modeline-minor-mode-menu' instead - of TOGGLE's symbol-name. - - TOGGLE may have an `:included' property, which determines whether a - menu button will be shown for this minor mode in the - `modeline-minor-mode-menu'. This should be either a boolean - variable, or an expression evaluating to t or nil. \(See the - documentation of `current-menubar' for more information.) - - It may have an `:active' property also, as documented in - `current-menubar'. - NAME is the name that should appear in the modeline. It should either be a string beginning with a space, or a symbol with a similar string as its value. @@ -349,70 +335,61 @@ modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, TOGGLE is used as the toggle function. -Example: (put 'view-minor-mode :menu-tag \"View (minor)\") - (put 'view-minor-mode :included '(buffer-file-name)) - (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" - (let (el place - (add-elt #'(lambda (elt sym) - (cond ((null after) ; add to front - (set sym (cons elt (symbol-value sym)))) - ((and (not (eq after t)) - (setq place (memq (assq after - (symbol-value sym)) - (symbol-value sym)))) - (setq elt (cons elt (cdr place))) - (setcdr place elt)) - (t - (set sym (append (symbol-value sym) (list elt)))) - ) - (symbol-value sym))) - toggle-keymap) +Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" + (let* ((add-elt #'(lambda (elt sym) + (let (place) + (cond ((null after) ; add to front + (push elt (symbol-value sym))) + ((and (not (eq after t)) + (setq place (memq (assq after + (symbol-value sym)) + (symbol-value sym)))) + (push elt (cdr place))) + (t + (set sym (append (symbol-value sym) + (list elt)))))) + (symbol-value sym))) + el toggle-keymap) (if toggle-fun - (if (not (commandp toggle-fun)) - (error "not an interactive function: %S" toggle-fun)) - (if (commandp toggle) - (setq toggle-fun toggle))) - (if (and toggle-fun name) - (progn - (setq toggle-keymap (make-sparse-keymap - (intern (concat "modeline-minor-" - (symbol-name toggle) - "-map")))) - (define-key toggle-keymap 'button2 - ;; defeat the DUMB-ASS byte-compiler, which tries to - ;; expand the macro at compile time and fucks up. - (eval '(make-modeline-command-wrapper toggle-fun))) - (put toggle 'modeline-toggle-function toggle-fun))) - (and name - (let ((hacked-name - (if toggle-keymap - (cons (let ((extent (make-extent nil nil))) - (set-extent-keymap extent toggle-keymap) - (set-extent-property - extent 'help-echo - (concat "button2 turns off " - (if (symbolp toggle-fun) - (symbol-name toggle-fun) - (symbol-name toggle)))) - extent) - (cons - modeline-mousable-minor-mode-extent - name)) - name))) - (if (setq el (assq toggle minor-mode-alist)) - (setcdr el (list hacked-name)) - (funcall add-elt - (list toggle hacked-name) - 'minor-mode-alist)))) - (and keymap - (if (setq el (assq toggle minor-mode-map-alist)) - (setcdr el keymap) - (funcall add-elt - (cons toggle keymap) - 'minor-mode-map-alist))) - )) + (check-argument-type 'commandp toggle-fun) + (when (commandp toggle) + (setq toggle-fun toggle))) + (when (and toggle-fun name) + (setq toggle-keymap (make-sparse-keymap + (intern (concat "modeline-minor-" + (symbol-name toggle) + "-map")))) + (define-key toggle-keymap 'button2 + ;; defeat the DUMB-ASS byte-compiler, which tries to + ;; expand the macro at compile time and fucks up. + (eval '(make-modeline-command-wrapper toggle-fun))) + (put toggle 'modeline-toggle-function toggle-fun)) + (when name + (let ((hacked-name + (if toggle-keymap + (cons (let ((extent (make-extent nil nil))) + (set-extent-keymap extent toggle-keymap) + (set-extent-property + extent 'help-echo + (concat "button2 turns off " + (if (symbolp toggle-fun) + (symbol-name toggle-fun) + (symbol-name toggle)))) + extent) + (cons modeline-mousable-minor-mode-extent name)) + name))) + (if (setq el (assq toggle minor-mode-alist)) + (setcdr el (list hacked-name)) + (funcall add-elt + (list toggle hacked-name) + 'minor-mode-alist)))) + (when keymap + (if (setq el (assq toggle minor-mode-map-alist)) + (setcdr el keymap) + (funcall add-elt + (cons toggle keymap) + 'minor-mode-map-alist))))) -;; gettext anyone? (put 'abbrev-mode :menu-tag "Abbreviation Expansion") (add-minor-mode 'abbrev-mode " Abbrev") ;; only when visiting a file... @@ -420,10 +397,18 @@ (put 'auto-fill-function :menu-tag "Auto Fill") (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode) -;; what's the meaning of `####' vs `FIXME' or ...? -;; not really a minor mode... and it doesn't work right anyway. -;;(put 'defining-kbd-macro :menu-tag "Defining kbd macro") -;;(add-minor-mode 'defining-kbd-macro " Def") FIXME +(put 'defining-kbd-macro :menu-tag "Keyboard Macro") +(add-minor-mode 'defining-kbd-macro " Def" nil nil + (lambda () + (interactive) + (if defining-kbd-macro + ;; #### 1 means to disregard the last event. + ;; This is needed because the last recorded + ;; event is usually the mouse event that invoked + ;; the menu item (and this function), and having + ;; it in the macro causes problems. + (end-kbd-macro nil 1) + (start-kbd-macro nil)))) (defun modeline-minor-mode-menu (event) "The menu that pops up when you press `button3' inside the @@ -432,38 +417,39 @@ (save-excursion (set-buffer (event-buffer event)) (popup-menu-and-execute-in-window - (cons "Minor Mode Toggles" - (apply 'nconc - (mapcar - #'(lambda (x) - (let* ((toggle-sym (car x)) - (menu-tag (get toggle-sym :menu-tag nil)) - (toggle-fun - (or (get toggle-sym - 'modeline-toggle-function) - (and (fboundp toggle-sym) - (commandp toggle-sym) - toggle-sym)))) - (if (not toggle-fun) nil - (list (vector - (or (and (stringp menu-tag) - menu-tag) - (setq menu-tag (capitalize - (replace-in-string - (replace-in-string - (replace-in-string (if (symbolp toggle-fun) - (symbol-name toggle-fun) - (symbol-name toggle-sym)) - "-" " ") - "minor" " (minor)") - " mode" "")))) - toggle-fun - :active (get toggle-sym :active t) - :included (get toggle-sym :included t) - :style 'toggle - :selected (and (boundp toggle-sym) - toggle-sym)))))) - minor-mode-alist))) + (cons + "Minor Mode Toggles" + (sort + (delq nil (mapcar + #'(lambda (x) + (let* ((toggle-sym (car x)) + (toggle-fun (or (get toggle-sym + 'modeline-toggle-function) + (and (commandp toggle-sym) + toggle-sym))) + (menu-tag (or (get toggle-sym :menu-tag nil) + (symbol-name (if (symbolp toggle-fun) + toggle-fun + toggle-sym)) + ;; Here a function should + ;; maybe be invoked to + ;; beautify the symbol's + ;; menu appearance. + ))) + (and toggle-fun + (vector menu-tag + toggle-fun + ;; The following two are wrong + ;; because of possible name + ;; clashes. + ;:active (get toggle-sym :active t) + ;:included (get toggle-sym :included t) + :style 'toggle + :selected (and (boundp toggle-sym) + toggle-sym))))) + minor-mode-alist)) + (lambda (e1 e2) + (string< (aref e1 0) (aref e2 0))))) event))) (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) @@ -541,6 +527,24 @@ other than ordinary files may change this (e.g. Info, Dired,...)") (make-variable-buffer-local 'modeline-buffer-identification) +(defvar modeline-line-number-map + (make-sparse-keymap 'modeline-line-number-map) +"Keymap consulted for mouse-clicks on the line number in the modeline.") + +(define-key modeline-line-number-map 'button2 'goto-line) + +(defvar modeline-line-number-extent (make-extent nil nil) + "Extent covering the modeline-line-number string.") +(set-extent-face modeline-line-number-extent 'modeline-mousable) +(set-extent-keymap modeline-line-number-extent modeline-line-number-map) +(set-extent-property modeline-line-number-extent 'help-echo + "button2 to goto a specific line") + +(put 'line-number-mode :menu-tag "Line Number") +(add-minor-mode 'line-number-mode "") +(put 'column-number-mode :menu-tag "Column Number") +(add-minor-mode 'column-number-mode "") + (defconst modeline-process nil "Modeline control for displaying info on process status. Normally nil in most modes, since there is no process to display.") @@ -587,7 +591,7 @@ (cons modeline-narrowed-extent "%n") 'modeline-process (purecopy ")%]----") - (purecopy '(line-number-mode "L%l--")) + (cons modeline-line-number-extent (list 'line-number-mode (purecopy "L%l--"))) (purecopy '(column-number-mode "C%c--")) (purecopy '(-3 . "%p")) (purecopy "-%-")))