Mercurial > hg > xemacs-beta
view lisp/gui.el @ 4697:0d6d0edf1253
lisp beginning-end-of-defun-function Changelog entry
hg diff
diff -r ecc468b62551 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Sep 21 21:40:35 2009 +0200
+++ b/lisp/ChangeLog Tue Sep 22 21:11:51 2009 +0200
@@ -1,3 +1,12 @@ 2009-09-20 Aidan Kehoe <kehoea@parhasa
+2009-09-22 Andreas Roehler <andreas.roehler@online.de>
+
+ * lisp.el (beginning-of-defun-raw):
+ new variable: beginning-of-defun-function,
+ beginning-of-defun may call FUNCTION determining start position
+ * lisp.el (end-of-defun):
+ new variable: end-of-defun-function,
+ end-of-defun may call FUNCTION determining the end position
+
;;;;;;;;;;;;;;;;;;;;;;;;
hg diff -p -r 4695 -r 4696
diff -r fee33ab25966 -r ecc468b62551 lisp/lisp.el
--- a/lisp/lisp.el Sun Sep 20 23:50:05 2009 +0100
+++ b/lisp/lisp.el Mon Sep 21 21:40:35 2009 +0200
@@ -155,6 +155,21 @@ Negative arg -N means kill N sexps after
(interactive "p")
(kill-sexp (- (or arg 1))))
+
+;; derived stuff from GNU Emacs
+(defvar beginning-of-defun-function nil
+ "If non-nil, function for `beginning-of-defun-raw' to call.
+This is used to find the beginning of the defun instead of using the
+normal recipe (see `beginning-of-defun'). Modes can define this
+if defining `defun-prompt-regexp' is not sufficient to handle the mode's
+needs.")
+
+(defvar end-of-defun-function nil
+ "If non-nil, function for `end-of-defun' to call.
+This is used to find the end of the defun instead of using the normal
+recipe (see `end-of-defun'). Modes can define this if the
+normal method is not appropriate.")
+
(defun beginning-of-defun (&optional arg)
"Move backward to the beginning of a defun.
With argument, do it that many times. Negative arg -N
@@ -175,13 +190,17 @@ This is identical to beginning-of-defun,
This is identical to beginning-of-defun, except that point does not move
to the beginning of the line when `defun-prompt-regexp' is non-nil."
(interactive "p")
- (and arg (< arg 0) (not (eobp)) (forward-char 1))
- (and (re-search-backward (if defun-prompt-regexp
- (concat "^\\s(\\|"
- "\\(" defun-prompt-regexp "\\)\\s(")
- "^\\s(")
- nil 'move (or arg 1))
- (progn (goto-char (1- (match-end 0)))) t))
+ ;; (and arg (< arg 0) (not (eobp)) (forward-char 1))
+ (unless arg (setq arg 1))
+ (cond
+ (beginning-of-defun-function
+ (funcall beginning-of-defun-function arg))
+ (t (re-search-backward (if defun-prompt-regexp
+ (concat "^\\s(\\|"
+ "\\(" defun-prompt-regexp "\\)\\s(")
+ "^\\s(")
+ nil 'move (or arg 1))
+ (progn (goto-char (1- (match-end 0)))) t)))
;; XEmacs change (optional buffer parameter)
(defun buffer-end (arg &optional buffer)
@@ -198,6 +217,10 @@ the open-parenthesis that starts a defun
;; XEmacs change (for zmacs regions)
(interactive "_p")
(if (or (null arg) (= arg 0)) (setq arg 1))
+ (if end-of-defun-function
+ (if (> arg 0)
+ (dotimes (i arg)
+ (funcall end-of-defun-function)))
(let ((first t))
(while (and (> arg 0) (< (point) (point-max)))
(let ((pos (point))) ; XEmacs -- remove unused npos.
@@ -229,7 +252,7 @@ the open-parenthesis that starts a defun
(if (looking-at "\\s<\\|\n")
(forward-line 1)))
(goto-char (point-min)))))
- (setq arg (1+ arg)))))
+ (setq arg (1+ arg))))))
(defun mark-defun ()
"Put mark at end of this defun, point at beginning.
| author | Andreas Roehler <andreas.roehler@online.de> |
|---|---|
| date | Tue, 22 Sep 2009 21:14:03 +0200 |
| parents | 79940b592197 |
| children | 308d34e9f07d |
line wrap: on
line source
;;; gui.el --- Basic GUI functions for XEmacs. ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1996 Ben Wing ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped ;; This file is part of XEmacs. ;; XEmacs 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. ;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Synched up with: Not in FSF ;;; Commentary: ;; This file is dumped with XEmacs (when window system support is compiled in). ;;; Code: (defcustom dialog-frame-plist '(width 60 height 20) "Plist of frame properties for initially creating a dialog frame. Properties specified here supersede the values given in `default-frame-plist'." :type 'plist :group 'frames) (defun make-dialog-frame (&optional props parent) "Create a frame suitable for use as a dialog box. The frame is made a child of PARENT (defaults to the selected frame), and has additional properties PROPS, as well as `dialog-frame-plist'. Normally it also has no modelines, menubars, or toolbars." (or parent (setq parent (selected-frame))) (let* ((ftop (frame-property parent 'top)) (fleft (frame-property parent 'left)) (fwidth (frame-pixel-width parent)) (fheight (frame-pixel-height parent)) (fonth (font-height (face-font 'default))) (fontw (font-width (face-font 'default))) (props (append props dialog-frame-plist)) (dfheight (plist-get props 'height)) (dfwidth (plist-get props 'width)) ;; under FVWM at least, if I don't specify the initial position, ;; it ends up always at (0, 0). xwininfo doesn't tell me ;; that there are any program-specified position hints, so ;; it must be an FVWM bug. So just be smashing and position ;; in the center of the selected frame. (frame (make-frame (append props `(popup ,parent initially-unmapped t menubar-visible-p nil has-modeline-p nil default-toolbar-visible-p nil default-gutter-visible-p nil modeline-shadow-thickness 0 left ,(+ fleft (- (/ fwidth 2) (/ (* dfwidth fontw) 2))) top ,(+ ftop (- (/ fheight 2) (/ (* dfheight fonth) 2)))))))) (set-face-foreground 'modeline [default foreground] frame) (set-face-background 'modeline [default background] frame) (make-frame-visible frame) frame)) (defvar gui-button-shadow-thickness 2) (defun gui-button-p (object) "True if OBJECT is a GUI button." (and (vectorp object) (> (length object) 0) (eq 'button (aref object 0)))) (make-face 'gui-button-face "Face used for gui buttons") (if (not (face-differs-from-default-p 'gui-button-face)) (progn (set-face-reverse-p 'gui-button-face t) (set-face-background 'gui-button-face '(((win color) . "grey75"))) (set-face-foreground 'gui-button-face '(((win color) . "black"))))) (defun gui-button-action (instance action user-data) (let ((domain (image-instance-domain instance))) (with-current-buffer (if (windowp domain) (window-buffer domain) nil) (funcall action user-data)))) (defun make-gui-button (string &optional action user-data) "Make a GUI button whose label is STRING and whose action is ACTION. If the button is inserted in a buffer and then clicked on, and ACTION is non-nil, ACTION will be called with one argument, USER-DATA. When ACTION is called, the buffer containing the button is made current." (vector 'button :descriptor string :face 'gui-button-face :callback-ex `(lambda (image-instance event) (gui-button-action image-instance (quote ,action) (quote ,user-data))))) (defun insert-gui-button (button &optional pos buffer) "Insert GUI button BUTTON at POS in BUFFER." (check-argument-type 'gui-button-p button) (if-fboundp 'make-annotation (make-annotation (make-glyph button) pos 'text buffer nil) (error 'unimplemented "insert-gui-button requires `annotations' package"))) ;;; gui.el ends here