Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 99973. ------------------------------------------------------------ revno: 99973 committer: Dan Nicolaescu branch nick: trunk timestamp: Tue 2010-04-20 23:49:28 -0700 message: Remove NOMULTIPLEJOBS. diff: === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2010-04-11 21:45:59 +0000 +++ admin/CPP-DEFINES 2010-04-21 06:49:28 +0000 @@ -57,7 +57,6 @@ INTERRUPT_INPUT MAIL_USE_FLOCK NARROWPROTO -NOMULTIPLEJOBS SEPCHAR SIGTYPE SYSTEM_TYPE ------------------------------------------------------------ revno: 99972 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 23:40:18 -0700 message: * src/ChangeLog: Remove merged duplicate entry. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 06:35:35 +0000 +++ src/ChangeLog 2010-04-21 06:40:18 +0000 @@ -233,14 +233,6 @@ * frame.h (FRAME_LINE_TO_PIXEL_Y): Add missing parenthesis. -2010-04-19 Jan Djärv - - * frame.h (FRAME_TEXT_LINES_TO_PIXEL_HEIGHT): Don't use - FRAME_LINE_TO_PIXEL_Y. - - * xterm.c (x_set_window_size_1): Don't add border_width/height to - pixelwidth/height. - 2010-04-19 Chong Yidong * xdisp.c (prepare_menu_bars): Don't call ns_set_doc_edited for ------------------------------------------------------------ revno: 99971 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 23:35:35 -0700 message: Remove some more cpp in favor of autoconf. * configure.in (LIBSELINUX_LIBS): Always substitute in Makefiles. (GTK_OBJ, DBUS_OBJ, LIBXSM, XMENU_OBJ, XOBJ): New output variables. * src/Makefile.in (DBUS_OBJ, GTK_OBJ, XMENU_OBJ, XOBJ): Define using autoconf, not cpp. (LIBXSM): New variable, set by autoconf. (LIBXT): Use $LIBXSM. diff: === modified file 'ChangeLog' --- ChangeLog 2010-04-21 03:33:04 +0000 +++ ChangeLog 2010-04-21 06:35:35 +0000 @@ -1,6 +1,7 @@ 2010-04-21 Glenn Morris * configure.in (LIBSELINUX_LIBS): Always substitute in Makefiles. + (GTK_OBJ, DBUS_OBJ, LIBXSM, XMENU_OBJ, XOBJ): New output variables. 2010-04-21 Karel Klíč === modified file 'configure.in' --- configure.in 2010-04-21 03:33:04 +0000 +++ configure.in 2010-04-21 06:35:35 +0000 @@ -1612,6 +1612,7 @@ fi +GTK_OBJ= if test x"$pkg_check_gtk" = xyes; then AC_SUBST(GTK_CFLAGS) @@ -1629,6 +1630,7 @@ else HAVE_GTK=yes AC_DEFINE(USE_GTK, 1, [Define to 1 if using GTK.]) + GTK_OBJ=gtkutil.o USE_X_TOOLKIT=none if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then : @@ -1642,6 +1644,7 @@ fi fi +AC_SUBST(GTK_OBJ) if test "${HAVE_GTK}" = "yes"; then @@ -1713,14 +1716,17 @@ dnl other platforms. Support for higher D-Bus versions than 1.0 is dnl also not configured. HAVE_DBUS=no +DBUS_OBJ= if test "${with_dbus}" = "yes"; then PKG_CHECK_MODULES(DBUS, dbus-1 >= 1.0, HAVE_DBUS=yes, HAVE_DBUS=no) if test "$HAVE_DBUS" = yes; then LIBS="$LIBS $DBUS_LIBS" AC_DEFINE(HAVE_DBUS, 1, [Define to 1 if using D-Bus.]) AC_CHECK_FUNCS([dbus_watch_get_unix_fd]) + DBUS_OBJ=dbusbind.o fi fi +AC_SUBST(DBUS_OBJ) dnl GConf has been tested under GNU/Linux only. dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6. @@ -2243,18 +2249,21 @@ ### Use session management (-lSM -lICE) if available HAVE_X_SM=no +LIBXSM= if test "${HAVE_X11}" = "yes"; then AC_CHECK_HEADER(X11/SM/SMlib.h, [AC_CHECK_LIB(SM, SmcOpenConnection, HAVE_X_SM=yes, , -lICE)]) if test "${HAVE_X_SM}" = "yes"; then AC_DEFINE(HAVE_X_SM, 1, [Define to 1 if you have the SM library (-lSM).]) + LIBXSM="-lSM -lICE" case "$LIBS" in *-lSM*) ;; - *) LIBS="-lSM -lICE $LIBS" ;; + *) LIBS="$LIBXSM $LIBS" ;; esac fi fi +AC_SUBST(LIBXSM) # If netdb.h doesn't declare h_errno, we must declare it by hand. AC_CACHE_CHECK(whether netdb declares h_errno, @@ -2762,10 +2771,17 @@ AC_DEFINE_UNQUOTED(UNEXEC_SRC, ${UNEXEC_SRC}, [Define to the unexec source file name.]) +XMENU_OBJ= +XOBJ= if test "${HAVE_X_WINDOWS}" = "yes" ; then AC_DEFINE(HAVE_X_WINDOWS, 1, [Define to 1 if you want to use the X window system.]) + XMENU_OBJ=xmenu.o + XOBJ="xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o xsettings.o xgselect.o" fi +AC_SUBST(XMENU_OBJ) +AC_SUBST(XOBJ) + if test "${USE_X_TOOLKIT}" != "none" ; then AC_DEFINE(USE_X_TOOLKIT, 1, [Define to 1 if using an X toolkit.]) if test "${USE_X_TOOLKIT}" = "LUCID"; then === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 05:47:56 +0000 +++ src/ChangeLog 2010-04-21 06:35:35 +0000 @@ -1,3 +1,10 @@ +2010-04-21 Glenn Morris + + * Makefile.in (DBUS_OBJ, GTK_OBJ, XMENU_OBJ, XOBJ): + Define using autoconf, not cpp. + (LIBXSM): New variable, set by autoconf. + (LIBXT): Use $LIBXSM. + 2010-04-21 Dan Nicolaescu Remove NOMULTIPLEJOBS, unused. === modified file 'src/Makefile.in' --- src/Makefile.in 2010-04-21 03:33:04 +0000 +++ src/Makefile.in 2010-04-21 06:35:35 +0000 @@ -82,10 +82,18 @@ DBUS_CFLAGS = @DBUS_CFLAGS@ DBUS_LIBS = @DBUS_LIBS@ +DBUS_OBJ = @DBUS_OBJ@ GCONF_CFLAGS = @GCONF_CFLAGS@ GCONF_LIBS = @GCONF_LIBS@ +GTK_OBJ=@GTK_OBJ@ + +LIBXSM=@LIBXSM@ + +XMENU_OBJ=@XMENU_OBJ@ +XOBJ=@XOBJ@ + LIBSOUND= @LIBSOUND@ CFLAGS_SOUND= @CFLAGS_SOUND@ @@ -241,10 +249,6 @@ shared=no #endif -#ifdef HAVE_DBUS -DBUS_OBJ = dbusbind.o -#endif - /* DO NOT use -R. There is a special hack described in lastfile.c which is used instead. Some initialized data areas are modified at initial startup, then labeled as part of the text area when @@ -282,16 +286,8 @@ #endif #ifdef HAVE_X_WINDOWS -XMENU_OBJ = xmenu.o -XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o \ - xsettings.o xgselect.o - #ifdef HAVE_MENUS -#ifdef USE_GTK -GTK_OBJ= gtkutil.o -#endif - /* The X Menu stuff is present in the X10 distribution, but missing from X11. If we have X10, just use the installed library; otherwise, use our own copy. */ @@ -354,11 +350,7 @@ LIBXMENU= #endif /* USE_GTK */ -#ifdef HAVE_X_SM -LIBXT=$(LIBW) -lSM -lICE -#else -LIBXT=$(LIBW) -#endif +LIBXT=$(LIBW) $(LIBXSM) #endif /* not USE_X_TOOLKIT */ #ifdef HAVE_X11 ------------------------------------------------------------ revno: 99970 committer: Dan Nicolaescu branch nick: trunk timestamp: Tue 2010-04-20 22:47:56 -0700 message: Remove NOMULTIPLEJOBS, unused. * s/template.h (NOMULTIPLEJOBS): * s/msdos.h (NOMULTIPLEJOBS): Remove, unused. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 05:33:24 +0000 +++ src/ChangeLog 2010-04-21 05:47:56 +0000 @@ -1,5 +1,9 @@ 2010-04-21 Dan Nicolaescu + Remove NOMULTIPLEJOBS, unused. + * s/template.h (NOMULTIPLEJOBS): + * s/msdos.h (NOMULTIPLEJOBS): Remove, unused. + Simplify LD_SWITCH_SYSTEM_TEMACS usage. * s/freebsd.h (LD_SWITCH_SYSTEM_TEMACS): * s/gnu-linux.h (LD_SWITCH_SYSTEM_TEMACS): Remove, configure === modified file 'src/s/msdos.h' --- src/s/msdos.h 2010-04-10 20:38:48 +0000 +++ src/s/msdos.h 2010-04-21 05:47:56 +0000 @@ -44,12 +44,6 @@ #define SYMS_SYSTEM syms_of_dosfns();syms_of_msdos();syms_of_win16select() -/* NOMULTIPLEJOBS should be defined if your system's shell - does not have "job control" (the ability to stop a program, - run some other program, then continue the first one). */ - -#define NOMULTIPLEJOBS - #define SYSV_SYSTEM_DIR /* Define this symbol if your system has the functions bcopy, etc. */ === modified file 'src/s/template.h' --- src/s/template.h 2010-01-13 08:35:10 +0000 +++ src/s/template.h 2010-04-21 05:47:56 +0000 @@ -37,12 +37,6 @@ #define SYSTEM_TYPE "berkeley-unix" -/* NOMULTIPLEJOBS should be defined if your system's shell - does not have "job control" (the ability to stop a program, - run some other program, then continue the first one). */ - -/* #define NOMULTIPLEJOBS */ - /* Emacs can read input using SIGIO and buffering characters itself, or using CBREAK mode and making C-g cause SIGINT. The choice is controlled by the variable interrupt_input. ------------------------------------------------------------ revno: 99969 committer: Dan Nicolaescu branch nick: trunk timestamp: Tue 2010-04-20 22:33:24 -0700 message: Simplify LD_SWITCH_SYSTEM_TEMACS usage. * s/freebsd.h (LD_SWITCH_SYSTEM_TEMACS): * s/gnu-linux.h (LD_SWITCH_SYSTEM_TEMACS): Remove, configure detects -znocombreloc and passes it to the linker * s/hpux10-20.h (LD_SWITCH_SYSTEM_TEMACS): Remove, empty. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 03:33:04 +0000 +++ src/ChangeLog 2010-04-21 05:33:24 +0000 @@ -1,3 +1,11 @@ +2010-04-21 Dan Nicolaescu + + Simplify LD_SWITCH_SYSTEM_TEMACS usage. + * s/freebsd.h (LD_SWITCH_SYSTEM_TEMACS): + * s/gnu-linux.h (LD_SWITCH_SYSTEM_TEMACS): Remove, configure + detects -znocombreloc and passes it to the linker + * s/hpux10-20.h (LD_SWITCH_SYSTEM_TEMACS): Remove, empty. + 2010-04-21 Glenn Morris * Makefile.in (LIBSELINUX_LIBS): Move out of #ifdef. === modified file 'src/s/freebsd.h' --- src/s/freebsd.h 2010-04-16 17:22:12 +0000 +++ src/s/freebsd.h 2010-04-21 05:33:24 +0000 @@ -113,13 +113,5 @@ #define POSIX_SIGNALS 1 -/* The `combreloc' setting became the default, and it seems to be - incompatible with unexec. Symptom is an immediate SEGV in - XtInitializeWidget when starting Emacs under X11. */ - -#if defined __FreeBSD_version && __FreeBSD_version >= 500042 -#define LD_SWITCH_SYSTEM_TEMACS -znocombreloc -#endif - /* arch-tag: 426529ca-b7c4-448f-b10a-d4dcdc9c78eb (do not change this comment) */ === modified file 'src/s/gnu-linux.h' --- src/s/gnu-linux.h 2010-03-30 02:47:23 +0000 +++ src/s/gnu-linux.h 2010-04-21 05:33:24 +0000 @@ -179,12 +179,6 @@ #define LD_SWITCH_SYSTEM LD_SWITCH_X_SITE_AUX #endif /* __mips__ */ -/* Link temacs with -z nocombreloc so that unexec works right, whether or - not -z combreloc is the default. GNU ld ignores unknown -z KEYWORD - switches, so this also works with older versions that don't implement - -z combreloc. */ -#define LD_SWITCH_SYSTEM_TEMACS -z nocombreloc - #ifdef emacs #define INTERRUPT_INPUT #endif @@ -201,7 +195,7 @@ /* _BSD_SOURCE is redundant, at least in glibc2, since we define _GNU_SOURCE. Left in in case it's relevant to libc5 systems and anyone's still using Emacs on those. --fx 2002-12-14 */ -#define C_SWITCH_SYSTEM -D_BSD_SOURCE +/* #define C_SWITCH_SYSTEM -D_BSD_SOURCE */ /* Paul Abrahams says this is needed. */ #define LIB_MOTIF -lXm -lXpm @@ -223,7 +217,7 @@ /* Use BSD process groups, but use setpgid() instead of setpgrp() to actually set a process group. */ /* Interesting: only GNU/Linux defines this, but the BSDs do not... */ -#define BSD_PGRPS +/* #define BSD_PGRPS */ #define NARROWPROTO 1 === modified file 'src/s/hpux10-20.h' --- src/s/hpux10-20.h 2010-04-07 06:11:45 +0000 +++ src/s/hpux10-20.h 2010-04-21 05:33:24 +0000 @@ -105,11 +105,6 @@ /* This triggers a conditional in xfaces.c. */ #define XOS_NEEDS_TIME_H -/* Don't use shared libraries. unexec doesn't handle them. - Note GCC automatically passes -a archive to ld, and it has its own - conflicting -a. */ -#define LD_SWITCH_SYSTEM_TEMACS - #ifndef HAVE_LIBXMU /* HP-UX doesn't supply Xmu. */ #define LIBXMU ------------------------------------------------------------ revno: 99968 committer: Juanma Barranquero branch nick: trunk timestamp: Wed 2010-04-21 05:53:42 +0200 message: tetris.el: Use `define-derived-mode'; fix window selection; doc fixes. * play/tetris.el (tetris, tetris-update-speed-function) (tetris-tty-colors, tetris-x-colors, tetris-move-bottom) (tetris-move-left, tetris-move-right, tetris-rotate-prev) (tetris-rotate-next, tetris-end-game, tetris-start-game) (tetris-pause-game): Fix typos in docstrings. (tetris-mode-map, tetris-null-map): Move initialization into declaration. (tetris-mode): Define with `define-derived-mode'; set show-trailing-whitespace to nil. (tetris): Prefer window already displaying the "*Tetris*" buffer. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-21 03:02:58 +0000 +++ lisp/ChangeLog 2010-04-21 03:53:42 +0000 @@ -1,3 +1,17 @@ +2010-04-21 Juanma Barranquero + + Use `define-derived-mode'; fix window selection; doc fixes. + * play/tetris.el (tetris, tetris-update-speed-function) + (tetris-tty-colors, tetris-x-colors, tetris-move-bottom) + (tetris-move-left, tetris-move-right, tetris-rotate-prev) + (tetris-rotate-next, tetris-end-game, tetris-start-game) + (tetris-pause-game): Fix typos in docstrings. + (tetris-mode-map, tetris-null-map): + Move initialization into declaration. + (tetris-mode): Define with `define-derived-mode'; + set show-trailing-whitespace to nil. + (tetris): Prefer window already displaying the "*Tetris*" buffer. + 2010-04-21 Karel Klíč * files.el (backup-buffer): Handle SELinux context, and return it === modified file 'lisp/play/tetris.el' --- lisp/play/tetris.el 2010-01-13 08:35:10 +0000 +++ lisp/play/tetris.el 2010-04-21 03:53:42 +0000 @@ -35,7 +35,7 @@ ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup tetris nil - "Play a game of tetris." + "Play a game of Tetris." :prefix "tetris-" :group 'games) @@ -61,10 +61,10 @@ (defcustom tetris-update-speed-function 'tetris-default-update-speed-function - "Function run whenever the Tetris score changes + "Function run whenever the Tetris score changes. Called with two arguments: (SHAPES ROWS) -SHAPES is the number of shapes which have been dropped -ROWS is the number of rows which have been completed +SHAPES is the number of shapes which have been dropped. +ROWS is the number of rows which have been completed. If the return value is a number, it is used as the timer period." :group 'tetris @@ -77,7 +77,7 @@ (defcustom tetris-tty-colors [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"] - "Vector of colors of the various shapes in text mode + "Vector of colors of the various shapes in text mode. Element 0 is ignored." :group 'tetris :type (let ((names `("Shape 1" "Shape 2" "Shape 3" @@ -97,7 +97,7 @@ (defcustom tetris-x-colors [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] - "Vector of colors of the various shapes + "Vector of colors of the various shapes. Element 0 is ignored." :group 'tetris :type 'sexp) @@ -274,22 +274,22 @@ ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar tetris-mode-map - (make-sparse-keymap 'tetris-mode-map)) - -(define-key tetris-mode-map "n" 'tetris-start-game) -(define-key tetris-mode-map "q" 'tetris-end-game) -(define-key tetris-mode-map "p" 'tetris-pause-game) - -(define-key tetris-mode-map " " 'tetris-move-bottom) -(define-key tetris-mode-map [left] 'tetris-move-left) -(define-key tetris-mode-map [right] 'tetris-move-right) -(define-key tetris-mode-map [up] 'tetris-rotate-prev) -(define-key tetris-mode-map [down] 'tetris-rotate-next) + (let ((map (make-sparse-keymap 'tetris-mode-map))) + (define-key map "n" 'tetris-start-game) + (define-key map "q" 'tetris-end-game) + (define-key map "p" 'tetris-pause-game) + + (define-key map " " 'tetris-move-bottom) + (define-key map [left] 'tetris-move-left) + (define-key map [right] 'tetris-move-right) + (define-key map [up] 'tetris-rotate-prev) + (define-key map [down] 'tetris-rotate-next) + map)) (defvar tetris-null-map - (make-sparse-keymap 'tetris-null-map)) - -(define-key tetris-null-map "n" 'tetris-start-game) + (let ((map (make-sparse-keymap 'tetris-null-map))) + (define-key map "n" 'tetris-start-game) + map)) ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -508,7 +508,7 @@ (tetris-shape-done))))) (defun tetris-move-bottom () - "Drops the shape to the bottom of the playing area" + "Drop the shape to the bottom of the playing area." (interactive) (if (not tetris-paused) (let ((hit nil)) @@ -521,7 +521,7 @@ (tetris-shape-done)))) (defun tetris-move-left () - "Moves the shape one square to the left" + "Move the shape one square to the left." (interactive) (unless (or (= tetris-pos-x 0) tetris-paused) @@ -532,7 +532,7 @@ (tetris-draw-shape))) (defun tetris-move-right () - "Moves the shape one square to the right" + "Move the shape one square to the right." (interactive) (unless (or (= (+ tetris-pos-x (tetris-shape-width)) tetris-width) @@ -544,7 +544,7 @@ (tetris-draw-shape))) (defun tetris-rotate-prev () - "Rotates the shape clockwise" + "Rotate the shape clockwise." (interactive) (if (not tetris-paused) (progn (tetris-erase-shape) @@ -554,7 +554,7 @@ (tetris-draw-shape)))) (defun tetris-rotate-next () - "Rotates the shape anticlockwise" + "Rotate the shape anticlockwise." (interactive) (if (not tetris-paused) (progn @@ -565,14 +565,14 @@ (tetris-draw-shape)))) (defun tetris-end-game () - "Terminates the current game" + "Terminate the current game." (interactive) (gamegrid-kill-timer) (use-local-map tetris-null-map) (gamegrid-add-score tetris-score-file tetris-score)) (defun tetris-start-game () - "Starts a new game of Tetris" + "Start a new game of Tetris." (interactive) (tetris-reset-game) (use-local-map tetris-mode-map) @@ -581,7 +581,7 @@ (gamegrid-start-timer period 'tetris-update-game))) (defun tetris-pause-game () - "Pauses (or resumes) the current game" + "Pause (or resume) the current game." (interactive) (setq tetris-paused (not tetris-paused)) (message (and tetris-paused "Game paused (press p to resume)"))) @@ -591,21 +591,13 @@ (put 'tetris-mode 'mode-class 'special) -(defun tetris-mode () - "A mode for playing Tetris. - -tetris-mode keybindings: - \\{tetris-mode-map} -" - (kill-all-local-variables) +(define-derived-mode tetris-mode nil "Tetris" + "A mode for playing Tetris." (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) (use-local-map tetris-null-map) - (setq major-mode 'tetris-mode) - (setq mode-name "Tetris") - (unless (featurep 'emacs) (setq mode-popup-menu '("Tetris Commands" @@ -617,12 +609,12 @@ ["Resume" tetris-pause-game (and (tetris-active-p) tetris-paused)]))) + (setq show-trailing-whitespace nil) + (setq gamegrid-use-glyphs tetris-use-glyphs) (setq gamegrid-use-color tetris-use-color) - (gamegrid-init (tetris-display-options)) - - (run-mode-hooks 'tetris-mode-hook)) + (gamegrid-init (tetris-display-options))) ;;;###autoload (defun tetris () @@ -645,6 +637,8 @@ " (interactive) + (select-window (or (get-buffer-window tetris-buffer-name) + (selected-window))) (switch-to-buffer tetris-buffer-name) (gamegrid-kill-timer) (tetris-mode) ------------------------------------------------------------ revno: 99967 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 20:41:01 -0700 message: Regenerate configure. diff: === modified file 'configure' --- configure 2010-04-21 03:11:03 +0000 +++ configure 2010-04-21 03:41:01 +0000 @@ -12720,6 +12720,7 @@ fi HAVE_LIBSELINUX=no +LIBSELINUX_LIBS= if test "${with_selinux}" = "yes"; then { $as_echo "$as_me:$LINENO: checking for lgetfilecon in -lselinux" >&5 $as_echo_n "checking for lgetfilecon in -lselinux... " >&6; } @@ -12799,10 +12800,10 @@ _ACEOF LIBSELINUX_LIBS=-lselinux - fi fi + HAVE_XAW3D=no if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then if test "$with_xaw3d" != no; then ------------------------------------------------------------ revno: 99966 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 20:33:04 -0700 message: Remove LIBSELINUX_LIBS need for cpp in Makefiles. * configure.in (LIBSELINUX_LIBS): Always substitute in Makefiles. * src/Makefile.in (LIBSELINUX_LIBS): Remove containing #ifdef. diff: === modified file 'ChangeLog' --- ChangeLog 2010-04-21 03:02:58 +0000 +++ ChangeLog 2010-04-21 03:33:04 +0000 @@ -1,3 +1,7 @@ +2010-04-21 Glenn Morris + + * configure.in (LIBSELINUX_LIBS): Always substitute in Makefiles. + 2010-04-21 Karel Klíč * configure.in: New option: --with(out)-selinux, on by default. === modified file 'configure.in' --- configure.in 2010-04-21 03:02:58 +0000 +++ configure.in 2010-04-21 03:33:04 +0000 @@ -1734,14 +1734,15 @@ dnl SELinux is available for GNU/Linux only. HAVE_LIBSELINUX=no +LIBSELINUX_LIBS= if test "${with_selinux}" = "yes"; then AC_CHECK_LIB([selinux], [lgetfilecon], HAVE_LIBSELINUX=yes, HAVE_LIBSELINUX=no) if test "$HAVE_LIBSELINUX" = yes; then AC_DEFINE(HAVE_LIBSELINUX, 1, [Define to 1 if using SELinux.]) LIBSELINUX_LIBS=-lselinux - AC_SUBST(LIBSELINUX_LIBS) fi fi +AC_SUBST(LIBSELINUX_LIBS) dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 03:02:58 +0000 +++ src/ChangeLog 2010-04-21 03:33:04 +0000 @@ -1,3 +1,7 @@ +2010-04-21 Glenn Morris + + * Makefile.in (LIBSELINUX_LIBS): Move out of #ifdef. + 2010-04-21 Karel Klíč * Makefile.in (LIBSELINUX_LIBS): New. === modified file 'src/Makefile.in' --- src/Makefile.in 2010-04-21 03:02:58 +0000 +++ src/Makefile.in 2010-04-21 03:33:04 +0000 @@ -92,6 +92,8 @@ RSVG_LIBS= @RSVG_LIBS@ RSVG_CFLAGS= @RSVG_CFLAGS@ +LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ + INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ @@ -243,10 +245,6 @@ DBUS_OBJ = dbusbind.o #endif -#ifdef HAVE_LIBSELINUX -LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ -#endif - /* DO NOT use -R. There is a special hack described in lastfile.c which is used instead. Some initialized data areas are modified at initial startup, then labeled as part of the text area when ------------------------------------------------------------ revno: 99965 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 20:11:03 -0700 message: Regenerate configure, src/config.in. diff: === modified file 'configure' --- configure 2010-04-03 01:54:24 +0000 +++ configure 2010-04-21 03:11:03 +0000 @@ -718,6 +718,7 @@ DBUS_LIBS GCONF_CFLAGS GCONF_LIBS +LIBSELINUX_LIBS FONTCONFIG_CFLAGS FONTCONFIG_LIBS XFT_CFLAGS @@ -811,6 +812,7 @@ with_gpm with_dbus with_gconf +with_selinux with_makeinfo with_gtk with_gcc @@ -1524,6 +1526,7 @@ console --without-dbus don't compile with D-Bus support --without-gconf don't compile with GConf support + --without-selinux don't compile with SELinux support --without-makeinfo don't require makeinfo for building manuals --with-pkg-config-prog=PATH @@ -2316,6 +2319,14 @@ fi +# Check whether --with-selinux was given. +if test "${with_selinux+set}" = set; then + withval=$with_selinux; +else + with_selinux=yes +fi + + ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -2773,15 +2784,6 @@ esac ;; - ## LynxOS ports - *-*-lynxos* ) - opsys=lynxos - case "${canonical}" in - i[3456]86-*-lynxos*) machine=intel386 ;; - powerpc-*-lynxos*) machine=powerpc ;; - esac - ;; - alpha*-*-linux-gnu* ) machine=alpha opsys=gnu-linux ;; @@ -2865,30 +2867,14 @@ *-sun-solaris* \ | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \ - | x86_64-*-solaris2* | x86_64-*-sunos5* \ - | powerpc*-*-solaris2* | rs6000-*-solaris2*) + | x86_64-*-solaris2* | x86_64-*-sunos5*) case "${canonical}" in i[3456]86-*-* ) machine=intel386 ;; amd64-*-*|x86_64-*-*) machine=amdx86-64 ;; - powerpc* | rs6000* ) machine=ibmrs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; esac case "${canonical}" in - *-sunos5.3* | *-solaris2.3* ) - opsys=sol2-3 - NON_GNU_CPP=/usr/ccs/lib/cpp - ;; - *-sunos5.4* | *-solaris2.4* ) - opsys=sol2-4 - NON_GNU_CPP=/usr/ccs/lib/cpp - RANLIB="ar -ts" - ;; - *-sunos5.5* | *-solaris2.5* ) - opsys=sol2-5 - NON_GNU_CPP=/usr/ccs/lib/cpp - RANLIB="ar -ts" - ;; *-sunos5.6* | *-solaris2.6* ) opsys=sol2-6 NON_GNU_CPP=/usr/ccs/lib/cpp @@ -2979,22 +2965,6 @@ if test x"${opsys}" = x; then case "${canonical}" in *-gnu* ) opsys=gnu ;; - *-sysv4.2uw* ) opsys=unixware ;; - *-sysv5uw* ) opsys=unixware ;; - *-sysv5OpenUNIX* ) opsys=unixware ;; - *-sysv4.1* | *-sysvr4.1* ) - NON_GNU_CPP=/usr/lib/cpp - opsys=usg5-4 ;; - *-sysv4.[2-9]* | *-sysvr4.[2-9]* ) - if [ x$NON_GNU_CPP = x ]; then - if [ -f /usr/ccs/lib/cpp ]; then - NON_GNU_CPP=/usr/ccs/lib/cpp - else - NON_GNU_CPP=/lib/cpp - fi - fi - opsys=usg5-4-2 ;; - *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; * ) unported=yes ;; @@ -5816,10 +5786,6 @@ configure___ use_mmap_for_buffers=no #endif -#ifndef C_DEBUG_SWITCH -#define C_DEBUG_SWITCH -g -#endif - #ifndef C_OPTIMIZE_SWITCH #ifdef __GNUC__ #define C_OPTIMIZE_SWITCH -O2 @@ -5851,18 +5817,18 @@ /* Get the CFLAGS for tests in configure. */ #ifdef __GNUC__ -configure___ CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' +configure___ CFLAGS=C_OPTIMIZE_SWITCH '${SPECIFIED_CFLAGS}' #else -configure___ CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' +configure___ CFLAGS='${SPECIFIED_CFLAGS}' #endif #else /* not THIS_IS_CONFIGURE */ /* Get the CFLAGS for real compilation. */ #ifdef __GNUC__ -configure___ REAL_CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH C_WARNINGS_SWITCH ${PROFILING_CFLAGS} '${SPECIFIED_CFLAGS}' +configure___ REAL_CFLAGS=C_OPTIMIZE_SWITCH C_WARNINGS_SWITCH ${PROFILING_CFLAGS} '${SPECIFIED_CFLAGS}' #else -configure___ REAL_CFLAGS=C_DEBUG_SWITCH '${SPECIFIED_CFLAGS}' +configure___ REAL_CFLAGS='${SPECIFIED_CFLAGS}' #endif #endif /* not THIS_IS_CONFIGURE */ @@ -12753,6 +12719,90 @@ fi fi +HAVE_LIBSELINUX=no +if test "${with_selinux}" = "yes"; then + { $as_echo "$as_me:$LINENO: checking for lgetfilecon in -lselinux" >&5 +$as_echo_n "checking for lgetfilecon in -lselinux... " >&6; } +if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lselinux $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lgetfilecon (); +int +main () +{ +return lgetfilecon (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then + ac_cv_lib_selinux_lgetfilecon=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_selinux_lgetfilecon=no +fi + +rm -rf conftest.dSYM +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_selinux_lgetfilecon" >&5 +$as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; } +if test $ac_cv_lib_selinux_lgetfilecon = yes; then + HAVE_LIBSELINUX=yes +else + HAVE_LIBSELINUX=no +fi + + if test "$HAVE_LIBSELINUX" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_LIBSELINUX 1 +_ACEOF + + LIBSELINUX_LIBS=-lselinux + + fi +fi + HAVE_XAW3D=no if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then if test "$with_xaw3d" != no; then @@ -21156,6 +21206,7 @@ { (exit 1); exit 1; }; } fi # Must define this when any termcap library is found. + cat >>confdefs.h <<\_ACEOF #define HAVE_LIBNCURSES 1 _ACEOF @@ -25936,6 +25987,7 @@ echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" +echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" === modified file 'src/config.in' --- src/config.in 2010-03-24 18:02:56 +0000 +++ src/config.in 2010-04-21 03:11:03 +0000 @@ -318,10 +318,10 @@ /* Define to 1 if you have the header file. */ #undef HAVE_KERBEROS_KRB_H -/* Define to 1 if `e_text' is a member of `krb5_error'. */ +/* Define to 1 if `e_text' is member of `krb5_error'. */ #undef HAVE_KRB5_ERROR_E_TEXT -/* Define to 1 if `text' is a member of `krb5_error'. */ +/* Define to 1 if `text' is member of `krb5_error'. */ #undef HAVE_KRB5_ERROR_TEXT /* Define to 1 if you have the header file. */ @@ -399,6 +399,9 @@ /* Define to 1 if you have the resolv library (-lresolv). */ #undef HAVE_LIBRESOLV +/* Define to 1 if using SELinux. */ +#undef HAVE_LIBSELINUX + /* Define to 1 if you have the `Xext' library (-lXext). */ #undef HAVE_LIBXEXT @@ -615,25 +618,25 @@ /* Define to 1 if you have the `strsignal' function. */ #undef HAVE_STRSIGNAL -/* Define to 1 if `ifr_addr' is a member of `struct ifreq'. */ +/* Define to 1 if `ifr_addr' is member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_ADDR -/* Define to 1 if `ifr_broadaddr' is a member of `struct ifreq'. */ +/* Define to 1 if `ifr_broadaddr' is member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_BROADADDR -/* Define to 1 if `ifr_flags' is a member of `struct ifreq'. */ +/* Define to 1 if `ifr_flags' is member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_FLAGS -/* Define to 1 if `ifr_hwaddr' is a member of `struct ifreq'. */ +/* Define to 1 if `ifr_hwaddr' is member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_HWADDR -/* Define to 1 if `ifr_netmask' is a member of `struct ifreq'. */ +/* Define to 1 if `ifr_netmask' is member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_NETMASK -/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */ +/* Define to 1 if `n_un.n_name' is member of `struct nlist'. */ #undef HAVE_STRUCT_NLIST_N_UN_N_NAME -/* Define to 1 if `tm_zone' is a member of `struct tm'. */ +/* Define to 1 if `tm_zone' is member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE /* Define to 1 if `struct utimbuf' is declared by . */ @@ -860,9 +863,6 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME -/* Define to the home page for this package. */ -#undef PACKAGE_URL - /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -922,28 +922,6 @@ /* Define to 1 if using the Motif X toolkit. */ #undef USE_MOTIF -/* Enable extensions on AIX 3, Interix. */ -#ifndef _ALL_SOURCE -# undef _ALL_SOURCE -#endif -/* Enable GNU extensions on systems that have them. */ -#ifndef _GNU_SOURCE -# undef _GNU_SOURCE -#endif -/* Enable threading extensions on Solaris. */ -#ifndef _POSIX_PTHREAD_SEMANTICS -# undef _POSIX_PTHREAD_SEMANTICS -#endif -/* Enable extensions on HP NonStop. */ -#ifndef _TANDEM_SOURCE -# undef _TANDEM_SOURCE -#endif -/* Enable general extensions on Solaris. */ -#ifndef __EXTENSIONS__ -# undef __EXTENSIONS__ -#endif - - /* Define to 1 if we should use toolkit scroll bars. */ #undef USE_TOOLKIT_SCROLL_BARS @@ -979,6 +957,28 @@ /* Define to 1 if you need to in order for `stat' and other things to work. */ #undef _POSIX_SOURCE +/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif + + /* Define to rpl_ if the getopt replacement functions and variables should be used. */ #undef __GETOPT_PREFIX ------------------------------------------------------------ revno: 99964 committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 20:08:21 -0700 message: Doc updates for SELinux support. * ack.texi, emacs.texi (Acknowledgments): Add SELinux support. * etc/NEWS: Mention SELinux support. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2010-04-19 15:07:52 +0000 +++ doc/emacs/ChangeLog 2010-04-21 03:08:21 +0000 @@ -1,3 +1,7 @@ +2010-04-21 Glenn Morris + + * ack.texi, emacs.texi (Acknowledgments): Add SELinux support. + 2010-04-18 Chong Yidong * programs.texi (Semantic): New node. === modified file 'doc/emacs/ack.texi' --- doc/emacs/ack.texi 2010-04-19 15:07:52 +0000 +++ doc/emacs/ack.texi 2010-04-21 03:08:21 +0000 @@ -574,6 +574,10 @@ Emacs. @item +Karel Kl@'{@dotless{i}}@v{c} contributed SELinux support, for preserving the +Security-Enchanced Linux context of files on backup and copy. + +@item Shuhei Kobayashi wrote @file{hex-util.el}, for operating on hexadecimal strings; support for HMAC (Keyed-Hashing for Message Authentication); and a Lisp implementation of the SHA1 Secure Hash Algorithm. === modified file 'doc/emacs/emacs.texi' --- doc/emacs/emacs.texi 2010-04-19 15:07:52 +0000 +++ doc/emacs/emacs.texi 2010-04-21 03:08:21 +0000 @@ -1375,12 +1375,12 @@ Jones, Simon Josefsson, Arne J@o{}rgensen, Tomoji Kagatani, Brewster Kahle, Tokuya Kameshima, Lute Kamstra, David Kastrup, David Kaufman, Henry Kautz, Taichi Kawabata, Howard Kaye, Michael Kifer, Richard King, -Peter Kleiweg, Shuhei Kobayashi, Pavel Kobiakov, Larry K.@: Kolodney, -David M.@: Koppelman, Koseki Yoshinori, Robert Krawitz, Sebastian -Kremer, Ryszard Kubiak, David K@aa{}gedal, Daniel LaLiberte, Karl -Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, Vinicius Jose -Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Lars -Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov, +Peter Kleiweg, Karel Kl@'{@dotless{i}}@v{c}, Shuhei Kobayashi, Pavel +Kobiakov, Larry K.@: Kolodney, David M.@: Koppelman, Koseki Yoshinori, +Robert Krawitz, Sebastian Kremer, Ryszard Kubiak, David K@aa{}gedal, Daniel +LaLiberte, Karl Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, +Vinicius Jose Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, +Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov, Francis Litterio, Emilio C. Lopes, K@'{a}roly L@H{o}rentey, Dave Love, Sascha L@"{u}decke, Eric Ludlam, Alan Mackenzie, Christopher J.@: Madsen, Neil M.@: Mager, Ken Manheimer, Bill Mann, Brian Marick, Simon === modified file 'etc/NEWS' --- etc/NEWS 2010-04-21 02:05:24 +0000 +++ etc/NEWS 2010-04-21 03:08:21 +0000 @@ -30,6 +30,9 @@ These provide no new functionality, they just remove the need to edit lib-src/Makefile by hand in order to use the associated features. +** Configure links against libselinux if it is found. +You can disable this by using --without-selinux. + * Startup Changes in Emacs 24.1 @@ -68,6 +71,14 @@ ** Lucid menus and dialogs can display antialiased fonts if Emacs is built with Xft. +** Basic SELinux support has been added. +This requires Emacs to be linked with libselinux at build time. + +*** Emacs preserves the SELinux file context when backing up or copying files. + +*** The new functions file-selinux-context and set-file-selinux-context +get and set the SELinux context of a file. + ** New scrolling commands `scroll-up-command' and `scroll-down-command' (bound to C-v/[next] and M-v/[prior]) does not signal errors at top/bottom of buffer at first key-press (instead moves to top/bottom of buffer) ------------------------------------------------------------ revno: 99963 author: Karel Klic committer: Glenn Morris branch nick: trunk timestamp: Tue 2010-04-20 20:02:58 -0700 message: Add SELinux support. * configure.in: New option: --with(out)-selinux, on by default. Set HAVE_LIBSELINUX if we find libselinux, and substitute LIBSELINUX_LIBS in Makefiles. * src/Makefile.in (LIBSELINUX_LIBS): New. (LIBES): Add $LIBSELINUX_LIBS. * src/eval.c, lisp.h (call7): New function. * src/fileio.c [HAVE_LIBSELINUX]: Include selinux headers. (Ffile_selinux_context, Fset_file_selinux_context): New functions. (Fcopy_file): New parameter preserve-selinux-context. (Frename_file): Preserve selinux context when renaming by copy-file. * lisp/files.el (backup-buffer): Handle SELinux context, and return it if a backup was made by renaming. (backup-buffer-copy): Set SELinux context to the target file. (basic-save-buffer): Set SELinux context of the newly written file. (basic-save-buffer-1): Now it also returns any SELinux context. (basic-save-buffer-2): Set SELinux context of the newly created file, and return it. * lisp/net/tramp.el (tramp-file-name-for-operation): Add file-selinux-context. diff: === modified file 'ChangeLog' --- ChangeLog 2010-04-03 01:54:24 +0000 +++ ChangeLog 2010-04-21 03:02:58 +0000 @@ -1,3 +1,9 @@ +2010-04-21 Karel Klíč + + * configure.in: New option: --with(out)-selinux, on by default. + Set HAVE_LIBSELINUX if we find libselinux, and substitute + LIBSELINUX_LIBS in Makefiles. + 2010-04-01 Dan Nicolaescu * configure.in: Remove all references to LIBX11_SYSTEM. === modified file 'configure.in' --- configure.in 2010-04-03 01:54:24 +0000 +++ configure.in 2010-04-21 03:02:58 +0000 @@ -161,6 +161,7 @@ OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) +OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -1731,6 +1732,17 @@ fi fi +dnl SELinux is available for GNU/Linux only. +HAVE_LIBSELINUX=no +if test "${with_selinux}" = "yes"; then + AC_CHECK_LIB([selinux], [lgetfilecon], HAVE_LIBSELINUX=yes, HAVE_LIBSELINUX=no) + if test "$HAVE_LIBSELINUX" = yes; then + AC_DEFINE(HAVE_LIBSELINUX, 1, [Define to 1 if using SELinux.]) + LIBSELINUX_LIBS=-lselinux + AC_SUBST(LIBSELINUX_LIBS) + fi +fi + dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. HAVE_XAW3D=no @@ -3083,6 +3095,7 @@ echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" +echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-21 02:05:24 +0000 +++ lisp/ChangeLog 2010-04-21 03:02:58 +0000 @@ -1,3 +1,15 @@ +2010-04-21 Karel Klíč + + * files.el (backup-buffer): Handle SELinux context, and return it + if a backup was made by renaming. + (backup-buffer-copy): Set SELinux context to the target file. + (basic-save-buffer): Set SELinux context of the newly written file. + (basic-save-buffer-1): Now it also returns any SELinux context. + (basic-save-buffer-2): Set SELinux context of the newly created file, + and return it. + * net/tramp.el (tramp-file-name-for-operation): + Add file-selinux-context. + 2010-04-21 Stefan Monnier * vc.el (vc-checkin, vc-modify-change-comment): === modified file 'lisp/files.el' --- lisp/files.el 2010-04-18 23:08:52 +0000 +++ lisp/files.el 2010-04-21 03:02:58 +0000 @@ -3625,10 +3625,13 @@ no longer accessible under its old name. The value is non-nil after a backup was made by renaming. -It has the form (MODES . BACKUPNAME). +It has the form (MODES SELINUXCONTEXT BACKUPNAME). MODES is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes. +SELINUXCONTEXT is the result of `file-selinux-context' on the original +file; this means that the caller, after saving the buffer, should change +the SELinux context of the new file to agree with the old context. BACKUPNAME is the backup file name, which is the old file renamed." (if (and make-backup-files (not backup-inhibited) (not buffer-backed-up) @@ -3656,7 +3659,8 @@ (or delete-old-versions (y-or-n-p (format "Delete excess backup versions of %s? " real-file-name))))) - (modes (file-modes buffer-file-name))) + (modes (file-modes buffer-file-name)) + (context (file-selinux-context buffer-file-name))) ;; Actually write the back up file. (condition-case () (if (or file-precious-flag @@ -3676,10 +3680,10 @@ (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) (or (nth 9 attr) (not (file-ownership-preserved-p real-file-name))))))) - (backup-buffer-copy real-file-name backupname modes) + (backup-buffer-copy real-file-name backupname modes context) ;; rename-file should delete old backup. (rename-file real-file-name backupname t) - (setq setmodes (cons modes backupname))) + (setq setmodes (list modes context backupname))) (file-error ;; If trouble writing the backup, write it in ~. (setq backupname (expand-file-name @@ -3688,7 +3692,7 @@ (message "Cannot write backup file; backing up in %s" backupname) (sleep-for 1) - (backup-buffer-copy real-file-name backupname modes))) + (backup-buffer-copy real-file-name backupname modes context))) (setq buffer-backed-up t) ;; Now delete the old versions, if desired. (if delete-old-versions @@ -3700,7 +3704,7 @@ setmodes) (file-error nil)))))) -(defun backup-buffer-copy (from-name to-name modes) +(defun backup-buffer-copy (from-name to-name modes context) (let ((umask (default-file-modes))) (unwind-protect (progn @@ -3727,7 +3731,9 @@ ;; Reset the umask. (set-default-file-modes umask))) (and modes - (set-file-modes to-name (logand modes #o1777)))) + (set-file-modes to-name (logand modes #o1777))) + (and context + (set-file-selinux-context to-name context))) (defun file-name-sans-versions (name &optional keep-backup-version) "Return file NAME sans backup versions or strings. @@ -4257,7 +4263,9 @@ (nthcdr 10 (file-attributes buffer-file-name))) (if setmodes (condition-case () - (set-file-modes buffer-file-name (car setmodes)) + (progn + (set-file-modes buffer-file-name (car setmodes)) + (set-file-selinux-context buffer-file-name (nth 1 setmodes))) (error nil)))) ;; If the auto-save file was recent before this command, ;; delete it now. @@ -4270,7 +4278,7 @@ ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done ;; but inhibited if one of write-file-functions returns non-nil. -;; It returns a value (MODES . BACKUPNAME), like backup-buffer. +;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. (defun basic-save-buffer-1 () (prog1 (if save-buffer-coding-system @@ -4282,7 +4290,7 @@ (setq buffer-file-coding-system-explicit (cons last-coding-system-used nil))))) -;; This returns a value (MODES . BACKUPNAME), like backup-buffer. +;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) (if (not (file-writable-p buffer-file-name)) @@ -4353,8 +4361,9 @@ ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes - (cons (or (file-modes buffer-file-name) + (list (or (file-modes buffer-file-name) (logand ?\666 umask)) + (file-selinux-context buffer-file-name) buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. @@ -4365,8 +4374,11 @@ ;; (setmodes is set) because that says we're superseding. (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. - (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name)) - (set-file-modes buffer-file-name (logior (car setmodes) 128)))) + (setq setmodes (list (file-modes buffer-file-name) + (file-selinux-context buffer-file-name) + buffer-file-name)) + (set-file-modes buffer-file-name (logior (car setmodes) 128)) + (set-file-selinux-context buffer-file-name (nth 1 setmodes))))) (let (success) (unwind-protect (progn @@ -4380,8 +4392,8 @@ ;; the backup by renaming, undo the backing-up. (and setmodes (not success) (progn - (rename-file (cdr setmodes) buffer-file-name t) - (setq buffer-backed-up nil))))))) + (rename-file (nth 2 setmodes) buffer-file-name t) + (setq buffer-backed-up nil)))))) setmodes)) (defun diff-buffer-with-file (&optional buffer) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2010-04-15 22:19:01 +0000 +++ lisp/net/tramp.el 2010-04-21 03:02:58 +0000 @@ -5326,7 +5326,7 @@ 'dired-compress-file 'dired-uncache 'file-accessible-directory-p 'file-attributes 'file-directory-p 'file-executable-p 'file-exists-p - 'file-local-copy 'file-remote-p 'file-modes + 'file-local-copy 'file-remote-p 'file-modes 'file-selinux-context 'file-name-as-directory 'file-name-directory 'file-name-nondirectory 'file-name-sans-versions 'file-ownership-preserved-p 'file-readable-p === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 00:49:40 +0000 +++ src/ChangeLog 2010-04-21 03:02:58 +0000 @@ -1,3 +1,14 @@ +2010-04-21 Karel Klíč + + * Makefile.in (LIBSELINUX_LIBS): New. + (LIBES): Add $LIBSELINUX_LIBS. + * eval.c, lisp.h (call7): New function. + * fileio.c [HAVE_LIBSELINUX]: Include selinux headers. + (Ffile_selinux_context, Fset_file_selinux_context): + New functions. + (Fcopy_file): New parameter preserve-selinux-context. + (Frename_file): Preserve selinux context when renaming by copy-file. + 2010-04-21 Juanma Barranquero Eli Zaretskii === modified file 'src/Makefile.in' --- src/Makefile.in 2010-04-14 15:36:25 +0000 +++ src/Makefile.in 2010-04-21 03:02:58 +0000 @@ -243,6 +243,10 @@ DBUS_OBJ = dbusbind.o #endif +#ifdef HAVE_LIBSELINUX +LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ +#endif + /* DO NOT use -R. There is a special hack described in lastfile.c which is used instead. Some initialized data areas are modified at initial startup, then labeled as part of the text area when @@ -824,7 +828,7 @@ LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \ @LIBGPM@ @LIBRESOLV@ LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \ - $(GETLOADAVG_LIBS) ${GCONF_LIBS} \ + $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ @FREETYPE_LIBS@ @FONTCONFIG_LIBS@ @LIBOTF_LIBS@ @M17N_FLT_LIBS@ \ $(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR) === modified file 'src/eval.c' --- src/eval.c 2010-04-20 01:50:52 +0000 +++ src/eval.c 2010-04-21 03:02:58 +0000 @@ -2952,6 +2952,33 @@ #endif /* not NO_ARG_ARRAY */ } +/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */ +/* ARGSUSED */ +Lisp_Object +call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7) + Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7; +{ + struct gcpro gcpro1; +#ifdef NO_ARG_ARRAY + Lisp_Object args[8]; + args[0] = fn; + args[1] = arg1; + args[2] = arg2; + args[3] = arg3; + args[4] = arg4; + args[5] = arg5; + args[6] = arg6; + args[7] = arg7; + GCPRO1 (args[0]); + gcpro1.nvars = 8; + RETURN_UNGCPRO (Ffuncall (8, args)); +#else /* not NO_ARG_ARRAY */ + GCPRO1 (fn); + gcpro1.nvars = 8; + RETURN_UNGCPRO (Ffuncall (8, &fn)); +#endif /* not NO_ARG_ARRAY */ +} + /* The caller should GCPRO all the elements of ARGS. */ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, === modified file 'src/fileio.c' --- src/fileio.c 2010-04-13 01:47:40 +0000 +++ src/fileio.c 2010-04-21 03:02:58 +0000 @@ -53,6 +53,11 @@ #include #include +#ifdef HAVE_LIBSELINUX +#include +#include +#endif + #include "lisp.h" #include "intervals.h" #include "buffer.h" @@ -331,6 +336,8 @@ Lisp_Object Qfile_modes; Lisp_Object Qset_file_modes; Lisp_Object Qset_file_times; +Lisp_Object Qfile_selinux_context; +Lisp_Object Qset_file_selinux_context; Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; Lisp_Object Qwrite_region; @@ -1894,7 +1901,7 @@ return; } -DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5, +DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6, "fCopy file: \nGCopy %s to file: \np\nP", doc: /* Copy FILE to NEWNAME. Both args must be strings. If NEWNAME names a directory, copy FILE there. @@ -1916,10 +1923,13 @@ A prefix arg makes KEEP-TIME non-nil. If PRESERVE-UID-GID is non-nil, we try to transfer the -uid and gid of FILE to NEWNAME. */) - (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid) +uid and gid of FILE to NEWNAME. + +If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled +on the system, we copy the SELinux context of FILE to NEWNAME. */) + (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid, preserve_selinux_context) Lisp_Object file, newname, ok_if_already_exists, keep_time; - Lisp_Object preserve_uid_gid; + Lisp_Object preserve_uid_gid, preserve_selinux_context; { int ifd, ofd, n; char buf[16 * 1024]; @@ -1929,6 +1939,10 @@ int count = SPECPDL_INDEX (); int input_file_statable_p; Lisp_Object encoded_file, encoded_newname; +#if HAVE_LIBSELINUX + security_context_t con; + int fail, conlength = 0; +#endif encoded_file = encoded_newname = Qnil; GCPRO4 (file, newname, encoded_file, encoded_newname); @@ -1949,8 +1963,9 @@ if (NILP (handler)) handler = Ffind_file_name_handler (newname, Qcopy_file); if (!NILP (handler)) - RETURN_UNGCPRO (call6 (handler, Qcopy_file, file, newname, - ok_if_already_exists, keep_time, preserve_uid_gid)); + RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname, + ok_if_already_exists, keep_time, preserve_uid_gid, + preserve_selinux_context)); encoded_file = ENCODE_FILE (file); encoded_newname = ENCODE_FILE (newname); @@ -2004,6 +2019,15 @@ copyable by us. */ input_file_statable_p = (fstat (ifd, &st) >= 0); +#if HAVE_LIBSELINUX + if (!NILP (preserve_selinux_context) && is_selinux_enabled ()) + { + conlength = fgetfilecon (ifd, &con); + if (conlength == -1) + report_file_error ("Doing fgetfilecon", Fcons (file, Qnil)); + } +#endif + if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) { @@ -2061,6 +2085,18 @@ } #endif /* not MSDOS */ +#if HAVE_LIBSELINUX + if (conlength > 0) + { + /* Set the modified context back to the file. */ + fail = fsetfilecon (ofd, con); + if (fail) + report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil)); + + freecon (con); + } +#endif + /* Closing the output clobbers the file times on some systems. */ if (emacs_close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); @@ -2287,7 +2323,7 @@ have copy-file prompt again. */ Fcopy_file (file, newname, NILP (ok_if_already_exists) ? Qnil : Qt, - Qt, Qt); + Qt, Qt, Qt); count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); @@ -2844,6 +2880,136 @@ #endif } +DEFUN ("file-selinux-context", Ffile_selinux_context, + Sfile_selinux_context, 1, 1, 0, + doc: /* Return SELinux context of file named FILENAME, +as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil) +if file does not exist, is not accessible, or SELinux is disabled */) + (filename) + Lisp_Object filename; +{ + Lisp_Object absname; + Lisp_Object values[4]; + Lisp_Object handler; +#if HAVE_LIBSELINUX + security_context_t con; + int conlength; + context_t context; +#endif + + absname = expand_and_dir_to_file (filename, current_buffer->directory); + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (absname, Qfile_selinux_context); + if (!NILP (handler)) + return call2 (handler, Qfile_selinux_context, absname); + + absname = ENCODE_FILE (absname); + + values[0] = Qnil; + values[1] = Qnil; + values[2] = Qnil; + values[3] = Qnil; +#if HAVE_LIBSELINUX + if (is_selinux_enabled ()) + { + conlength = lgetfilecon (SDATA (absname), &con); + if (conlength > 0) + { + context = context_new (con); + values[0] = build_string (context_user_get (context)); + values[1] = build_string (context_role_get (context)); + values[2] = build_string (context_type_get (context)); + values[3] = build_string (context_range_get (context)); + context_free (context); + } + if (con) + freecon (con); + } +#endif + + return Flist (sizeof(values) / sizeof(values[0]), values); +} + +DEFUN ("set-file-selinux-context", Fset_file_selinux_context, + Sset_file_selinux_context, 2, 2, 0, + doc: /* Set SELinux context of file named FILENAME to CONTEXT +as a list ("user", "role", "type", "range"). Has no effect if SELinux +is disabled. */) + (filename, context) + Lisp_Object filename, context; +{ + Lisp_Object absname, encoded_absname; + Lisp_Object handler; + Lisp_Object user = CAR_SAFE (context); + Lisp_Object role = CAR_SAFE (CDR_SAFE (context)); + Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context))); + Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context)))); +#if HAVE_LIBSELINUX + security_context_t con; + int fail, conlength; + context_t parsed_con; +#endif + + absname = Fexpand_file_name (filename, current_buffer->directory); + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (absname, Qset_file_selinux_context); + if (!NILP (handler)) + return call3 (handler, Qset_file_selinux_context, absname, context); + + encoded_absname = ENCODE_FILE (absname); + +#if HAVE_LIBSELINUX + if (is_selinux_enabled ()) + { + /* Get current file context. */ + conlength = lgetfilecon (SDATA (encoded_absname), &con); + if (conlength > 0) + { + parsed_con = context_new (con); + /* Change the parts defined in the parameter.*/ + if (STRINGP (user)) + { + if (context_user_set (parsed_con, SDATA (user))) + error ("Doing context_user_set"); + } + if (STRINGP (role)) + { + if (context_role_set (parsed_con, SDATA (role))) + error ("Doing context_role_set"); + } + if (STRINGP (type)) + { + if (context_type_set (parsed_con, SDATA (type))) + error ("Doing context_type_set"); + } + if (STRINGP (range)) + { + if (context_range_set (parsed_con, SDATA (range))) + error ("Doing context_range_set"); + } + + /* Set the modified context back to the file. */ + fail = lsetfilecon (SDATA (encoded_absname), context_str (parsed_con)); + if (fail) + report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil)); + + context_free (parsed_con); + } + else + report_file_error("Doing lgetfilecon", Fcons (absname, Qnil)); + + if (con) + freecon (con); + } +#endif + + return Qnil; +} + DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, doc: /* Return mode bits of file named FILENAME, as an integer. Return nil, if file does not exist or is not accessible. */) @@ -5505,6 +5671,8 @@ Qfile_modes = intern_c_string ("file-modes"); Qset_file_modes = intern_c_string ("set-file-modes"); Qset_file_times = intern_c_string ("set-file-times"); + Qfile_selinux_context = intern_c_string("file-selinux-context"); + Qset_file_selinux_context = intern_c_string("set-file-selinux-context"); Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p"); Qinsert_file_contents = intern_c_string ("insert-file-contents"); Qwrite_region = intern_c_string ("write-region"); @@ -5540,6 +5708,8 @@ staticpro (&Qfile_modes); staticpro (&Qset_file_modes); staticpro (&Qset_file_times); + staticpro (&Qfile_selinux_context); + staticpro (&Qset_file_selinux_context); staticpro (&Qfile_newer_than_file_p); staticpro (&Qinsert_file_contents); staticpro (&Qwrite_region); @@ -5773,6 +5943,8 @@ defsubr (&Sfile_modes); defsubr (&Sset_file_modes); defsubr (&Sset_file_times); + defsubr (&Sfile_selinux_context); + defsubr (&Sset_file_selinux_context); defsubr (&Sset_default_file_modes); defsubr (&Sdefault_file_modes); defsubr (&Sfile_newer_than_file_p); === modified file 'src/lisp.h' --- src/lisp.h 2010-04-20 01:50:52 +0000 +++ src/lisp.h 2010-04-21 03:02:58 +0000 @@ -2897,6 +2897,7 @@ extern Lisp_Object call4 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); extern Lisp_Object call5 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); extern Lisp_Object call6 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); +extern Lisp_Object call7 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); EXFUN (Fdo_auto_save, 2); extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int)); extern Lisp_Object internal_catch P_ ((Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object)); ------------------------------------------------------------ revno: 99962 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 22:10:50 -0400 message: vc-bzr.el (vc-bzr-checkin): Undo spurious `async' arg change. diff: === modified file 'lisp/vc-bzr.el' --- lisp/vc-bzr.el 2010-04-21 02:05:24 +0000 +++ lisp/vc-bzr.el 2010-04-21 02:10:50 +0000 @@ -457,7 +457,7 @@ "Check FILE in to bzr with log message COMMENT. REV non-nil gets an error." (if rev (error "Can't check in a specific revision with bzr")) - (apply 'vc-bzr-command "commit" nil 'async + (apply 'vc-bzr-command "commit" nil 0 files (cons "-m" (log-edit-extract-headers '(("Author" . "--author") ("Fixes" . "--fixes")) comment)))) ------------------------------------------------------------ revno: 99961 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 22:05:24 -0400 message: Make the log-edit comments use RFC822 format throughout. * vc.el (vc-checkin, vc-modify-change-comment): Adjust to new vc-start/finish-logentry. (vc-find-conflicted-file): New command. (vc-transfer-file): Adjust to new vc-checkin. (vc-next-action): Improve scoping. * vc-hg.el (vc-hg-log-edit-mode): Remove. (vc-hg-checkin): Remove extra arg. Use log-edit-extract-headers. * vc-git.el (vc-git-log-edit-mode): Remove. (vc-git-checkin): Remove extra arg. Use log-edit-extract-headers. (vc-git-commits-coding-system): Rename from git-commits-coding-system. * vc-dispatcher.el (vc-log-edit): Shorten names for log-edit-show-files. (vc-start-logentry): Remove argument `extra'. (vc-finish-logentry): Remove extra args. * vc-bzr.el (vc-bzr-log-edit-mode): Remove. (vc-bzr-checkin): Remove extra arg. Use log-edit-extract-headers. (vc-bzr-conflicted-files): New function. * log-edit.el (log-edit-extra-flags) (log-edit-before-checkin-process): Remove. (log-edit-summary, log-edit-header, log-edit-unknown-header): New faces. (log-edit-headers-alist): New var. (log-edit-header-contents-regexp): New const. (log-edit-match-to-eoh): New function. (log-edit-font-lock-keywords): Use them. (log-edit): Insert a "Summary:" header as default. (log-edit-mode): Mark font-lock rules as case-insensitive. (log-edit-done): Cleanup headers. (log-view-process-buffer): Remove. (log-edit-extract-headers): New function to replace it. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-04-18 23:49:58 +0000 +++ etc/NEWS 2010-04-21 02:05:24 +0000 @@ -88,6 +88,8 @@ ** Archive Mode has basic support to browse 7z archives. ** partial-completion-mode is now obsolete. +You can get the same behavior with +(setq completion-styles '(partial-completion initials)). ** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags. ** Customize @@ -106,23 +108,18 @@ ** VC and related modes -*** New VC commands: vc-log-incoming and vc-log-outgoing. +*** New VC commands: vc-log-incoming, vc-log-outgoing, vc-find-conflicted-file. *** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. *** Special markup can be added to log-edit buffers. - -**** For Bzr, adding an -Author: NAME -line will add "--author NAME" to the "bzr commit" command. - -**** For Git, adding an -Author: NAME -line will add "--author NAME" to the "git commit" command. - -**** For Hg, adding an -Author: NAME -line will add "--user NAME" to the "hg commit" command. +The log-edit buffers are expected to have a format similar to email messages +with headers of the form: + Author: + Summary: + Fixes: +Some backends handle some of those headers specially, but any unknown header +is just left as is in the message, so it is not lost. ** Directory local variables can apply to file-less buffers. For example, adding "(diff-mode . ((mode . whitespace)))" to your === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-20 23:05:30 +0000 +++ lisp/ChangeLog 2010-04-21 02:05:24 +0000 @@ -1,3 +1,39 @@ +2010-04-21 Stefan Monnier + + * vc.el (vc-checkin, vc-modify-change-comment): + Adjust to new vc-start/finish-logentry. + (vc-find-conflicted-file): New command. + (vc-transfer-file): Adjust to new vc-checkin. + (vc-next-action): Improve scoping. + + * vc-hg.el (vc-hg-log-edit-mode): Remove. + (vc-hg-checkin): Remove extra arg. Use log-edit-extract-headers. + + * vc-git.el (vc-git-log-edit-mode): Remove. + (vc-git-checkin): Remove extra arg. Use log-edit-extract-headers. + (vc-git-commits-coding-system): Rename from git-commits-coding-system. + + * vc-dispatcher.el (vc-log-edit): Shorten names for log-edit-show-files. + (vc-start-logentry): Remove argument `extra'. + (vc-finish-logentry): Remove extra args. + + * vc-bzr.el (vc-bzr-log-edit-mode): Remove. + (vc-bzr-checkin): Remove extra arg. Use log-edit-extract-headers. + (vc-bzr-conflicted-files): New function. + + * log-edit.el (log-edit-extra-flags) + (log-edit-before-checkin-process): Remove. + (log-edit-summary, log-edit-header, log-edit-unknown-header): New faces. + (log-edit-headers-alist): New var. + (log-edit-header-contents-regexp): New const. + (log-edit-match-to-eoh): New function. + (log-edit-font-lock-keywords): Use them. + (log-edit): Insert a "Summary:" header as default. + (log-edit-mode): Mark font-lock rules as case-insensitive. + (log-edit-done): Cleanup headers. + (log-view-process-buffer): Remove. + (log-edit-extract-headers): New function to replace it. + 2010-04-20 Juanma Barranquero * subr.el (default-direction-reversed): Remove obsolescence info. === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2010-04-20 13:31:28 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2010-04-21 02:05:24 +0000 @@ -1242,7 +1242,6 @@ ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t +;; coding: utf-8 ;; End: - -;; arch-tag: 08cc5aab-e992-47f6-992e-12a7428c1a0e ;;; cl-loaddefs.el ends here === modified file 'lisp/log-edit.el' --- lisp/log-edit.el 2010-03-24 03:27:24 +0000 +++ lisp/log-edit.el 2010-04-21 02:05:24 +0000 @@ -125,6 +125,7 @@ :type 'boolean) (defcustom log-edit-hook '(log-edit-insert-cvs-template + log-edit-show-files log-edit-insert-changelog) "Hook run at the end of `log-edit'." :group 'log-edit @@ -188,22 +189,6 @@ (defvar log-edit-callback nil) (defvar log-edit-diff-function nil) (defvar log-edit-listfun nil) -(defvar log-edit-extra-flags nil - "List of extra flags to pass to the check in command.") -(defvar log-edit-before-checkin-process nil - "Alist with instructions for processing the commit message before check in. -The format is: (REGEXP . INSTRUCTIONS). -All lines matching REGEXP are removed. For example: - -\(\"^#.*\" . nil) - -means: just remove all lines starting with #. This can be used -to insert lines in the commit buffer that contain, for example, the -list of files to be committed. - -\(\"Author: \\\\(.*\\\\)\" . (list \"--author\" (match-string 1))) - -means: append (list \"--author\" (match-string 1)) to `log-edit-extra-flags'.") (defvar log-edit-parent-buffer nil) @@ -329,10 +314,53 @@ ;;; Actual code ;;; +(defface log-edit-summary '((t :inherit font-lock-function-name-face)) + "Face for the summary in `log-edit-mode' buffers.") + +(defface log-edit-header '((t :inherit font-lock-keyword-face)) + "Face for the headers in `log-edit-mode' buffers.") + +(defface log-edit-unknown-header '((t :inherit font-lock-comment-face)) + "Face for unknown headers in `log-edit-mode' buffers.") + +(defvar log-edit-headers-alist '(("Summary" . log-edit-summary) + ("Fixes") ("Author")) + "AList of known headers and the face to use to highlight them.") + +(defconst log-edit-header-contents-regexp + "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") + +(defun log-edit-match-to-eoh (limit) + ;; FIXME: copied from message-match-to-eoh. + (let ((start (point))) + (rfc822-goto-eoh) + ;; Typical situation: some temporary change causes the header to be + ;; incorrect, so EOH comes earlier than intended: the last lines of the + ;; intended headers are now not considered part of the header any more, + ;; so they don't have the multiline property set. When the change is + ;; completed and the header has its correct shape again, the lack of the + ;; multiline property means we won't rehighlight the last lines of + ;; the header. + (if (< (point) start) + nil ;No header within start..limit. + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) + (defvar log-edit-font-lock-keywords - '(("\\`\\(Summary:\\)\\(.*\\)" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)))) + ;; Copied/inspired by message-font-lock-keywords. + `((log-edit-match-to-eoh + (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp + "\\|\\(.*\\)") + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 (if (assoc (match-string 2) log-edit-headers-alist) + 'log-edit-header + 'log-edit-unknown-header) + nil lax) + (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) + 'log-edit-header) + nil lax) + (4 font-lock-warning-face))))) ;;;###autoload (defun log-edit (callback &optional setup params buffer mode &rest ignore) @@ -358,7 +386,10 @@ (if buffer (pop-to-buffer buffer)) (when (and log-edit-setup-invert (not (eq setup 'force))) (setq setup (not setup))) - (when setup (erase-buffer)) + (when setup + (erase-buffer) + (insert "Summary: ") + (save-excursion (insert "\n\n"))) (if mode (funcall mode) (log-edit-mode)) @@ -387,7 +418,7 @@ \\{log-edit-mode-map}" (set (make-local-variable 'font-lock-defaults) - '(log-edit-font-lock-keywords t)) + '(log-edit-font-lock-keywords t t)) (make-local-variable 'log-edit-comment-ring-index) (hack-dir-local-variables-non-file-buffer)) @@ -401,6 +432,17 @@ "Finish editing the log message and commit the files. If you want to abort the commit, simply delete the buffer." (interactive) + ;; Clean up empty headers. + (goto-char (point-min)) + (while (looking-at (concat "^[a-z]*:" log-edit-header-contents-regexp)) + (let ((beg (match-beginning 0))) + (goto-char (match-end 0)) + (if (string-match "\\`[ \n\t]*\\'" (match-string 1)) + (delete-region beg (point))))) + ;; Get rid of leading empty lines. + (goto-char (point-min)) + (when (looking-at "\\([ \t]*\n\\)+") + (delete-region (match-beginning 0) (match-end 0))) ;; Get rid of trailing empty lines (goto-char (point-max)) (skip-syntax-backward " ") @@ -458,12 +500,13 @@ "(Un)Indent the current buffer rigidly to `log-edit-common-indent'." (save-excursion (let ((common (point-max))) - (goto-char (point-min)) + (rfc822-goto-eoh) (while (< (point) (point-max)) (if (not (looking-at "^[ \t]*$")) (setq common (min common (current-indentation)))) (forward-line 1)) - (indent-rigidly (point-min) (point-max) + (rfc822-goto-eoh) + (indent-rigidly (point) (point-max) (- log-edit-common-indent common))))) (defun log-edit-show-diff () @@ -546,6 +589,10 @@ or if the command is repeated a second time in a row, use the first log entry regardless of user name or time." (interactive "P") + (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) + (when (<= (point) eoh) + (goto-char eoh) + (if (looking-at "\n") (forward-char 1)))) (let ((log-edit-changelog-use-first (or use-first (eq last-command 'log-edit-insert-changelog)))) (log-edit-insert-changelog-entries (log-edit-files))) @@ -731,16 +778,39 @@ (log-edit-changelog-insert-entries (car buffer-entry) (cdr buffer-entry)) (when (cdr buffer-entry) (newline))))) -(defun log-view-process-buffer () - (when log-edit-before-checkin-process - (dolist (crt log-edit-before-checkin-process) - ;; Remove all lines matching (car crt) - ;; Append to `log-edit-extra-flags' the results of (cdr crt). +(defun log-edit-extract-headers (headers comment) + "Extract headers from COMMENT to form command line arguments. +HEADERS should be an alist with elements of the form (HEADER . CMDARG) +associating header names to the corresponding cmdline option name and the +result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...). +where MSG is the remaining text from STRING. +If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted +anyway and put back as the first line of MSG." + (with-temp-buffer + (insert comment) + (rfc822-goto-eoh) + (narrow-to-region (point-min) (point)) + (let ((case-fold-search t) + (summary ()) + (res ())) + (dolist (header (if (assoc "Summary" headers) headers + (cons '("Summary" . t) headers))) + (goto-char (point-min)) + (while (re-search-forward (concat "^" (car header) + ":" log-edit-header-contents-regexp) + nil t) + (if (eq t (cdr header)) + (setq summary (match-string 1)) + (push (match-string 1) res) + (push (or (cdr header) (car header)) res)) + (replace-match "" t t))) + ;; Remove header separator if the header is empty. + (widen) (goto-char (point-min)) - (while (re-search-forward (car crt) nil t) - (when (cdr crt) - (setq log-edit-extra-flags (append log-edit-extra-flags (eval (cdr crt))))) - (replace-match "" nil t))))) + (when (looking-at "\\([ \t]*\n\\)+") + (delete-region (match-beginning 0) (match-end 0))) + (if summary (insert summary "\n")) + (cons (buffer-string) res)))) (provide 'log-edit) === modified file 'lisp/vc-bzr.el' --- lisp/vc-bzr.el 2010-04-19 15:26:06 +0000 +++ lisp/vc-bzr.el 2010-04-21 02:05:24 +0000 @@ -451,11 +451,16 @@ "Unregister FILE from bzr." (vc-bzr-command "remove" nil 0 file "--keep")) -(defun vc-bzr-checkin (files rev comment &optional extra-args) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + +(defun vc-bzr-checkin (files rev comment) "Check FILE in to bzr with log message COMMENT. REV non-nil gets an error." (if rev (error "Can't check in a specific revision with bzr")) - (apply 'vc-bzr-command "commit" nil 0 files (append (list "-m" comment) extra-args))) + (apply 'vc-bzr-command "commit" nil 'async + files (cons "-m" (log-edit-extract-headers '(("Author" . "--author") + ("Fixes" . "--fixes")) + comment)))) (defun vc-bzr-find-revision (file rev buffer) "Fetch revision REV of file FILE and put it into BUFFER." @@ -552,23 +557,6 @@ (goto-char (point-min))) found))) -(declare-function log-edit-mode "log-edit" ()) -(defvar log-edit-extra-flags) -(defvar log-edit-before-checkin-process) - -(define-derived-mode vc-bzr-log-edit-mode log-edit-mode "Bzr-Log-Edit" - "Mode for editing Bzr commit logs. -If a line like: -Author: NAME -is present in the log, it is removed, and ---author NAME -is passed to the bzr commit command. Similarly with Fixes: and --fixes." - (set (make-local-variable 'log-edit-extra-flags) nil) - (set (make-local-variable 'log-edit-before-checkin-process) - '(("^\\(Author\\|Fixes\\):[ \t]+\\(.*\\)[ \t]*$" . - (list (format "--%s" (downcase (match-string 1))) - (match-string 2)))))) - (defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." ;; `bzr diff' exits with code 1 if diff is non-empty. @@ -983,6 +971,19 @@ (setq loglines (buffer-substring-no-properties start (point-max)))))) vc-bzr-revisions)) +(defun vc-bzr-conflicted-files (dir) + (let ((default-directory (vc-bzr-root dir)) + (files ())) + (with-temp-buffer + (vc-bzr-command "status" t 0 default-directory) + (goto-char (point-min)) + (when (re-search-forward "^conflicts:\n" nil t) + (while (looking-at " \\(?:Text conflict in \\(.*\\)\\|.*\\)\n") + (if (match-end 1) + (push (expand-file-name (match-string 1)) files)) + (goto-char (match-end 0))))) + files)) + ;;; Revision completion (eval-and-compile === modified file 'lisp/vc-dispatcher.el' --- lisp/vc-dispatcher.el 2010-04-20 16:52:43 +0000 +++ lisp/vc-dispatcher.el 2010-04-21 02:05:24 +0000 @@ -141,7 +141,6 @@ (defvar vc-log-operation nil) (defvar vc-log-after-operation-hook nil) (defvar vc-log-fileset) -(defvar vc-log-extra) ;; In a log entry buffer, this is a local variable ;; that points to the buffer for which it was made @@ -521,17 +520,20 @@ (with-current-buffer vc-parent-buffer default-directory)) (log-edit 'vc-finish-logentry nil - `((log-edit-listfun . (lambda () ',fileset)) + `((log-edit-listfun . (lambda () + ;; FIXME: Should expand the list + ;; for directories. + (mapcar 'file-relative-name + ',fileset))) (log-edit-diff-function . (lambda () (vc-diff nil)))) nil mode) (set (make-local-variable 'vc-log-fileset) fileset) - (make-local-variable 'vc-log-extra) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files extra comment initial-contents msg logbuf mode action &optional after-hook) - "Accept a comment for an operation on FILES with extra data EXTRA. +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook) + "Accept a comment for an operation on FILES. If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the action on close to ACTION. If COMMENT is a string and INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial @@ -561,7 +563,6 @@ (when after-hook (setq vc-log-after-operation-hook after-hook)) (setq vc-log-operation action) - (setq vc-log-extra extra) (when comment (erase-buffer) (when (stringp comment) (insert comment))) @@ -570,10 +571,8 @@ (vc-finish-logentry (eq comment t))))) (declare-function vc-dir-move-to-goal-column "vc-dir" ()) -;; vc-finish-logentry is called from a log-edit buffer (see above). -(declare-function log-view-process-buffer "log-edit" ()) -(defvar log-edit-extra-flags) - +;; vc-finish-logentry is typically called from a log-edit buffer (see +;; vc-start-logentry). (defun vc-finish-logentry (&optional nocomment) "Complete the operation implied by the current log entry. Use the contents of the current buffer as a check-in or registration @@ -590,25 +589,21 @@ (unless vc-log-operation (error "No log operation is pending")) - (log-view-process-buffer) - ;; save the parameters held in buffer-local variables (let ((logbuf (current-buffer)) (log-operation vc-log-operation) + ;; FIXME: When coming from VC-Dir, we should check that the + ;; set of selected files is still equal to vc-log-fileset, + ;; to avoid surprises. (log-fileset vc-log-fileset) - (log-extra vc-log-extra) (log-entry (buffer-string)) - (extra-flags log-edit-extra-flags) (after-hook vc-log-after-operation-hook)) (pop-to-buffer vc-parent-buffer) ;; OK, do it to it (save-excursion (funcall log-operation log-fileset - log-extra - log-entry - extra-flags - )) + log-entry)) ;; Remove checkin window (after the checkin so that if that fails ;; we don't zap the log buffer and the typing therein). ;; -- IMO this should be replaced with quit-window === modified file 'lisp/vc-git.el' --- lisp/vc-git.el 2010-04-19 15:07:52 +0000 +++ lisp/vc-git.el 2010-04-21 02:05:24 +0000 @@ -118,7 +118,7 @@ :version "23.1" :group 'vc) -(defvar git-commits-coding-system 'utf-8 +(defvar vc-git-commits-coding-system 'utf-8 "Default coding system for git commits.") ;;; BACKEND PROPERTIES @@ -548,11 +548,15 @@ (defun vc-git-unregister (file) (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) +(declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-git-checkin (files rev comment &optional extra-args) - (let ((coding-system-for-write git-commits-coding-system)) +(defun vc-git-checkin (files rev comment) + (let ((coding-system-for-write vc-git-commits-coding-system)) (apply 'vc-git-command nil 0 files - (nconc (list "commit" "-m" comment) extra-args (list "--only" "--"))))) + (nconc (list "commit" "-m") + (log-edit-extract-headers '(("Author" . "--author")) + comment) + (list "--only" "--"))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -582,7 +586,7 @@ "Get change log associated with FILES. Note that using SHORTLOG requires at least Git version 1.5.6, for the --graph option." - (let ((coding-system-for-read git-commits-coding-system)) + (let ((coding-system-for-read vc-git-commits-coding-system)) ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -793,21 +797,6 @@ (progn (forward-line 1) (1- (point))))))))) (or (vc-git-symbolic-commit next-rev) next-rev))) -(declare-function log-edit-mode "log-edit" ()) -(defvar log-edit-extra-flags) -(defvar log-edit-before-checkin-process) - -(define-derived-mode vc-git-log-edit-mode log-edit-mode "Git-log-edit" - "Mode for editing Git commit logs. -If a line like: -Author: NAME -is present in the log, it is removed, and ---author=NAME -is passed to the git commit command." - (set (make-local-variable 'log-edit-extra-flags) nil) - (set (make-local-variable 'log-edit-before-checkin-process) - '(("^Author:[ \t]+\\(.*\\)[ \t]*$" . (list "--author" (match-string 1)))))) - (defun vc-git-delete-file (file) (vc-git-command nil 0 file "rm" "-f" "--")) === modified file 'lisp/vc-hg.el' --- lisp/vc-hg.el 2010-04-19 15:07:52 +0000 +++ lisp/vc-hg.el 2010-04-21 02:05:24 +0000 @@ -296,20 +296,7 @@ ("^tag: +\\([^ ]+\\)$" (1 'highlight)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) -(declare-function log-edit-mode "log-edit" ()) -(defvar log-edit-extra-flags) -(defvar log-edit-before-checkin-process) - -(define-derived-mode vc-hg-log-edit-mode log-edit-mode "Hg-log-edit" - "Mode for editing Hg commit logs. -If a line like: -Author: NAME -is present in the log, it is removed, and ---author NAME -is passed to the hg commit command." - (set (make-local-variable 'log-edit-extra-flags) nil) - (set (make-local-variable 'log-edit-before-checkin-process) - '(("^Author:[ \t]+\\(.*\\)[ \t]*$" . (list "--user" (match-string 1)))))) +(declare-function log-edit-extract-headers "log-edit" (headers string)) (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." @@ -434,11 +421,15 @@ ;; "Unregister FILE from hg." ;; (vc-hg-command nil nil file "remove")) -(defun vc-hg-checkin (files rev comment &optional extra-args) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + +(defun vc-hg-checkin (files rev comment) "Hg-specific version of `vc-backend-checkin'. REV is ignored." (apply 'vc-hg-command nil 0 files - (nconc (list "commit" "-m" comment) extra-args))) + (nconc (list "commit" "-m") + (log-edit-extract-headers '(("Author" . "--user")) + comment)))) (defun vc-hg-find-revision (file rev buffer) (let ((coding-system-for-read 'binary) === modified file 'lisp/vc.el' --- lisp/vc.el 2010-04-09 17:19:53 +0000 +++ lisp/vc.el 2010-04-21 02:05:24 +0000 @@ -268,15 +268,12 @@ ;; Unregister FILE from this backend. This is only needed if this ;; backend may be used as a "more local" backend for temporary editing. ;; -;; * checkin (files rev comment &optional extra-args) +;; * checkin (files rev comment) ;; -;; Commit changes in FILES to this backend. If REV is non-nil, that -;; should become the new revision number (not all backends do -;; anything with it). COMMENT is used as a check-in comment. The -;; implementation should pass the value of vc-checkin-switches to -;; the backend command. (Note: in older versions of VC, this -;; command took a single file argument and not a list.) -;; EXTRA-ARGS should be passed to the backend command. +;; Commit changes in FILES to this backend. REV is a historical artifact +;; and should be ignored. COMMENT is used as a check-in comment. +;; The implementation should pass the value of vc-checkin-switches to +;; the backend command. ;; ;; * find-revision (file rev buffer) ;; @@ -548,6 +545,12 @@ ;; makes it possible to provide menu entries for functionality that ;; is specific to a backend and which does not map to any of the VC ;; generic concepts. +;; +;; - conflicted-files (dir) +;; +;; Return the list of files where conflict resolution is needed in +;; the project that contains DIR. +;; FIXME: what should it do with non-text conflicts? ;;; Todo: @@ -1054,8 +1057,7 @@ (state (nth 3 vc-fileset)) ;; The backend should check that the checkout-model is consistent ;; among all the `files'. - (model (nth 4 vc-fileset)) - revision) + (model (nth 4 vc-fileset))) ;; Do the right thing (cond @@ -1070,11 +1072,13 @@ (cond (verbose ;; go to a different revision - (setq revision (read-string "Branch, revision, or backend to move to: ")) - (let ((revision-downcase (downcase revision))) + (let* ((revision + (read-string "Branch, revision, or backend to move to: ")) + (revision-downcase (downcase revision))) (if (member revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends)) + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) (let ((vsym (intern-soft revision-downcase))) (dolist (file files) (vc-transfer-file file vsym))) (dolist (file files) @@ -1119,8 +1123,8 @@ (message "No files remain to be committed") (if (not verbose) (vc-checkin ready-for-commit backend) - (setq revision (read-string "New revision or backend: ")) - (let ((revision-downcase (downcase revision))) + (let* ((revision (read-string "New revision or backend: ")) + (revision-downcase (downcase revision))) (if (member revision-downcase (mapcar (lambda (arg) (downcase (symbol-name arg))) @@ -1365,7 +1369,7 @@ (defun vc-checkin (files backend &optional rev comment initial-contents) "Check in FILES. The optional argument REV may be a string specifying the new revision -level (if nil increment the current level). COMMENT is a comment +level (strongly deprecated). COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment. If INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents of the log entry buffer. @@ -1379,28 +1383,30 @@ (lexical-let ((backend backend)) (vc-start-logentry - files rev comment initial-contents + files comment initial-contents "Enter a change comment." "*VC-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) - (lambda (files rev comment extra-flags) - (message "Checking in %s..." (vc-delistify files)) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (with-vc-properties - files - ;; We used to change buffers to get local value of vc-checkin-switches, - ;; but 'the' local buffer is not a well-defined concept for filesets. - (progn - (vc-call-backend backend 'checkin files rev comment extra-flags) - (mapc 'vc-delete-automatic-version-backups files)) - `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))) + (lexical-let ((rev rev)) + (lambda (files comment) + (message "Checking in %s..." (vc-delistify files)) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about white-space-only comments too. + (or (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (with-vc-properties + files + ;; We used to change buffers to get local value of + ;; vc-checkin-switches, but 'the' local buffer is + ;; not a well-defined concept for filesets. + (progn + (vc-call-backend backend 'checkin files rev comment) + (mapc 'vc-delete-automatic-version-backups files)) + `((vc-state . up-to-date) + (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files)))) 'vc-checkin-hook))) ;;; Additional entry points for examining version histories @@ -1772,13 +1778,14 @@ ;; case the more general operation ever becomes meaningful. (let ((backend (vc-responsible-backend (car files)))) (vc-start-logentry - files rev oldcomment t + files oldcomment t "Enter a replacement change comment." "*VC-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) - (lambda (files rev comment ignored) - (vc-call-backend backend - 'modify-change-comment files rev comment))))) + (lexical-let ((rev rev)) + (lambda (files comment) + (vc-call-backend backend + 'modify-change-comment files rev comment)))))) ;;;###autoload (defun vc-merge () @@ -1839,6 +1846,31 @@ ;;;###autoload (defalias 'vc-resolve-conflicts 'smerge-ediff) +;; TODO: This is OK but maybe we could integrate it better. +;; E.g. it could be run semi-automatically (via a prompt?) when saving a file +;; that was conflicted (i.e. upon mark-resolved). +;; FIXME: should we add an "other-window" version? Or maybe we should +;; hook it inside find-file so it automatically works for +;; find-file-other-window as well. E.g. find-file could use a new +;; `default-next-file' variable for its default file (M-n), and +;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would +;; automatically offer the next conflicted file. +(defun vc-find-conflicted-file () + "Visit the next conflicted file in the current project." + (interactive) + (let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name)) + (vc-responsible-backend default-directory) + (error "No VC backend"))) + (files (vc-call-backend backend + 'conflicted-files default-directory))) + ;; Don't try and visit the current file. + (if (equal (car files) buffer-file-name) (pop files)) + (if (null files) + (message "No more conflicted files") + (find-file (pop files)) + (message "%s more conflicted files after this one" + (if files (length files) "No"))))) + ;; Named-configuration entry points (defun vc-tag-precondition (dir) ------------------------------------------------------------ revno: 99960 committer: Juanma Barranquero branch nick: trunk timestamp: Wed 2010-04-21 02:49:40 +0200 message: Fix typos and spacing. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-21 00:17:02 +0000 +++ src/ChangeLog 2010-04-21 00:49:40 +0000 @@ -1,14 +1,14 @@ 2010-04-21 Juanma Barranquero Eli Zaretskii - Don't depend on cm.c or termcap.c on Windows, use stubs. - * makefile.w32-in (OBJ1): Remove cm.$(O) and termcap.$(O). - ($(BLD)/cm.$(O), $(BLD)/termcap.$(O)): Remove. - * w32console.c (current_tty, cost): New vars; lifted from cm.c. - (evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear) - (sys_tputs, sys_tgetstr): New stubs. - * s/ms-w32.h (chcheckmagic, cmcostinit, cmgoto, cmputc, Wcm_clear) - (tputs, tgetstr): New; define to sys_*. + Don't depend on cm.c or termcap.c on Windows, use stubs. + * makefile.w32-in (OBJ1): Remove cm.$(O) and termcap.$(O). + ($(BLD)/cm.$(O), $(BLD)/termcap.$(O)): Remove. + * w32console.c (current_tty, cost): New vars; lifted from cm.c. + (evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear) + (sys_tputs, sys_tgetstr): New stubs. + * s/ms-w32.h (chcheckmagic, cmcostinit, cmgoto, cmputc, Wcm_clear) + (tputs, tgetstr): New; define to sys_*. 2010-04-20 Juanma Barranquero @@ -341,7 +341,8 @@ 2010-04-12 Dan Nicolaescu - * Makefile.in (C_SWITCH_SYSTEM,C_SWITCH_MACHINE,C_SWITCH_X_SITE): Undefine. + * Makefile.in (C_SWITCH_SYSTEM,C_SWITCH_MACHINE,C_SWITCH_X_SITE): + Undefine. 2010-04-11 Dan Nicolaescu @@ -415,10 +416,10 @@ (parse_xft_settings): Also check for XSETTINGS_FONT_NAME and save that in current_font. (init_gconf): Read value of SYSTEM_FONT and save it in current_font. - (Ffont_get_system_normal_font, xsettings_get_system_normal_font): New - functions. - (syms_of_xsettings): Initialize current_font. defsubr - Sfont_get_system_normal_font. + (Ffont_get_system_normal_font, xsettings_get_system_normal_font): + New functions. + (syms_of_xsettings): Initialize current_font. + defsubr Sfont_get_system_normal_font. * xsettings.h (Ffont_get_system_normal_font, xsettings_get_system_normal_font): Declare. @@ -3045,7 +3046,7 @@ * xterm.h: Rename x_non_menubar_window_to_frame to x_menubar_window_to_frame. - * xterm.c: Remove declarations also in xterm.h + * xterm.c: Remove declarations also in xterm.h. (XTmouse_position): Do not return valid positions for clicks in the menubar and the toolbar for Gtk+. @@ -3605,7 +3606,7 @@ 2009-07-04 Eli Zaretskii Emulation of `getloadavg' on MS-Windows. - * w32.c: Include float.h + * w32.c: Include float.h. (g_b_init_get_native_system_info, g_b_init_get_system_times) (GetNativeSystemInfo_Proc, GetSystemTimes_Proc): Declare. (get_native_system_info, get_system_times): New functions. @@ -9551,7 +9552,7 @@ 2008-07-10 Dan Nicolaescu * fileio.c: - * sysdep.c + * sysdep.c: * systty.h: * m/ibmrs6000.h: * m/iris4d.h: ------------------------------------------------------------ revno: 99959 author: Juanma Barranquero , Eli Zaretskii committer: Juanma Barranquero branch nick: trunk timestamp: Wed 2010-04-21 02:17:02 +0200 message: Don't depend on cm.c or termcap.c on Windows, use stubs. * makefile.w32-in (OBJ1): Remove cm.$(O) and termcap.$(O). ($(BLD)/cm.$(O), $(BLD)/termcap.$(O)): Remove. * w32console.c (current_tty, cost): New vars; lifted from cm.c. (evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear) (sys_tputs, sys_tgetstr): New stubs. * s/ms-w32.h (chcheckmagic, cmcostinit, cmgoto, cmputc, Wcm_clear) (tputs, tgetstr): New; define to sys_*. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 23:05:30 +0000 +++ src/ChangeLog 2010-04-21 00:17:02 +0000 @@ -1,3 +1,15 @@ +2010-04-21 Juanma Barranquero + Eli Zaretskii + + Don't depend on cm.c or termcap.c on Windows, use stubs. + * makefile.w32-in (OBJ1): Remove cm.$(O) and termcap.$(O). + ($(BLD)/cm.$(O), $(BLD)/termcap.$(O)): Remove. + * w32console.c (current_tty, cost): New vars; lifted from cm.c. + (evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear) + (sys_tputs, sys_tgetstr): New stubs. + * s/ms-w32.h (chcheckmagic, cmcostinit, cmgoto, cmputc, Wcm_clear) + (tputs, tgetstr): New; define to sys_*. + 2010-04-20 Juanma Barranquero * buffer.c (syms_of_buffer) : Doc fix. === modified file 'src/makefile.w32-in' --- src/makefile.w32-in 2010-03-30 12:15:45 +0000 +++ src/makefile.w32-in 2010-04-21 00:17:02 +0000 @@ -62,7 +62,6 @@ $(BLD)/callint.$(O) \ $(BLD)/callproc.$(O) \ $(BLD)/casefiddle.$(O) \ - $(BLD)/cm.$(O) \ $(BLD)/cmds.$(O) \ $(BLD)/data.$(O) \ $(BLD)/dired.$(O) \ @@ -98,7 +97,6 @@ $(BLD)/syntax.$(O) \ $(BLD)/sysdep.$(O) \ $(BLD)/term.$(O) \ - $(BLD)/termcap.$(O) \ $(BLD)/tparam.$(O) \ $(BLD)/undo.$(O) \ $(BLD)/unexw32.$(O) \ @@ -494,17 +492,6 @@ $(SRC)/character.h \ $(SRC)/charset.h -$(BLD)/cm.$(O) : \ - $(SRC)/cm.c \ - $(CONFIG_H) \ - $(SRC)/lisp.h \ - $(SRC)/cm.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h - $(BLD)/cmds.$(O) : \ $(SRC)/cmds.c \ $(CONFIG_H) \ @@ -1407,13 +1394,6 @@ $(SRC)/w32gui.h \ $(SRC)/window.h -$(BLD)/termcap.$(O) : \ - $(SRC)/termcap.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(SRC)/lisp.h - $(BLD)/terminal.$(O) : \ $(SRC)/terminal.c \ $(CONFIG_H) \ === modified file 'src/s/ms-w32.h' --- src/s/ms-w32.h 2010-01-13 08:35:10 +0000 +++ src/s/ms-w32.h 2010-04-21 00:17:02 +0000 @@ -260,6 +260,17 @@ #define kill sys_kill #define signal sys_signal +/* termcap.c calls that are emulated */ +#define tputs sys_tputs +#define tgetstr sys_tgetstr + +/* cm.c calls that are emulated */ +#define chcheckmagic sys_chcheckmagic +#define cmcostinit sys_cmcostinit +#define cmgoto sys_cmgoto +#define cmputc sys_cmputc +#define Wcm_clear sys_Wcm_clear + #endif /* emacs */ /* map to MSVC names */ === modified file 'src/w32console.c' --- src/w32console.c 2010-01-13 08:35:10 +0000 +++ src/w32console.c 2010-04-21 00:17:02 +0000 @@ -488,6 +488,62 @@ } /*********************************************************************** + stubs from termcap.c + ***********************************************************************/ + +void +sys_tputs (char *str, int nlines, int (*outfun)()) +{ +} + +char * +sys_tgetstr (char *cap, char **area) +{ + return NULL; +} + + +/*********************************************************************** + stubs from cm.c + ***********************************************************************/ + +struct tty_display_info *current_tty = NULL; +int cost = 0; + +int +evalcost (char c) +{ + return c; +} + +int +cmputc (char c) +{ + return c; +} + +void +cmcheckmagic (struct tty_display_info *tty) +{ +} + +void +cmcostinit (struct tty_display_info *tty) +{ +} + +void +cmgoto (struct tty_display_info *tty, int row, int col) +{ +} + +void +Wcm_clear (struct tty_display_info *tty) +{ +} + + +/*********************************************************************** Faces ***********************************************************************/ ------------------------------------------------------------ revno: 99958 committer: Juanma Barranquero branch nick: trunk timestamp: Wed 2010-04-21 01:05:30 +0200 message: Remove references to (default-)direction-reversed. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2010-04-19 15:07:52 +0000 +++ doc/lispref/ChangeLog 2010-04-20 23:05:30 +0000 @@ -1,3 +1,8 @@ +2010-04-20 Juanma Barranquero + + * locals.texi (Standard Buffer-Local Variables): + Remove @ignore'd reference to `direction-reversed'. + 2010-04-14 Juri Linkov Fix @deffn without category. === modified file 'doc/lispref/locals.texi' --- doc/lispref/locals.texi 2010-01-13 08:35:10 +0000 +++ doc/lispref/locals.texi 2010-04-20 23:05:30 +0000 @@ -106,11 +106,6 @@ @item desktop-save-buffer @xref{Desktop Save Mode}. -@ignore -@item direction-reversed -Does not work yet. -@end ignore - @item enable-multibyte-characters @ref{Text Representations}. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-20 16:52:43 +0000 +++ lisp/ChangeLog 2010-04-20 23:05:30 +0000 @@ -1,3 +1,7 @@ +2010-04-20 Juanma Barranquero + + * subr.el (default-direction-reversed): Remove obsolescence info. + 2010-04-20 Stefan Monnier * vc-dispatcher.el (vc-finish-logentry): Don't mess so badly with the === modified file 'lisp/subr.el' --- lisp/subr.el 2010-03-31 02:37:57 +0000 +++ lisp/subr.el 2010-04-20 23:05:30 +0000 @@ -1055,7 +1055,6 @@ (make-obsolete-variable 'default-line-spacing 'line-spacing "23.2") (make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2") (make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2") -(make-obsolete-variable 'default-direction-reversed 'direction-reversed "23.2") (make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2") (make-obsolete-variable 'default-left-margin 'left-margin "23.2") (make-obsolete-variable 'default-tab-width 'tab-width "23.2") === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 17:35:16 +0000 +++ src/ChangeLog 2010-04-20 23:05:30 +0000 @@ -1,3 +1,7 @@ +2010-04-20 Juanma Barranquero + + * buffer.c (syms_of_buffer) : Doc fix. + 2010-04-20 Stefan Monnier * data.c (Fmake_variable_buffer_local, Fmake_local_variable): === modified file 'src/buffer.c' --- src/buffer.c 2010-04-20 17:01:39 +0000 +++ src/buffer.c 2010-04-20 23:05:30 +0000 @@ -5784,8 +5784,7 @@ DEFVAR_PER_BUFFER ("bidi-display-reordering", ¤t_buffer->bidi_display_reordering, Qnil, - doc: /* Non-nil means reorder bidirectional text for display in the visual order. -See also the variable `direction-reversed'. */); + doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); DEFVAR_PER_BUFFER ("bidi-paragraph-direction", ¤t_buffer->bidi_paragraph_direction, Qnil, ------------------------------------------------------------ revno: 99957 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 13:35:16 -0400 message: Warn rather than error when making a local var inside a let. * data.c (Fmake_variable_buffer_local, Fmake_local_variable): Just signal a warning rather than an error when inside a let. (Fmake_variable_frame_local): Add the same test. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 17:17:29 +0000 +++ src/ChangeLog 2010-04-20 17:35:16 +0000 @@ -1,5 +1,9 @@ 2010-04-20 Stefan Monnier + * data.c (Fmake_variable_buffer_local, Fmake_local_variable): + Just signal a warning rather than an error when inside a let. + (Fmake_variable_frame_local): Add the same test. + * font.c (syms_of_font): Make the style table vars read-only. * buffer.h (struct buffer): Remove unused var `direction_reversed'. === modified file 'src/data.c' --- src/data.c 2010-04-20 01:50:52 +0000 +++ src/data.c 2010-04-20 17:35:16 +0000 @@ -1639,8 +1639,8 @@ Lisp_Object symbol; XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */ if (let_shadows_global_binding_p (symbol)) - error ("Making %s buffer-local while let-bound!", - SDATA (SYMBOL_NAME (variable))); + message ("Making %s buffer-local while let-bound!", + SDATA (SYMBOL_NAME (variable))); } } @@ -1702,7 +1702,8 @@ } if (sym->constant) - error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); + error ("Symbol %s may not be buffer-local", + SDATA (SYMBOL_NAME (variable))); if (blv ? blv->local_if_set : (forwarded && BUFFER_OBJFWDP (valcontents.fwd))) @@ -1722,8 +1723,9 @@ Lisp_Object symbol; XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */ if (let_shadows_global_binding_p (symbol)) - error ("Making %s local to %s while let-bound!", - SDATA (SYMBOL_NAME (variable)), SDATA (current_buffer->name)); + message ("Making %s local to %s while let-bound!", + SDATA (SYMBOL_NAME (variable)), + SDATA (current_buffer->name)); } } @@ -1899,6 +1901,13 @@ blv->frame_local = 1; sym->redirect = SYMBOL_LOCALIZED; SET_SYMBOL_BLV (sym, blv); + { + Lisp_Object symbol; + XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */ + if (let_shadows_global_binding_p (symbol)) + message ("Making %s frame-local while let-bound!", + SDATA (SYMBOL_NAME (variable))); + } return variable; } ------------------------------------------------------------ revno: 99956 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 13:17:29 -0400 message: * font.c (syms_of_font): Make the style table vars read-only. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 17:01:39 +0000 +++ src/ChangeLog 2010-04-20 17:17:29 +0000 @@ -1,5 +1,7 @@ 2010-04-20 Stefan Monnier + * font.c (syms_of_font): Make the style table vars read-only. + * buffer.h (struct buffer): Remove unused var `direction_reversed'. * buffer.c (init_buffer_once, syms_of_buffer): Remove its initialization. === modified file 'src/font.c' --- src/font.c 2010-02-27 02:09:03 +0000 +++ src/font.c 2010-04-20 17:17:29 +0000 @@ -5376,22 +5376,30 @@ gets the repertory information by an opened font and ENCODING. */); Vfont_encoding_alist = Qnil; + /* FIXME: These 3 vars are not quite what they appear: setq on them + won't have any effect other than disconnect them from the style + table used by the font display code. So we make them read-only, + to avoid this confusing situation. */ + DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table, doc: /* Vector of valid font weight values. Each element has the form: [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); + XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1; DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table, doc: /* Vector of font slant symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); + XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1; DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table, doc: /* Alist of font width symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_width_table = BUILD_STYLE_TABLE (width_table); + XSYMBOL (intern_c_string ("font-width-table"))->constant = 1; staticpro (&font_style_table); font_style_table = Fmake_vector (make_number (3), Qnil); ------------------------------------------------------------ revno: 99955 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 13:01:39 -0400 message: * buffer.h (struct buffer): Remove unused var `direction_reversed'. * buffer.c (init_buffer_once, syms_of_buffer): Remove its initialization. * bidi.c (bidi_initialize): Simplify fallback_paragraph_*_re init. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 13:31:28 +0000 +++ src/ChangeLog 2010-04-20 17:01:39 +0000 @@ -1,3 +1,10 @@ +2010-04-20 Stefan Monnier + + * buffer.h (struct buffer): Remove unused var `direction_reversed'. + * buffer.c (init_buffer_once, syms_of_buffer): Remove its initialization. + + * bidi.c (bidi_initialize): Simplify fallback_paragraph_*_re init. + 2010-04-20 Eli Zaretskii Fix R2L paragraph display on TTY. === modified file 'src/bidi.c' --- src/bidi.c 2010-04-20 01:50:52 +0000 +++ src/bidi.c 2010-04-20 17:01:39 +0000 @@ -399,20 +399,18 @@ bidi_type[i].to ? bidi_type[i].to : bidi_type[i].from, make_number (bidi_type[i].type)); - fallback_paragraph_start_re = - Fsymbol_value (Fintern_soft (build_string ("paragraph-start"), Qnil)); + Qparagraph_start = intern ("paragraph-start"); + staticpro (&Qparagraph_start); + fallback_paragraph_start_re = Fsymbol_value (Qparagraph_start); if (!STRINGP (fallback_paragraph_start_re)) fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$"); staticpro (&fallback_paragraph_start_re); - Qparagraph_start = intern ("paragraph-start"); - staticpro (&Qparagraph_start); - fallback_paragraph_separate_re = - Fsymbol_value (Fintern_soft (build_string ("paragraph-separate"), Qnil)); + Qparagraph_separate = intern ("paragraph-separate"); + staticpro (&Qparagraph_separate); + fallback_paragraph_separate_re = Fsymbol_value (Qparagraph_separate); if (!STRINGP (fallback_paragraph_separate_re)) fallback_paragraph_separate_re = build_string ("[ \t\f]*$"); staticpro (&fallback_paragraph_separate_re); - Qparagraph_separate = intern ("paragraph-separate"); - staticpro (&Qparagraph_separate); bidi_initialized = 1; } @@ -752,6 +750,7 @@ static EMACS_INT bidi_at_paragraph_end (EMACS_INT charpos, EMACS_INT bytepos) { + /* FIXME: Why Fbuffer_local_value rather than just Fsymbol_value? */ Lisp_Object sep_re = Fbuffer_local_value (Qparagraph_separate, Fcurrent_buffer ()); Lisp_Object start_re = Fbuffer_local_value (Qparagraph_start, @@ -830,6 +829,7 @@ static EMACS_INT bidi_find_paragraph_start (EMACS_INT pos, EMACS_INT pos_byte) { + /* FIXME: Why Fbuffer_local_value rather than just Fsymbol_value? */ Lisp_Object re = Fbuffer_local_value (Qparagraph_start, Fcurrent_buffer ()); EMACS_INT limit = ZV, limit_byte = ZV_BYTE; === modified file 'src/buffer.c' --- src/buffer.c 2010-04-20 01:50:52 +0000 +++ src/buffer.c 2010-04-20 17:01:39 +0000 @@ -5175,7 +5175,6 @@ buffer_defaults.word_wrap = Qnil; buffer_defaults.ctl_arrow = Qt; buffer_defaults.bidi_display_reordering = Qnil; - buffer_defaults.direction_reversed = Qnil; buffer_defaults.bidi_paragraph_direction = Qnil; buffer_defaults.cursor_type = Qt; buffer_defaults.extra_line_spacing = Qnil; @@ -5262,7 +5261,6 @@ XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx; XSETFASTINT (buffer_local_flags.category_table, idx); ++idx; XSETFASTINT (buffer_local_flags.bidi_display_reordering, idx); ++idx; - XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx; XSETFASTINT (buffer_local_flags.bidi_paragraph_direction, idx); ++idx; XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx); /* Make this one a permanent local. */ @@ -5784,11 +5782,6 @@ This variable is never applied to a way of decoding a file while reading it. */); - DEFVAR_PER_BUFFER ("direction-reversed", - ¤t_buffer->direction_reversed, Qnil, - doc: /* Non-nil means set beginning of lines at the right edge of the window. -See also the variable `bidi-display-reordering'. */); - DEFVAR_PER_BUFFER ("bidi-display-reordering", ¤t_buffer->bidi_display_reordering, Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. @@ -5797,12 +5790,12 @@ DEFVAR_PER_BUFFER ("bidi-paragraph-direction", ¤t_buffer->bidi_paragraph_direction, Qnil, doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. - + If this is nil (the default), the direction of each paragraph is determined by the first strong directional character of its text. The values of `right-to-left' and `left-to-right' override that. Any other value is treated as nil. - + This variable has no effect unless the buffer's value of \`bidi-display-reordering' is non-nil. */); === modified file 'src/buffer.h' --- src/buffer.h 2010-04-20 01:50:52 +0000 +++ src/buffer.h 2010-04-20 17:01:39 +0000 @@ -679,9 +679,6 @@ /* Non-nil means reorder bidirectional text for display in the visual order. */ Lisp_Object bidi_display_reordering; - /* Non-nil means set beginning of lines at the right edge of - windows. */ - Lisp_Object direction_reversed; /* If non-nil, specifies which direction of text to force in all the paragraphs of the buffer. Nil means determine paragraph direction dynamically for each paragraph. */ === modified file 'src/dispextern.h' --- src/dispextern.h 2010-04-19 15:35:15 +0000 +++ src/dispextern.h 2010-04-20 17:01:39 +0000 @@ -1956,6 +1956,7 @@ NUM_IT_METHODS }; +/* FIXME: What is this? Why 5? */ #define IT_STACK_SIZE 5 /* Iterator for composition (both for static and automatic). */ ------------------------------------------------------------ revno: 99954 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 12:52:43 -0400 message: * vc-dispatcher (vc-finish-logentry): Don't mess with the windows/frames. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-20 16:37:31 +0000 +++ lisp/ChangeLog 2010-04-20 16:52:43 +0000 @@ -1,5 +1,8 @@ 2010-04-20 Stefan Monnier + * vc-dispatcher.el (vc-finish-logentry): Don't mess so badly with the + windows/frames. + * emacs-lisp/lisp.el (lisp-completion-at-point): Complete around point. I.e. include text after point in the completion region. Also, return nil when we're not after/in a symbol. === modified file 'lisp/vc-dispatcher.el' --- lisp/vc-dispatcher.el 2010-03-24 03:30:53 +0000 +++ lisp/vc-dispatcher.el 2010-04-20 16:52:43 +0000 @@ -599,8 +599,7 @@ (log-extra vc-log-extra) (log-entry (buffer-string)) (extra-flags log-edit-extra-flags) - (after-hook vc-log-after-operation-hook) - (tmp-vc-parent-buffer vc-parent-buffer)) + (after-hook vc-log-after-operation-hook)) (pop-to-buffer vc-parent-buffer) ;; OK, do it to it (save-excursion @@ -617,9 +616,11 @@ (delete-windows-on logbuf (selected-frame)) ;; Kill buffer and delete any other dedicated windows/frames. (kill-buffer logbuf)) - (logbuf (pop-to-buffer logbuf) - (bury-buffer) - (pop-to-buffer tmp-vc-parent-buffer))) + (logbuf + (with-selected-window (or (get-buffer-window logbuf 0) + (selected-window)) + (with-current-buffer logbuf + (bury-buffer))))) ;; Now make sure we see the expanded headers (when log-fileset (mapc ------------------------------------------------------------ revno: 99953 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 12:37:31 -0400 message: (lisp-completion-at-point): Complete around point. I.e. include text after point in the completion region. Also, return nil when we're not after/in a symbol. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-20 14:45:14 +0000 +++ lisp/ChangeLog 2010-04-20 16:37:31 +0000 @@ -1,5 +1,9 @@ 2010-04-20 Stefan Monnier + * emacs-lisp/lisp.el (lisp-completion-at-point): Complete around point. + I.e. include text after point in the completion region. + Also, return nil when we're not after/in a symbol. + * international/mule-cmds.el (view-hello-file): Don't fiddle with the default enable-multibyte-characters. === modified file 'lisp/emacs-lisp/lisp.el' --- lisp/emacs-lisp/lisp.el 2010-01-13 08:35:10 +0000 +++ lisp/emacs-lisp/lisp.el 2010-04-20 16:37:31 +0000 @@ -631,12 +631,11 @@ (defun lisp-completion-at-point (&optional predicate) ;; FIXME: the `end' could be after point? - (let* ((end (point)) + (let* ((pos (point)) (beg (with-syntax-table emacs-lisp-mode-syntax-table (save-excursion (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) + (skip-syntax-forward "'") (point)))) (predicate (or predicate @@ -656,12 +655,21 @@ ;; Maybe a `let' varlist or something. nil ;; Else, we assume that a function name is expected. - 'fboundp)))))) - (list beg end obarray - :predicate predicate - :annotate-function + 'fboundp))))) + (end + (unless (or (eq beg (point-max)) + (member (char-syntax (char-after beg)) '(?\( ?\)))) + (save-excursion + (goto-char beg) + (forward-sexp 1) + (when (>= (point) pos) + (point)))))) + (when end + (list beg end obarray + :predicate predicate + :annotate-function (unless (eq predicate 'fboundp) - (lambda (str) (if (fboundp (intern-soft str)) " ")))))) + (lambda (str) (if (fboundp (intern-soft str)) " "))))))) ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e ;;; lisp.el ends here ------------------------------------------------------------ revno: 99952 committer: Chong Yidong branch nick: trunk timestamp: Tue 2010-04-20 11:46:52 -0400 message: * emacs.manifest: Add trustInfo section to Windows manifest. See http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00805.html for details. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2010-03-10 15:17:13 +0000 +++ nt/ChangeLog 2010-04-20 15:46:52 +0000 @@ -1,3 +1,7 @@ +2010-04-20 Lewis Perin (tiny change) + + * emacs.manifest: Add trustInfo section to Windows manifest. + 2010-03-10 Chong Yidong * Branch for 23.2. === modified file 'nt/emacs.manifest' --- nt/emacs.manifest 2007-06-15 00:07:45 +0000 +++ nt/emacs.manifest 2010-04-20 15:46:52 +0000 @@ -8,4 +8,14 @@ language="*"/> - \ No newline at end of file + + GNU Emacs + + + + + + + + ------------------------------------------------------------ revno: 99951 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2010-04-20 10:45:14 -0400 message: (view-hello-file): Don't fiddle with the default enable-multibyte-characters. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-04-19 17:05:12 +0000 +++ lisp/ChangeLog 2010-04-20 14:45:14 +0000 @@ -1,3 +1,8 @@ +2010-04-20 Stefan Monnier + + * international/mule-cmds.el (view-hello-file): Don't fiddle with the + default enable-multibyte-characters. + 2010-04-19 Stefan Monnier * international/mule.el: Help the user choose a valid coding-system. === modified file 'lisp/international/mule-cmds.el' --- lisp/international/mule-cmds.el 2010-01-15 12:35:31 +0000 +++ lisp/international/mule-cmds.el 2010-04-20 14:45:14 +0000 @@ -286,8 +286,7 @@ "Display the HELLO file, which lists many languages and characters." (interactive) ;; We have to decode the file in any environment. - (letf (((default-value 'enable-multibyte-characters) t) - (coding-system-for-read 'iso-2022-7bit)) + (letf ((coding-system-for-read 'iso-2022-7bit)) (view-file (expand-file-name "HELLO" data-directory)))) (defun universal-coding-system-argument (coding-system) ------------------------------------------------------------ revno: 99950 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Tue 2010-04-20 16:31:28 +0300 message: Implement GUI display of R2L lines, fix TTY display of R2L lines. xdisp.c [HAVE_WINDOW_SYSTEM]: Add prototype for append_stretch_glyph. (set_cursor_from_row) : Remove unused variable. Fix off-by-one error in computing x at end of text in the row. (append_stretch_glyph): In reversed row, prepend the glyph rather than append it. Set resolved_level and bidi_type of the glyph. (extend_face_to_end_of_line): If the row is reversed, prepend a stretch glyph whose width is such that the rightmost glyph will be drawn at the right margin of the window. Fix off-by-one error on TTY frames in testing whether a line needs face extension. Fix face extension at ZV. If this is the last glyph row, use DEFAULT_FACE_ID, to avoid painting the rest of the window with the region face. (set_cursor_from_row, display_line): Use MATRIX_ROW_CONTINUATION_LINE_P instead of testing value of row->continuation_lines_width. (next_element_from_buffer): Don't call bidi_paragraph_init if we are at ZV. Fixes a crash when reseated to ZV by try_window_reusing_current_matrix. (display_and_set_cursor, erase_phys_cursor): Handle negative HPOS, which happens with R2L glyph rows. Fixes a crash when inserting a character at end of an R2L line. (set_cursor_from_row): Don't be fooled by truncated rows: don't treat them as having zero-width characters. Improve comments. Don't reverse pos_before and pos_after for reversed glyph rows. Set cursor.x to negative value when the cursor might be on the left fringe. (IT_OVERFLOW_NEWLINE_INTO_FRINGE): For R2L lines, consider the left fringe, not the right one. (notice_overwritten_cursor, draw_phys_cursor_glyph) (erase_phys_cursor): For reversed cursor_row, support cursor on the left fringe. fringe.c (update_window_fringes): For R2L rows, swap the bitmaps of continuation indicators on the fringes. (draw_fringe_bitmap): For reversed glyph rows, allow cursor on the left fringe. w32term.c (w32_draw_window_cursor): For reversed glyph rows, draw cursor on the left fringe. xterm.c (x_draw_window_cursor): For reversed glyph rows, draw cursor on the left fringe. dispnew.c (update_text_area): Handle reversed desired rows when the cursor is on the left fringe. (set_window_cursor_after_update): Limit cursor's hpos by -1 from below, not by 0, for when the cursor is on the left fringe. xdisp.c (unproduce_glyphs): New function. (display_line): Use it when produced glyphs are discarded from R2L glyph rows. (append_composite_glyph): In R2L rows, prepend the glyph rather than appending it. term.c (append_composite_glyph): In R2L rows, prepend the glyph rather than append it. Set up the resolved_level and bidi_type attributes of the appended glyph. (produce_special_glyphs): Mirror the backslash continuation character in R2L lines. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 11:38:30 +0000 +++ src/ChangeLog 2010-04-20 13:31:28 +0000 @@ -1,3 +1,70 @@ +2010-04-20 Eli Zaretskii + + Fix R2L paragraph display on TTY. + + * xdisp.c (unproduce_glyphs): New function. + (display_line): Use it when produced glyphs are discarded from R2L + glyph rows. + (append_composite_glyph): In R2L rows, prepend the glyph rather + than appending it. + + * term.c (append_composite_glyph): In R2L rows, prepend the glyph + rather than append it. Set up the resolved_level and bidi_type + attributes of the appended glyph. + (produce_special_glyphs): Mirror the backslash continuation + character in R2L lines. + + Implement display of R2L paragraphs in GUI sessions. + + * xdisp.c [HAVE_WINDOW_SYSTEM]: Add prototype for + append_stretch_glyph. + (set_cursor_from_row) : Remove unused variable. Fix + off-by-one error in computing x at end of text in the row. + (append_stretch_glyph): In reversed row, prepend the glyph rather + than append it. Set resolved_level and bidi_type of the glyph. + (extend_face_to_end_of_line): If the row is reversed, prepend a + stretch glyph whose width is such that the rightmost glyph will be + drawn at the right margin of the window. Fix off-by-one error on + TTY frames in testing whether a line needs face extension. Fix + face extension at ZV. If this is the last glyph row, use + DEFAULT_FACE_ID, to avoid painting the rest of the window with the + region face. + (set_cursor_from_row, display_line): Use + MATRIX_ROW_CONTINUATION_LINE_P instead of testing value of + row->continuation_lines_width. + (next_element_from_buffer): Don't call bidi_paragraph_init if we + are at ZV. Fixes a crash when reseated to ZV by + try_window_reusing_current_matrix. + (display_and_set_cursor, erase_phys_cursor): Handle negative HPOS, + which happens with R2L glyph rows. Fixes a crash when inserting a + character at end of an R2L line. + (set_cursor_from_row): Don't be fooled by truncated rows: don't + treat them as having zero-width characters. Improve comments. + Don't reverse pos_before and pos_after for reversed glyph rows. + Set cursor.x to negative value when the cursor might be on the + left fringe. + (IT_OVERFLOW_NEWLINE_INTO_FRINGE): For R2L lines, consider the + left fringe, not the right one. + (notice_overwritten_cursor, draw_phys_cursor_glyph) + (erase_phys_cursor): For reversed cursor_row, support cursor on + the left fringe. + + * fringe.c (update_window_fringes): For R2L rows, swap the bitmaps + of continuation indicators on the fringes. + (draw_fringe_bitmap): For reversed glyph rows, allow cursor on the + left fringe. + + * w32term.c (w32_draw_window_cursor): For reversed glyph rows, + draw cursor on the left fringe. + + * xterm.c (x_draw_window_cursor): For reversed glyph rows, draw + cursor on the left fringe. + + * dispnew.c (update_text_area): Handle reversed desired rows when + the cursor is on the left fringe. + (set_window_cursor_after_update): Limit cursor's hpos by -1 from + below, not by 0, for when the cursor is on the left fringe. + 2010-04-20 Jan Djärv * gtkutil.c (xg_event_is_for_scrollbar): Check if grabbed === modified file 'src/dispnew.c' --- src/dispnew.c 2010-04-02 03:10:33 +0000 +++ src/dispnew.c 2010-04-10 16:28:30 +0000 @@ -4251,7 +4251,9 @@ doesn't work with lbearing/rbearing), so we must do it this way. */ if (vpos == w->phys_cursor.vpos - && w->phys_cursor.hpos >= desired_row->used[TEXT_AREA]) + && (desired_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= desired_row->used[TEXT_AREA]))) { w->phys_cursor_on_p = 0; x = -1; @@ -4415,7 +4417,7 @@ } /* Window cursor can be out of sync for horizontally split windows. */ - hpos = max (0, hpos); + hpos = max (-1, hpos); /* -1 is for when cursor is on the left fringe */ hpos = min (w->current_matrix->matrix_w - 1, hpos); vpos = max (0, vpos); vpos = min (w->current_matrix->nrows - 1, vpos); === modified file 'src/fringe.c' --- src/fringe.c 2010-01-13 08:35:10 +0000 +++ src/fringe.c 2010-04-17 12:33:05 +0000 @@ -825,7 +825,7 @@ { int overlay = 0; - if (!left_p && row->cursor_in_fringe_p) + if (left_p == row->reversed_p && row->cursor_in_fringe_p) { Lisp_Object cursor = Qnil; @@ -857,7 +857,7 @@ int bm = get_logical_cursor_bitmap (w, cursor); if (bm != NO_FRINGE_BITMAP) { - draw_fringe_bitmap_1 (w, row, 0, 2, bm); + draw_fringe_bitmap_1 (w, row, left_p, 2, bm); overlay = EQ (cursor, Qbox) ? 3 : 1; } } @@ -1090,7 +1090,8 @@ : LEFT_FRINGE (2, Qtop, 0)); else if (row->indicate_eob_p && EQ (boundary_bot, Qleft)) left = LEFT_FRINGE (3, Qbottom, row->ends_at_zv_p); - else if (MATRIX_ROW_CONTINUATION_LINE_P (row)) + else if ((!row->reversed_p && MATRIX_ROW_CONTINUATION_LINE_P (row)) + || (row->reversed_p && row->continued_p)) left = LEFT_FRINGE (4, Qcontinuation, 0); else if (row->indicate_empty_line_p && EQ (empty_pos, Qleft)) left = LEFT_FRINGE (5, Qempty_line, 0); @@ -1117,7 +1118,8 @@ : RIGHT_FRINGE (2, Qtop, 0)); else if (row->indicate_eob_p && EQ (boundary_bot, Qright)) right = RIGHT_FRINGE (3, Qbottom, row->ends_at_zv_p); - else if (row->continued_p) + else if ((!row->reversed_p && row->continued_p) + || (row->reversed_p && MATRIX_ROW_CONTINUATION_LINE_P (row))) right = RIGHT_FRINGE (4, Qcontinuation, 0); else if (row->indicate_top_line_p && EQ (arrow_top, Qright)) right = RIGHT_FRINGE (6, Qup, 0); === modified file 'src/term.c' --- src/term.c 2010-04-20 01:50:52 +0000 +++ src/term.c 2010-04-20 13:31:28 +0000 @@ -1589,7 +1589,6 @@ } } - /* Produce glyphs for the display element described by IT. *IT specifies what we want to produce a glyph for (character, image, ...), and where in the glyph matrix we currently are (glyph row and hpos). @@ -1808,6 +1807,17 @@ glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area]; if (glyph < it->glyph_row->glyphs[1 + it->area]) { + /* If the glyph row is reversed, we need to prepend the glyph + rather than append it. */ + if (it->glyph_row->reversed_p && it->area == TEXT_AREA) + { + struct glyph *g; + + /* Make room for the new glyph. */ + for (g = glyph - 1; g >= it->glyph_row->glyphs[it->area]; g--) + g[1] = *g; + glyph = it->glyph_row->glyphs[it->area]; + } glyph->type = COMPOSITE_GLYPH; glyph->pixel_width = it->pixel_width; glyph->u.cmp.id = it->cmp_it.id; @@ -1828,6 +1838,18 @@ glyph->padding_p = 0; glyph->charpos = CHARPOS (it->position); glyph->object = it->object; + if (it->bidi_p) + { + glyph->resolved_level = it->bidi_it.resolved_level; + if ((it->bidi_it.type & 7) != it->bidi_it.type) + abort (); + glyph->bidi_type = it->bidi_it.type; + } + else + { + glyph->resolved_level = 0; + glyph->bidi_type = UNKNOWN_BT; + } ++it->glyph_row->used[it->area]; ++glyph; @@ -1889,12 +1911,16 @@ if (what == IT_CONTINUATION) { - /* Continuation glyph. */ - SET_GLYPH_FROM_CHAR (glyph, '\\'); + /* Continuation glyph. For R2L lines, we mirror it by hand. */ + if (it->bidi_it.paragraph_dir == R2L) + SET_GLYPH_FROM_CHAR (glyph, '/'); + else + SET_GLYPH_FROM_CHAR (glyph, '\\'); if (it->dp && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc)) && GLYPH_CODE_CHAR_VALID_P (gc)) { + /* FIXME: Should we mirror GC for R2L lines? */ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); spec_glyph_lookup_face (XWINDOW (it->window), &glyph); } @@ -1907,6 +1933,7 @@ && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc)) && GLYPH_CODE_CHAR_VALID_P (gc)) { + /* FIXME: Should we mirror GC for R2L lines? */ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); spec_glyph_lookup_face (XWINDOW (it->window), &glyph); } === modified file 'src/w32term.c' --- src/w32term.c 2010-04-02 03:10:33 +0000 +++ src/w32term.c 2010-04-10 16:28:30 +0000 @@ -5136,10 +5136,12 @@ } if (glyph_row->exact_window_width_line_p - && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) + && (glyph_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]))) { glyph_row->cursor_in_fringe_p = 1; - draw_fringe_bitmap (w, glyph_row, 0); + draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p); return; } === modified file 'src/xdisp.c' --- src/xdisp.c 2010-04-20 01:50:52 +0000 +++ src/xdisp.c 2010-04-20 13:31:28 +0000 @@ -404,12 +404,14 @@ /* Test if overflow newline into fringe. Called with iterator IT at or past right window margin, and with IT->current_x set. */ -#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) \ - (!NILP (Voverflow_newline_into_fringe) \ - && FRAME_WINDOW_P (it->f) \ - && WINDOW_RIGHT_FRINGE_WIDTH (it->w) > 0 \ - && it->current_x == it->last_visible_x \ - && it->line_wrap != WORD_WRAP) +#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(IT) \ + (!NILP (Voverflow_newline_into_fringe) \ + && FRAME_WINDOW_P ((IT)->f) \ + && ((IT)->bidi_it.paragraph_dir == R2L \ + ? (WINDOW_LEFT_FRINGE_WIDTH ((IT)->w) > 0) \ + : (WINDOW_RIGHT_FRINGE_WIDTH ((IT)->w) > 0)) \ + && (IT)->current_x == (IT)->last_visible_x \ + && (IT)->line_wrap != WORD_WRAP) #else /* !HAVE_WINDOW_SYSTEM */ #define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) 0 @@ -1077,6 +1079,8 @@ static void notice_overwritten_cursor P_ ((struct window *, enum glyph_row_area, int, int, int, int)); +static void append_stretch_glyph P_ ((struct it *, Lisp_Object, + int, int, int)); @@ -6709,13 +6713,20 @@ { it->bidi_it.charpos = IT_CHARPOS (*it); it->bidi_it.bytepos = IT_BYTEPOS (*it); - /* If we are at the beginning of a line, we can produce the next - element right away. */ - if (it->bidi_it.bytepos == BEGV_BYTE + if (it->bidi_it.bytepos == ZV_BYTE) + { + /* Nothing to do, but reset the FIRST_ELT flag, like + bidi_paragraph_init does, because we are not going to + call it. */ + it->bidi_it.first_elt = 0; + } + else if (it->bidi_it.bytepos == BEGV_BYTE /* FIXME: Should support all Unicode line separators. */ || FETCH_CHAR (it->bidi_it.bytepos - 1) == '\n' || FETCH_CHAR (it->bidi_it.bytepos) == '\n') { + /* If we are at the beginning of a line, we can produce the + next element right away. */ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it); bidi_get_next_char_visually (&it->bidi_it); } @@ -12619,7 +12630,6 @@ /* The last known character position in row. */ int last_pos = MATRIX_ROW_START_CHARPOS (row) + delta; int x = row->x; - int cursor_x = x; EMACS_INT pt_old = PT - delta; EMACS_INT pos_before = MATRIX_ROW_START_CHARPOS (row) + delta; EMACS_INT pos_after = MATRIX_ROW_END_CHARPOS (row) + delta; @@ -12655,8 +12665,8 @@ } while (end > glyph && INTEGERP ((end - 1)->object) - /* CHARPOS is zero for blanks inserted by - extend_face_to_end_of_line. */ + /* CHARPOS is zero for blanks and stretch glyphs + inserted by extend_face_to_end_of_line. */ && (end - 1)->charpos <= 0) --end; glyph_before = glyph - 1; @@ -12670,9 +12680,6 @@ to front, so swap the edge pointers. */ glyphs_end = end = glyph - 1; glyph += row->used[TEXT_AREA] - 1; - /* Reverse the known positions in the row. */ - last_pos = pos_after = MATRIX_ROW_START_CHARPOS (row) + delta; - pos_before = MATRIX_ROW_END_CHARPOS (row) + delta; while (glyph > end + 1 && INTEGERP (glyph->object) @@ -12687,7 +12694,6 @@ rightmost (first in the reading order) glyph. */ for (g = end + 1; g < glyph; g++) x += g->pixel_width; - cursor_x = x; while (end < glyph && INTEGERP ((end + 1)->object) && (end + 1)->charpos <= 0) @@ -12702,7 +12708,7 @@ rightmost glyph. Case in point: an empty last line that is part of an R2L paragraph. */ cursor = end - 1; - x = -1; /* will be computed below, at lable compute_x */ + x = -1; /* will be computed below, at label compute_x */ } /* Step 1: Try to find the glyph whose character position @@ -12838,8 +12844,11 @@ string_seen = 1; } --glyph; - if (glyph == end) - break; + if (glyph == glyphs_end) /* don't dereference outside TEXT_AREA */ + { + x--; /* can't use any pixel_width */ + break; + } x -= glyph->pixel_width; } @@ -12879,7 +12888,10 @@ } else if (match_with_avoid_cursor /* zero-width characters produce no glyphs */ - || eabs (glyph_after - glyph_before) == 1) + || ((row->reversed_p + ? glyph_after > glyphs_end + : glyph_after < glyphs_end) + && eabs (glyph_after - glyph_before) == 1)) { cursor = glyph_after; x = -1; @@ -12998,16 +13010,17 @@ } } - /* ROW could be part of a continued line, which might have other - rows whose start and end charpos occlude point. Only set - w->cursor if we found a better approximation to the cursor - position than we have from previously examined rows. */ + /* ROW could be part of a continued line, which, under bidi + reordering, might have other rows whose start and end charpos + occlude point. Only set w->cursor if we found a better + approximation to the cursor position than we have from previously + examined candidate rows belonging to the same continued line. */ if (/* we already have a candidate row */ w->cursor.vpos >= 0 /* that candidate is not the row we are processing */ && MATRIX_ROW (matrix, w->cursor.vpos) != row - /* this row is part of a continued line */ - && (row->continued_p || row->continuation_lines_width) + /* the row we are processing is part of a continued line */ + && (row->continued_p || MATRIX_ROW_CONTINUATION_LINE_P (row)) /* Make sure cursor.vpos specifies a row whose start and end charpos occlude point. This is because some callers of this function leave cursor.vpos at the row where the cursor was @@ -16850,9 +16863,11 @@ /* Extend the face of the last glyph in the text area of IT->glyph_row - to the end of the display line. Called from display_line. - If the glyph row is empty, add a space glyph to it so that we - know the face to draw. Set the glyph row flag fill_line_p. */ + to the end of the display line. Called from display_line. If the + glyph row is empty, add a space glyph to it so that we know the + face to draw. Set the glyph row flag fill_line_p. If the glyph + row is R2L, prepend a stretch glyph to cover the empty space to the + left of the leftmost glyph. */ static void extend_face_to_end_of_line (it) @@ -16861,15 +16876,17 @@ struct face *face; struct frame *f = it->f; - /* If line is already filled, do nothing. */ - if (it->current_x >= it->last_visible_x) + /* If line is already filled, do nothing. Non window-system frames + get a grace of one more ``pixel'' because their characters are + 1-``pixel'' wide, so they hit the equality too early. */ + if (it->current_x >= it->last_visible_x + !FRAME_WINDOW_P (f)) return; /* Face extension extends the background and box of IT->face_id to the end of the line. If the background equals the background of the frame, we don't have to do anything. */ if (it->face_before_selective_p) - face = FACE_FROM_ID (it->f, it->saved_face_id); + face = FACE_FROM_ID (f, it->saved_face_id); else face = FACE_FROM_ID (f, it->face_id); @@ -16877,7 +16894,8 @@ && it->glyph_row->displays_text_p && face->box == FACE_NO_BOX && face->background == FRAME_BACKGROUND_PIXEL (f) - && !face->stipple) + && !face->stipple + && !it->glyph_row->reversed_p) return; /* Set the glyph row flag indicating that the face of the last glyph @@ -16904,6 +16922,50 @@ it->glyph_row->glyphs[TEXT_AREA][0].face_id = it->face_id; it->glyph_row->used[TEXT_AREA] = 1; } +#ifdef HAVE_WINDOW_SYSTEM + if (it->glyph_row->reversed_p) + { + /* Prepend a stretch glyph to the row, such that the + rightmost glyph will be drawn flushed all the way to the + right margin of the window. The stretch glyph that will + occupy the empty space, if any, to the left of the + glyphs. */ + struct font *font = face->font ? face->font : FRAME_FONT (f); + struct glyph *row_start = it->glyph_row->glyphs[TEXT_AREA]; + struct glyph *row_end = row_start + it->glyph_row->used[TEXT_AREA]; + struct glyph *g; + int row_width, stretch_ascent, stretch_width; + struct text_pos saved_pos; + int saved_face_id, saved_avoid_cursor; + + for (row_width = 0, g = row_start; g < row_end; g++) + row_width += g->pixel_width; + stretch_width = window_box_width (it->w, TEXT_AREA) - row_width; + if (stretch_width > 0) + { + stretch_ascent = + (((it->ascent + it->descent) + * FONT_BASE (font)) / FONT_HEIGHT (font)); + saved_pos = it->position; + bzero (&it->position, sizeof it->position); + saved_avoid_cursor = it->avoid_cursor_p; + it->avoid_cursor_p = 1; + saved_face_id = it->face_id; + /* The last row's stretch glyph should get the default + face, to avoid painting the rest of the window with + the region face, if the region ends at ZV. */ + if (it->glyph_row->ends_at_zv_p) + it->face_id = DEFAULT_FACE_ID; + else + it->face_id = face->id; + append_stretch_glyph (it, make_number (0), stretch_width, + it->ascent + it->descent, stretch_ascent); + it->position = saved_pos; + it->avoid_cursor_p = saved_avoid_cursor; + it->face_id = saved_face_id; + } + } +#endif /* HAVE_WINDOW_SYSTEM */ } else { @@ -16922,7 +16984,13 @@ it->object = make_number (0); it->c = ' '; it->len = 1; - it->face_id = face->id; + /* The last row's blank glyphs should get the default face, to + avoid painting the rest of the window with the region face, + if the region ends at ZV. */ + if (it->glyph_row->ends_at_zv_p) + it->face_id = DEFAULT_FACE_ID; + else + it->face_id = face->id; PRODUCE_GLYPHS (it); @@ -17208,6 +17276,31 @@ +/* Remove N glyphs at the start of a reversed IT->glyph_row. Called + only for R2L lines from display_line, when it decides that too many + glyphs were produced by PRODUCE_GLYPHS, and the line needs to be + continued. */ +static void +unproduce_glyphs (it, n) + struct it *it; + int n; +{ + struct glyph *glyph, *end; + + xassert (it->glyph_row); + xassert (it->glyph_row->reversed_p); + xassert (it->area == TEXT_AREA); + xassert (n <= it->glyph_row->used[TEXT_AREA]); + + if (n > it->glyph_row->used[TEXT_AREA]) + n = it->glyph_row->used[TEXT_AREA]; + glyph = it->glyph_row->glyphs[TEXT_AREA] + n; + end = it->glyph_row->glyphs[TEXT_AREA] + it->glyph_row->used[TEXT_AREA]; + for ( ; glyph < end; glyph++) + glyph[-n] = *glyph; +} + + /* Construct the glyph row IT->glyph_row in the desired matrix of IT->w from text at the current position of IT. See dispextern.h for an overview of struct it. Value is non-zero if @@ -17472,6 +17565,9 @@ /* A padding glyph that doesn't fit on this line. This means the whole character doesn't fit on the line. */ + if (row->reversed_p) + unproduce_glyphs (it, row->used[TEXT_AREA] + - n_glyphs_before); row->used[TEXT_AREA] = n_glyphs_before; /* Fill the rest of the row with continuation @@ -17494,6 +17590,9 @@ else if (wrap_row_used > 0) { back_to_wrap: + if (row->reversed_p) + unproduce_glyphs (it, + row->used[TEXT_AREA] - wrap_row_used); *it = wrap_it; it->continuation_lines_width += wrap_x; row->used[TEXT_AREA] = wrap_row_used; @@ -17529,6 +17628,9 @@ /* Something other than a TAB that draws past the right edge of the window. Restore positions to values before the element. */ + if (row->reversed_p) + unproduce_glyphs (it, row->used[TEXT_AREA] + - (n_glyphs_before + i)); row->used[TEXT_AREA] = n_glyphs_before + i; /* Display continuation glyphs. */ @@ -17634,9 +17736,22 @@ { int i, n; - for (i = row->used[TEXT_AREA] - 1; i > 0; --i) - if (!CHAR_GLYPH_PADDING_P (row->glyphs[TEXT_AREA][i])) - break; + if (!row->reversed_p) + { + for (i = row->used[TEXT_AREA] - 1; i > 0; --i) + if (!CHAR_GLYPH_PADDING_P (row->glyphs[TEXT_AREA][i])) + break; + } + else + { + for (i = 0; i < row->used[TEXT_AREA]; i++) + if (!CHAR_GLYPH_PADDING_P (row->glyphs[TEXT_AREA][i])) + break; + /* Remove padding glyphs at the front of ROW, to + make room for the truncation glyphs we will be + adding below. */ + unproduce_glyphs (it, i); + } for (n = row->used[TEXT_AREA]; i < n; ++i) { @@ -17823,7 +17938,7 @@ *it = save_it; } else if (!row->continued_p - && row->continuation_lines_width + && MATRIX_ROW_CONTINUATION_LINE_P (row) && it->eol_pos.charpos > 0) { /* Last row of a continued line. Use the position @@ -21493,6 +21608,17 @@ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area]; if (glyph < it->glyph_row->glyphs[area + 1]) { + /* If the glyph row is reversed, we need to prepend the glyph + rather than append it. */ + if (it->glyph_row->reversed_p && it->area == TEXT_AREA) + { + struct glyph *g; + + /* Make room for the new glyph. */ + for (g = glyph - 1; g >= it->glyph_row->glyphs[it->area]; g--) + g[1] = *g; + glyph = it->glyph_row->glyphs[it->area]; + } glyph->charpos = CHARPOS (it->position); glyph->object = it->object; glyph->pixel_width = it->pixel_width; @@ -21738,6 +21864,17 @@ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area]; if (glyph < it->glyph_row->glyphs[area + 1]) { + /* If the glyph row is reversed, we need to prepend the glyph + rather than append it. */ + if (it->glyph_row->reversed_p && area == TEXT_AREA) + { + struct glyph *g; + + /* Make room for the additional glyph. */ + for (g = glyph - 1; g >= it->glyph_row->glyphs[area]; g--) + g[1] = *g; + glyph = it->glyph_row->glyphs[area]; + } glyph->charpos = CHARPOS (it->position); glyph->object = object; glyph->pixel_width = width; @@ -21764,6 +21901,11 @@ abort (); glyph->bidi_type = it->bidi_it.type; } + else + { + glyph->resolved_level = 0; + glyph->bidi_type = UNKNOWN_BT; + } ++it->glyph_row->used[area]; } else @@ -23244,7 +23386,7 @@ if (row->cursor_in_fringe_p) { row->cursor_in_fringe_p = 0; - draw_fringe_bitmap (w, row, 0); + draw_fringe_bitmap (w, row, row->reversed_p); w->phys_cursor_on_p = 0; return; } @@ -23345,7 +23487,9 @@ /* If cursor hpos is out of bounds, don't draw garbage. This can happen in mini-buffer windows when switching between echo area glyphs and mini-buffer. */ - if (w->phys_cursor.hpos < row->used[TEXT_AREA]) + if ((row->reversed_p + ? (w->phys_cursor.hpos >= 0) + : (w->phys_cursor.hpos < row->used[TEXT_AREA]))) { int on_p = w->phys_cursor_on_p; int x1; @@ -23425,7 +23569,7 @@ if (cursor_row->cursor_in_fringe_p) { cursor_row->cursor_in_fringe_p = 0; - draw_fringe_bitmap (w, cursor_row, 0); + draw_fringe_bitmap (w, cursor_row, cursor_row->reversed_p); goto mark_cursor_off; } @@ -23434,7 +23578,9 @@ should have cleared the cursor. Note that we wouldn't be able to erase the cursor in this case because we don't have a cursor glyph at hand. */ - if (w->phys_cursor.hpos >= cursor_row->used[TEXT_AREA]) + if ((cursor_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= cursor_row->used[TEXT_AREA]))) goto mark_cursor_off; /* If the cursor is in the mouse face area, redisplay that when @@ -23450,7 +23596,7 @@ /* Don't redraw the cursor's spot in mouse face if it is at the end of a line (on a newline). The cursor appears there, but mouse highlighting does not. */ - && cursor_row->used[TEXT_AREA] > hpos) + && cursor_row->used[TEXT_AREA] > hpos && hpos >= 0) mouse_face_here_p = 1; /* Maybe clear the display under the cursor. */ @@ -23532,7 +23678,7 @@ glyph = NULL; if (!glyph_row->exact_window_width_line_p - || hpos < glyph_row->used[TEXT_AREA]) + || (0 <= hpos && hpos < glyph_row->used[TEXT_AREA])) glyph = glyph_row->glyphs[TEXT_AREA] + hpos; xassert (interrupt_input_blocked); === modified file 'src/xterm.c' --- src/xterm.c 2010-04-19 15:07:52 +0000 +++ src/xterm.c 2010-04-20 13:31:28 +0000 @@ -7492,36 +7492,40 @@ w->phys_cursor_on_p = 1; if (glyph_row->exact_window_width_line_p - && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) + && (glyph_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]))) { glyph_row->cursor_in_fringe_p = 1; - draw_fringe_bitmap (w, glyph_row, 0); + draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p); } else - switch (cursor_type) { - case HOLLOW_BOX_CURSOR: - x_draw_hollow_cursor (w, glyph_row); - break; - - case FILLED_BOX_CURSOR: - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); - break; - - case BAR_CURSOR: - x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); - break; - - case HBAR_CURSOR: - x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); - break; - - case NO_CURSOR: - w->phys_cursor_width = 0; - break; - - default: - abort (); + switch (cursor_type) + { + case HOLLOW_BOX_CURSOR: + x_draw_hollow_cursor (w, glyph_row); + break; + + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + + case BAR_CURSOR: + x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + break; + + case HBAR_CURSOR: + x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); + break; + + case NO_CURSOR: + w->phys_cursor_width = 0; + break; + + default: + abort (); + } } #ifdef HAVE_X_I18N ------------------------------------------------------------ revno: 99949 committer: Jan D. branch nick: trunk timestamp: Tue 2010-04-20 13:38:30 +0200 message: gtkutils.c (xg_event_is_for_scrollbar): Check if grabbed widget is a scrollbar. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 07:26:02 +0000 +++ src/ChangeLog 2010-04-20 11:38:30 +0000 @@ -1,3 +1,8 @@ +2010-04-20 Jan Djärv + + * gtkutil.c (xg_event_is_for_scrollbar): Check if grabbed + widget is a scrollbar. + 2010-04-20 Kenichi Handa * charset.c (char_charset): Consider Vcharset_non_preferred_head === modified file 'src/gtkutil.c' --- src/gtkutil.c 2010-04-18 11:24:59 +0000 +++ src/gtkutil.c 2010-04-20 11:38:30 +0000 @@ -3371,8 +3371,8 @@ || event->type == MotionNotify)) { /* If we are releasing or moving the scroll bar, it has the grab. */ - retval = gtk_grab_get_current () != 0 - && gtk_grab_get_current () != f->output_data.x->edit_widget; + GtkWidget *w = gtk_grab_get_current (); + retval = w != 0 && GTK_IS_SCROLLBAR (w); } return retval; ------------------------------------------------------------ revno: 99948 [merge] committer: Kenichi Handa branch nick: trunk timestamp: Tue 2010-04-20 16:27:15 +0900 message: charset.c (char_charset): Consider Vcharset_non_preferred_head only when the arg CHARSET_LIST is nil. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-20 01:50:52 +0000 +++ src/ChangeLog 2010-04-20 07:26:02 +0000 @@ -1,3 +1,8 @@ +2010-04-20 Kenichi Handa + + * charset.c (char_charset): Consider Vcharset_non_preferred_head + only when the arg CHARSET_LIST is nil. + 2010-04-20 Stefan Monnier Make variable forwarding explicit rather the using special values. @@ -110,6 +115,8 @@ * .gdbinit (xsubchartable): New command. +2010-04-19 Eli Zaretskii + * xdisp.c (display_line): Don't write beyond the last glyph row in the desired matrix. Fixes a crash in "emacs -nw" (bug#5972), see http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00075.html === modified file 'src/charset.c' --- src/charset.c 2010-02-28 14:19:31 +0000 +++ src/charset.c 2010-04-20 06:30:26 +0000 @@ -2082,8 +2082,9 @@ return charset; } charset_list = XCDR (charset_list); - if (c <= MAX_UNICODE_CHAR - && EQ (charset_list, Vcharset_non_preferred_head)) + if (! maybe_null + && c <= MAX_UNICODE_CHAR + && EQ (charset_list, Vcharset_non_preferred_head)) return CHARSET_FROM_ID (charset_unicode); } return (maybe_null ? NULL ------------------------------------------------------------ revno: 99947 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2010-04-19 21:50:52 -0400 message: Make variable forwarding explicit rather the using special values. Basically, this makes the structure of buffer-local values and object forwarding explicit in the type of Lisp_Symbols rather than use special Lisp_Objects for that. This tends to lead to slightly more verbose code, but is more C-like, simpler, and makes it easier to make sure we handled all cases, among other things by letting the compiler help us check it. * lisp.h (enum Lisp_Misc_Type, union Lisp_Misc): Removing forwarding objects. (enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types. (struct Lisp_Symbol): Make the various forms of variable-forwarding explicit rather than hiding them inside Lisp_Object "values". (XFWDTYPE): New macro. (XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine. (XBUFFER_LOCAL_VALUE): Remove. (SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL) (SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros. (SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove. (struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd) (struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd): Remove the Lisp_Misc_* header. (struct Lisp_Buffer_Local_Value): Redefine. (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros. (struct Lisp_Misc_Any): Add filler to get the right size. (struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct Lisp_Intfwd. (DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT) (DEFVAR_KBOARD): Allocate a forwarding object. * data.c (do_blv_forwarding, store_blv_forwarding): New macros. (let_shadows_global_binding_p): New function. (union Lisp_Val_Fwd): New type. (make_blv): New function. (swap_in_symval_forwarding, indirect_variable, do_symval_forwarding) (store_symval_forwarding, swap_in_global_binding, Fboundp) (swap_in_symval_forwarding, find_symbol_value, Fset) (let_shadows_buffer_binding_p, set_internal, default_value) (Fset_default, Fmake_variable_buffer_local, Fmake_local_variable) (Fkill_local_variable, Fmake_variable_frame_local) (Flocal_variable_p, Flocal_variable_if_set_p) (Fvariable_binding_locus): * xdisp.c (select_frame_for_redisplay): * lread.c (Fintern, Funintern, init_obarray, defvar_int) (defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard): * frame.c (store_frame_param): * eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to): * bytecode.c (Fbyte_code) : Adapt to the new symbol value structure. * buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h. (clone_per_buffer_values): Only adjust markers into the current buffer. (reset_buffer_local_variables): PER_BUFFER_IDX is never -2. (Fbuffer_local_value, set_buffer_internal_1) (swap_out_buffer_local_variables): Adapt to the new symbol value structure. (DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object. (defvar_per_buffer): Take a new arg for the fwd object. (buffer_lisp_local_variables): Return a proper alist (different fix for bug#4138). * alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL. (Fgarbage_collect): Don't handle buffer_defaults specially. (mark_object): Handle new symbol value structure rather than the old special Lisp_Misc_* objects. (gc_sweep) : Free also the buffer-local-value objects. * term.c (set_tty_color_mode): * bidi.c (bidi_initialize): Don't access the ->value field directly. * buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with a buffer_local_flags. * print.c (print_object): Get rid of impossible forwarding objects. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-04-19 16:22:55 +0000 +++ src/ChangeLog 2010-04-20 01:50:52 +0000 @@ -1,9 +1,79 @@ +2010-04-20 Stefan Monnier + + Make variable forwarding explicit rather the using special values. + Basically, this makes the structure of buffer-local values and object + forwarding explicit in the type of Lisp_Symbols rather than use + special Lisp_Objects for that. This tends to lead to slightly more + verbose code, but is more C-like, simpler, and makes it easier to make + sure we handled all cases, among other things by letting the compiler + help us check it. + * lisp.h (enum Lisp_Misc_Type, union Lisp_Misc): + Removing forwarding objects. + (enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types. + (struct Lisp_Symbol): Make the various forms of variable-forwarding + explicit rather than hiding them inside Lisp_Object "values". + (XFWDTYPE): New macro. + (XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine. + (XBUFFER_LOCAL_VALUE): Remove. + (SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL) + (SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros. + (SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove. + (struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd) + (struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd): + Remove the Lisp_Misc_* header. + (struct Lisp_Buffer_Local_Value): Redefine. + (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros. + (struct Lisp_Misc_Any): Add filler to get the right size. + (struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct + Lisp_Intfwd. + (DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT) + (DEFVAR_KBOARD): Allocate a forwarding object. + * data.c (do_blv_forwarding, store_blv_forwarding): New macros. + (let_shadows_global_binding_p): New function. + (union Lisp_Val_Fwd): New type. + (make_blv): New function. + (swap_in_symval_forwarding, indirect_variable, do_symval_forwarding) + (store_symval_forwarding, swap_in_global_binding, Fboundp) + (swap_in_symval_forwarding, find_symbol_value, Fset) + (let_shadows_buffer_binding_p, set_internal, default_value) + (Fset_default, Fmake_variable_buffer_local, Fmake_local_variable) + (Fkill_local_variable, Fmake_variable_frame_local) + (Flocal_variable_p, Flocal_variable_if_set_p) + (Fvariable_binding_locus): + * xdisp.c (select_frame_for_redisplay): + * lread.c (Fintern, Funintern, init_obarray, defvar_int) + (defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard): + * frame.c (store_frame_param): + * eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to): + * bytecode.c (Fbyte_code) : Adapt to the new symbol + value structure. + * buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h. + (clone_per_buffer_values): Only adjust markers into the current buffer. + (reset_buffer_local_variables): PER_BUFFER_IDX is never -2. + (Fbuffer_local_value, set_buffer_internal_1) + (swap_out_buffer_local_variables): + Adapt to the new symbol value structure. + (DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object. + (defvar_per_buffer): Take a new arg for the fwd object. + (buffer_lisp_local_variables): Return a proper alist (different fix + for bug#4138). + * alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL. + (Fgarbage_collect): Don't handle buffer_defaults specially. + (mark_object): Handle new symbol value structure rather than the old + special Lisp_Misc_* objects. + (gc_sweep) : Free also the buffer-local-value objects. + * term.c (set_tty_color_mode): + * bidi.c (bidi_initialize): Don't access the ->value field directly. + * buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with + a buffer_local_flags. + * print.c (print_object): Get rid of impossible forwarding objects. + 2010-04-19 Eli Zaretskii * bidi.c (bidi_get_type, bidi_get_category) (bidi_at_paragraph_end, bidi_resolve_weak, bidi_resolve_neutral) - (bidi_type_of_next_char, bidi_level_of_next_char): Declare - static. Use `INLINE' rather than `inline'. + (bidi_type_of_next_char, bidi_level_of_next_char): + Declare static. Use `INLINE' rather than `inline'. 2010-04-19 Juanma Barranquero === modified file 'src/alloc.c' --- src/alloc.c 2010-04-18 21:49:33 +0000 +++ src/alloc.c 2010-04-20 01:50:52 +0000 @@ -1365,7 +1365,7 @@ pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE); pthread_mutex_init (&alloc_mutex, &attr); #else /* !DOUG_LEA_MALLOC */ - /* Some systems such as Solaris 2.6 doesn't have a recursive mutex, + /* Some systems such as Solaris 2.6 don't have a recursive mutex, and the bundled gmalloc.c doesn't require it. */ pthread_mutex_init (&alloc_mutex, NULL); #endif /* !DOUG_LEA_MALLOC */ @@ -3193,13 +3193,13 @@ p = XSYMBOL (val); p->xname = name; p->plist = Qnil; - p->value = Qunbound; + p->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (p, Qunbound); p->function = Qunbound; p->next = NULL; p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; p->constant = 0; - p->indirect_variable = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; @@ -5581,17 +5581,42 @@ break; CHECK_ALLOCATED_AND_LIVE (live_symbol_p); ptr->gcmarkbit = 1; - mark_object (ptr->value); mark_object (ptr->function); mark_object (ptr->plist); - + switch (ptr->redirect) + { + case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; + case SYMBOL_VARALIAS: + { + Lisp_Object tem; + XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); + mark_object (tem); + break; + } + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); + /* If the value is forwarded to a buffer or keyboard field, + these are marked when we see the corresponding object. + And if it's forwarded to a C variable, either it's not + a Lisp_Object var, or it's staticpro'd already. */ + mark_object (blv->where); + mark_object (blv->valcell); + mark_object (blv->defcell); + break; + } + case SYMBOL_FORWARDED: + /* If the value is forwarded to a buffer or keyboard field, + these are marked when we see the corresponding object. + And if it's forwarded to a C variable, either it's not + a Lisp_Object var, or it's staticpro'd already. */ + break; + default: abort (); + } if (!PURE_POINTER_P (XSTRING (ptr->xname))) MARK_STRING (XSTRING (ptr->xname)); MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname)); - /* Note that we do not mark the obarray of the symbol. - It is safe not to do so because nothing accesses that - slot except to check whether it is nil. */ ptr = ptr->next; if (ptr) { @@ -5610,22 +5635,6 @@ switch (XMISCTYPE (obj)) { - case Lisp_Misc_Buffer_Local_Value: - { - register struct Lisp_Buffer_Local_Value *ptr - = XBUFFER_LOCAL_VALUE (obj); - /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (ptr->cdr, Qnil)) - { - obj = ptr->realvalue; - goto loop; - } - mark_object (ptr->realvalue); - mark_object (ptr->buffer); - mark_object (ptr->frame); - obj = ptr->cdr; - goto loop; - } case Lisp_Misc_Marker: /* DO NOT mark thru the marker's chain. @@ -5633,17 +5642,6 @@ instead, markers are removed from the chain when freed by gc. */ break; - case Lisp_Misc_Intfwd: - case Lisp_Misc_Boolfwd: - case Lisp_Misc_Objfwd: - case Lisp_Misc_Buffer_Objfwd: - case Lisp_Misc_Kboard_Objfwd: - /* Don't bother with Lisp_Buffer_Objfwd, - since all markable slots in current buffer marked anyway. */ - /* Don't need to do Lisp_Objfwd, since the places they point - are protected with staticpro. */ - break; - case Lisp_Misc_Save_Value: #if GC_MARK_STACK { @@ -6048,6 +6046,8 @@ if (!sym->gcmarkbit && !pure_p) { + if (sym->redirect == SYMBOL_LOCALIZED) + xfree (SYMBOL_BLV (sym)); sym->next = symbol_free_list; symbol_free_list = sym; #if GC_MARK_STACK === modified file 'src/bidi.c' --- src/bidi.c 2010-04-19 16:22:55 +0000 +++ src/bidi.c 2010-04-20 01:50:52 +0000 @@ -400,14 +400,14 @@ make_number (bidi_type[i].type)); fallback_paragraph_start_re = - XSYMBOL (Fintern_soft (build_string ("paragraph-start"), Qnil))->value; + Fsymbol_value (Fintern_soft (build_string ("paragraph-start"), Qnil)); if (!STRINGP (fallback_paragraph_start_re)) fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$"); staticpro (&fallback_paragraph_start_re); Qparagraph_start = intern ("paragraph-start"); staticpro (&Qparagraph_start); fallback_paragraph_separate_re = - XSYMBOL (Fintern_soft (build_string ("paragraph-separate"), Qnil))->value; + Fsymbol_value (Fintern_soft (build_string ("paragraph-separate"), Qnil)); if (!STRINGP (fallback_paragraph_separate_re)) fallback_paragraph_separate_re = build_string ("[ \t\f]*$"); staticpro (&fallback_paragraph_separate_re); @@ -879,7 +879,6 @@ int ch, ch_len; EMACS_INT pos; bidi_type_t type; - EMACS_INT sep_len; /* If we are inside a paragraph separator, we are just waiting for the separator to be exhausted; use the previous paragraph === modified file 'src/buffer.c' --- src/buffer.c 2010-04-13 01:47:40 +0000 +++ src/buffer.c 2010-04-20 01:50:52 +0000 @@ -78,9 +78,6 @@ be a DEFVAR_PER_BUFFER for the slot, there is no default value for it; and the corresponding slot in buffer_defaults is not used. - If a slot is -2, then there is no DEFVAR_PER_BUFFER for it, - but there is a default value which is copied into each buffer. - If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is zero, that is a bug */ @@ -94,6 +91,12 @@ /* A Lisp_Object pointer to the above, used for staticpro */ static Lisp_Object Vbuffer_local_symbols; +/* Return the symbol of the per-buffer variable at offset OFFSET in + the buffer structure. */ + +#define PER_BUFFER_SYMBOL(OFFSET) \ + (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols)) + /* Flags indicating which built-in buffer-local variables are permanent locals. */ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS]; @@ -507,7 +510,7 @@ continue; obj = PER_BUFFER_VALUE (from, offset); - if (MARKERP (obj)) + if (MARKERP (obj) && XMARKER (obj)->buffer == from) { struct Lisp_Marker *m = XMARKER (obj); obj = Fmake_marker (); @@ -770,9 +773,7 @@ { Lisp_Object tmp, prop, last = Qnil; for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp)) - if (CONSP (XCAR (tmp)) - && SYMBOLP (XCAR (XCAR (tmp))) - && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) + if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) { /* If permanent-local, keep it. */ last = tmp; @@ -822,9 +823,7 @@ int idx = PER_BUFFER_IDX (offset); if ((idx > 0 && (permanent_too - || buffer_permanent_local_flags[idx] == 0)) - /* Is -2 used anywhere? */ - || idx == -2) + || buffer_permanent_local_flags[idx] == 0))) PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset); } } @@ -938,59 +937,49 @@ CHECK_SYMBOL (variable); CHECK_BUFFER (buffer); buf = XBUFFER (buffer); - - sym = indirect_variable (XSYMBOL (variable)); - XSETSYMBOL (variable, sym); - - /* Look in local_var_list */ - result = Fassoc (variable, buf->local_var_alist); - if (NILP (result)) - { - int offset, idx; - int found = 0; - - /* Look in special slots */ - /* buffer-local Lisp variables start at `undo_list', - tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof (struct buffer); - /* sizeof EMACS_INT == sizeof Lisp_Object */ - offset += (sizeof (EMACS_INT))) - { - idx = PER_BUFFER_IDX (offset); - if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) - && SYMBOLP (PER_BUFFER_SYMBOL (offset)) - && EQ (PER_BUFFER_SYMBOL (offset), variable)) - { - result = PER_BUFFER_VALUE (buf, offset); - found = 1; - break; - } - } - - if (!found) - result = Fdefault_value (variable); - } - else - { - Lisp_Object valcontents; - Lisp_Object current_alist_element; - - /* What binding is loaded right now? */ - valcontents = sym->value; - current_alist_element - = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - - /* The value of the currently loaded binding is not - stored in it, but rather in the realvalue slot. - Store that value into the binding it belongs to - in case that is the one we are about to use. */ - - Fsetcdr (current_alist_element, - do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); - - /* Now get the (perhaps updated) value out of the binding. */ - result = XCDR (result); + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break; + case SYMBOL_LOCALIZED: + { /* Look in local_var_alist. */ + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ + result = Fassoc (variable, buf->local_var_alist); + if (!NILP (result)) + { + if (blv->fwd) + { /* What binding is loaded right now? */ + Lisp_Object current_alist_element = blv->valcell; + + /* The value of the currently loaded binding is not + stored in it, but rather in the realvalue slot. + Store that value into the binding it belongs to + in case that is the one we are about to use. */ + + XSETCDR (current_alist_element, + do_symval_forwarding (blv->fwd)); + } + /* Now get the (perhaps updated) value out of the binding. */ + result = XCDR (result); + } + else + result = Fdefault_value (variable); + break; + } + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *fwd = SYMBOL_FWD (sym); + if (BUFFER_OBJFWDP (fwd)) + result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset); + else + result = Fdefault_value (variable); + break; + } + default: abort (); } if (!EQ (result, Qunbound)) @@ -1025,12 +1014,7 @@ if (buf != current_buffer) val = XCDR (elt); - /* If symbol is unbound, put just the symbol in the list. */ - if (EQ (val, Qunbound)) - result = Fcons (XCAR (elt), result); - /* Otherwise, put (symbol . value) in the list. */ - else - result = Fcons (Fcons (XCAR (elt), val), result); + result = Fcons (Fcons (XCAR (elt), val), result); } return result; @@ -1862,8 +1846,7 @@ register struct buffer *b; { register struct buffer *old_buf; - register Lisp_Object tail, valcontents; - Lisp_Object tem; + register Lisp_Object tail; #ifdef USE_MMAP_FOR_BUFFERS if (b->text->beg == NULL) @@ -1935,34 +1918,21 @@ /* Look down buffer's list of local Lisp variables to find and update any that forward into C variables. */ - for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail)) + do { - if (CONSP (XCAR (tail)) - && SYMBOLP (XCAR (XCAR (tail))) - && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))), - (BUFFER_LOCAL_VALUEP (valcontents))) - && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem)))) - /* Just reference the variable to cause it to become set for - this buffer. */ - Fsymbol_value (XCAR (XCAR (tail))); + for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object var = XCAR (XCAR (tail)); + struct Lisp_Symbol *sym = XSYMBOL (var); + if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */ + && SYMBOL_BLV (sym)->fwd) + /* Just reference the variable + to cause it to become set for this buffer. */ + Fsymbol_value (var); + } } - /* Do the same with any others that were local to the previous buffer */ - - if (old_buf) - for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) - { - if (CONSP (tail) - && SYMBOLP (XCAR (XCAR (tail))) - && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))), - (BUFFER_LOCAL_VALUEP (valcontents))) - && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem)))) - /* Just reference the variable to cause it to become set for - this buffer. */ - Fsymbol_value (XCAR (XCAR (tail))); - } + while (b != old_buf && (b = old_buf, b)); } /* Switch to buffer B temporarily for redisplay purposes. @@ -2677,23 +2647,22 @@ swap_out_buffer_local_variables (b) struct buffer *b; { - Lisp_Object oalist, alist, sym, buffer; + Lisp_Object oalist, alist, buffer; XSETBUFFER (buffer, b); oalist = b->local_var_alist; for (alist = oalist; CONSP (alist); alist = XCDR (alist)) { - if (CONSP (XCAR (alist)) - && (sym = XCAR (XCAR (alist)), SYMBOLP (sym)) - /* Need not do anything if some other buffer's binding is - now encached. */ - && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer, - buffer)) + Lisp_Object sym = XCAR (XCAR (alist)); + eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED); + /* Need not do anything if some other buffer's binding is + now encached. */ + if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer)) { /* Symbol is set up for this buffer's old local value: swap it out! */ - swap_in_global_binding (sym); + swap_in_global_binding (XSYMBOL (sym)); } } } @@ -5162,7 +5131,9 @@ /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); + eassert (EQ (buffer_defaults.name, make_number (0))); reset_buffer_local_variables (&buffer_defaults, 1); + eassert (EQ (buffer_local_symbols.name, make_number (0))); reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ @@ -5421,33 +5392,41 @@ in the buffer that is current now. */ /* TYPE is nil for a general Lisp variable. - An integer specifies a type; then only LIsp values + An integer specifies a type; then only Lisp values with that type code are allowed (except that nil is allowed too). - LNAME is the LIsp-level variable name. + LNAME is the Lisp-level variable name. VNAME is the name of the buffer slot. DOC is a dummy where you write the doc string as a comment. */ -#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ - defvar_per_buffer (lname, vname, type, 0) +#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ + do { \ + static struct Lisp_Buffer_Objfwd bo_fwd; \ + defvar_per_buffer (&bo_fwd, lname, vname, type, 0); \ + } while (0) static void -defvar_per_buffer (namestring, address, type, doc) +defvar_per_buffer (bo_fwd, namestring, address, type, doc) + struct Lisp_Buffer_Objfwd *bo_fwd; char *namestring; Lisp_Object *address; Lisp_Object type; char *doc; { - Lisp_Object sym, val; + struct Lisp_Symbol *sym; int offset; - sym = intern (namestring); - val = allocate_misc (); + sym = XSYMBOL (intern (namestring)); offset = (char *)address - (char *)current_buffer; - XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd; - XBUFFER_OBJFWD (val)->offset = offset; - XBUFFER_OBJFWD (val)->slottype = type; - SET_SYMBOL_VALUE (sym, val); - PER_BUFFER_SYMBOL (offset) = sym; + bo_fwd->type = Lisp_Fwd_Buffer_Obj; + bo_fwd->offset = offset; + bo_fwd->slottype = type; + sym->redirect = SYMBOL_FORWARDED; + { + /* I tried to do the job without a cast, but it seems impossible. + union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */ + SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd); + } + XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding === modified file 'src/buffer.h' --- src/buffer.h 2010-04-13 01:47:40 +0000 +++ src/buffer.h 2010-04-20 01:50:52 +0000 @@ -107,6 +107,11 @@ #define BUF_BEG(buf) (BEG) #define BUF_BEG_BYTE(buf) (BEG_BYTE) +/* !!!FIXME: all the BUF_BEGV/BUF_ZV/BUF_PT macros are flawed: + on indirect (or base) buffers, that value is only correct if that buffer + is the current_buffer, or if the buffer's text hasn't been modified (via + an indirect buffer) since it was last current. */ + /* Position of beginning of accessible range of buffer. */ #define BUF_BEGV(buf) ((buf)->begv) #define BUF_BEGV_BYTE(buf) ((buf)->begv_byte) @@ -313,7 +318,7 @@ - (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \ + BEG_BYTE) -/* Return character at position POS. */ +/* Return character at byte position POS. */ #define FETCH_CHAR(pos) \ (!NILP (current_buffer->enable_multibyte_characters) \ @@ -327,7 +332,7 @@ /* Variables used locally in FETCH_MULTIBYTE_CHAR. */ extern unsigned char *_fetch_multibyte_char_p; -/* Return character code of multi-byte form at position POS. If POS +/* Return character code of multi-byte form at byte position POS. If POS doesn't point the head of valid multi-byte form, only the byte at POS is returned. No range checking. */ @@ -336,7 +341,7 @@ + (pos) + BEG_ADDR - BEG_BYTE), \ STRING_CHAR (_fetch_multibyte_char_p)) -/* Return character at position POS. If the current buffer is unibyte +/* Return character at byte position POS. If the current buffer is unibyte and the character is not ASCII, make the returning character multibyte. */ @@ -447,7 +452,10 @@ /* The markers that refer to this buffer. This is actually a single marker --- successive elements in its marker `chain' - are the other markers referring to this buffer. */ + are the other markers referring to this buffer. + This is a singly linked unordered list, which means that it's + very cheap to add a marker to the list and it's also very cheap + to move a marker within a buffer. */ struct Lisp_Marker *markers; /* Usually 0. Temporarily set to 1 in decode_coding_gap to @@ -843,6 +851,7 @@ be a Lisp-level local variable for the slot, it has no default value, and the corresponding slot in buffer_defaults is not used. */ + extern struct buffer buffer_local_flags; /* For each buffer slot, this points to the Lisp symbol name @@ -948,7 +957,7 @@ from the start of a buffer structure. */ #define PER_BUFFER_VAR_OFFSET(VAR) \ - ((char *) &buffer_local_flags.VAR - (char *) &buffer_local_flags) + ((char *) &((struct buffer *)0)->VAR - (char *) ((struct buffer *)0)) /* Return the index of buffer-local variable VAR. Each per-buffer variable has an index > 0 associated with it, except when it always @@ -1013,11 +1022,5 @@ #define PER_BUFFER_VALUE(BUFFER, OFFSET) \ (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER))) -/* Return the symbol of the per-buffer variable at offset OFFSET in - the buffer structure. */ - -#define PER_BUFFER_SYMBOL(OFFSET) \ - (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols)) - /* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1 (do not change this comment) */ === modified file 'src/bytecode.c' --- src/bytecode.c 2010-03-05 23:08:18 +0000 +++ src/bytecode.c 2010-04-20 01:50:52 +0000 @@ -505,8 +505,9 @@ v1 = vectorp[op]; if (SYMBOLP (v1)) { - v2 = SYMBOL_VALUE (v1); - if (MISCP (v2) || EQ (v2, Qunbound)) + if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL + || (v2 = SYMBOL_VAL (XSYMBOL (v1)), + EQ (v2, Qunbound))) { BEFORE_POTENTIAL_GC (); v2 = Fsymbol_value (v1); @@ -597,10 +598,9 @@ /* Inline the most common case. */ if (SYMBOLP (sym) && !EQ (val, Qunbound) - && !XSYMBOL (sym)->indirect_variable - && !SYMBOL_CONSTANT_P (sym) - && !MISCP (XSYMBOL (sym)->value)) - XSYMBOL (sym)->value = val; + && !XSYMBOL (sym)->redirect + && !SYMBOL_CONSTANT_P (sym)) + XSYMBOL (sym)->val.value = val; else { BEFORE_POTENTIAL_GC (); === modified file 'src/character.h' --- src/character.h 2010-01-30 10:32:39 +0000 +++ src/character.h 2010-04-20 01:50:52 +0000 @@ -296,7 +296,7 @@ /* If P is after LIMIT, advance P to the previous character boundary. Assumes that P is already at a character boundary of the same - mulitbyte form whose beginning address is LIMIT. */ + multibyte form whose beginning address is LIMIT. */ #define PREV_CHAR_BOUNDARY(p, limit) \ do { \ === modified file 'src/coding.c' --- src/coding.c 2010-03-16 05:48:41 +0000 +++ src/coding.c 2010-04-20 01:50:52 +0000 @@ -6408,7 +6408,7 @@ { /* We didn't find an 8-bit code. We may have found a null-byte, but it's very - rare that a binary file confirm to + rare that a binary file conforms to ISO-2022. */ src = src_end; coding->head_ascii = src - coding->source; === modified file 'src/data.c' --- src/data.c 2010-03-22 19:51:59 +0000 +++ src/data.c 2010-04-20 01:50:52 +0000 @@ -91,7 +91,7 @@ Lisp_Object Qinteractive_form; -static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); +static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum; @@ -582,12 +582,35 @@ register Lisp_Object symbol; { Lisp_Object valcontents; + struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); - - valcontents = SYMBOL_VALUE (symbol); - - if (BUFFER_LOCAL_VALUEP (valcontents)) - valcontents = swap_in_symval_forwarding (symbol, valcontents); + sym = XSYMBOL (symbol); + + start: + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + if (blv->fwd) + /* In set_internal, we un-forward vars when their value is + set to Qunbound. */ + return Qt; + else + { + swap_in_symval_forwarding (sym, blv); + valcontents = BLV_VALUE (blv); + } + break; + } + case SYMBOL_FORWARDED: + /* In set_internal, we un-forward vars when their value is + set to Qunbound. */ + return Qt; + default: abort (); + } return (EQ (valcontents, Qunbound) ? Qnil : Qt); } @@ -824,14 +847,14 @@ hare = tortoise = symbol; - while (hare->indirect_variable) + while (hare->redirect == SYMBOL_VARALIAS) { - hare = XSYMBOL (hare->value); - if (!hare->indirect_variable) + hare = SYMBOL_ALIAS (hare); + if (hare->redirect != SYMBOL_VARALIAS) break; - hare = XSYMBOL (hare->value); - tortoise = XSYMBOL (tortoise->value); + hare = SYMBOL_ALIAS (hare); + tortoise = SYMBOL_ALIAS (tortoise); if (hare == tortoise) { @@ -865,44 +888,46 @@ This does not handle buffer-local variables; use swap_in_symval_forwarding for that. */ +#define do_blv_forwarding(blv) \ + ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv)) + Lisp_Object do_symval_forwarding (valcontents) - register Lisp_Object valcontents; + register union Lisp_Fwd *valcontents; { register Lisp_Object val; - if (MISCP (valcontents)) - switch (XMISCTYPE (valcontents)) - { - case Lisp_Misc_Intfwd: - XSETINT (val, *XINTFWD (valcontents)->intvar); - return val; - - case Lisp_Misc_Boolfwd: - return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); - - case Lisp_Misc_Objfwd: - return *XOBJFWD (valcontents)->objvar; - - case Lisp_Misc_Buffer_Objfwd: - return PER_BUFFER_VALUE (current_buffer, - XBUFFER_OBJFWD (valcontents)->offset); - - case Lisp_Misc_Kboard_Objfwd: - /* We used to simply use current_kboard here, but from Lisp - code, it's value is often unexpected. It seems nicer to - allow constructions like this to work as intuitively expected: - - (with-selected-frame frame - (define-key local-function-map "\eOP" [f1])) - - On the other hand, this affects the semantics of - last-command and real-last-command, and people may rely on - that. I took a quick look at the Lisp codebase, and I - don't think anything will break. --lorentey */ - return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset - + (char *)FRAME_KBOARD (SELECTED_FRAME ())); - } - return valcontents; + switch (XFWDTYPE (valcontents)) + { + case Lisp_Fwd_Int: + XSETINT (val, *XINTFWD (valcontents)->intvar); + return val; + + case Lisp_Fwd_Bool: + return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); + + case Lisp_Fwd_Obj: + return *XOBJFWD (valcontents)->objvar; + + case Lisp_Fwd_Buffer_Obj: + return PER_BUFFER_VALUE (current_buffer, + XBUFFER_OBJFWD (valcontents)->offset); + + case Lisp_Fwd_Kboard_Obj: + /* We used to simply use current_kboard here, but from Lisp + code, it's value is often unexpected. It seems nicer to + allow constructions like this to work as intuitively expected: + + (with-selected-frame frame + (define-key local-function-map "\eOP" [f1])) + + On the other hand, this affects the semantics of + last-command and real-last-command, and people may rely on + that. I took a quick look at the Lisp codebase, and I + don't think anything will break. --lorentey */ + return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset + + (char *)FRAME_KBOARD (SELECTED_FRAME ())); + default: abort (); + } } /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell @@ -913,102 +938,93 @@ BUF non-zero means set the value in buffer BUF instead of the current buffer. This only plays a role for per-buffer variables. */ -void -store_symval_forwarding (symbol, valcontents, newval, buf) - Lisp_Object symbol; - register Lisp_Object valcontents, newval; +#define store_blv_forwarding(blv, newval, buf) \ + do { \ + if ((blv)->forwarded) \ + store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \ + else \ + SET_BLV_VALUE (blv, newval); \ + } while (0) + +static void +store_symval_forwarding (/* symbol, */ valcontents, newval, buf) + /* struct Lisp_Symbol *symbol; */ + union Lisp_Fwd *valcontents; + register Lisp_Object newval; struct buffer *buf; { - switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) + switch (XFWDTYPE (valcontents)) { - case Lisp_Misc: - switch (XMISCTYPE (valcontents)) + case Lisp_Fwd_Int: + CHECK_NUMBER (newval); + *XINTFWD (valcontents)->intvar = XINT (newval); + break; + + case Lisp_Fwd_Bool: + *XBOOLFWD (valcontents)->boolvar = !NILP (newval); + break; + + case Lisp_Fwd_Obj: + *XOBJFWD (valcontents)->objvar = newval; + + /* If this variable is a default for something stored + in the buffer itself, such as default-fill-column, + find the buffers that don't have local values for it + and update them. */ + if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults + && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1)) { - case Lisp_Misc_Intfwd: - CHECK_NUMBER (newval); - *XINTFWD (valcontents)->intvar = XINT (newval); - /* This can never happen since intvar points to an EMACS_INT - which is at least large enough to hold a Lisp_Object. - if (*XINTFWD (valcontents)->intvar != XINT (newval)) - error ("Value out of range for variable `%s'", - SDATA (SYMBOL_NAME (symbol))); */ - break; - - case Lisp_Misc_Boolfwd: - *XBOOLFWD (valcontents)->boolvar = !NILP (newval); - break; - - case Lisp_Misc_Objfwd: - *XOBJFWD (valcontents)->objvar = newval; - - /* If this variable is a default for something stored - in the buffer itself, such as default-fill-column, - find the buffers that don't have local values for it - and update them. */ - if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults - && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1)) + int offset = ((char *) XOBJFWD (valcontents)->objvar + - (char *) &buffer_defaults); + int idx = PER_BUFFER_IDX (offset); + + Lisp_Object tail; + + if (idx <= 0) + break; + + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { - int offset = ((char *) XOBJFWD (valcontents)->objvar - - (char *) &buffer_defaults); - int idx = PER_BUFFER_IDX (offset); - - Lisp_Object tail; - - if (idx <= 0) - break; - - for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object buf; - struct buffer *b; - - buf = Fcdr (XCAR (tail)); - if (!BUFFERP (buf)) continue; - b = XBUFFER (buf); - - if (! PER_BUFFER_VALUE_P (b, idx)) - PER_BUFFER_VALUE (b, offset) = newval; - } + Lisp_Object buf; + struct buffer *b; + + buf = Fcdr (XCAR (tail)); + if (!BUFFERP (buf)) continue; + b = XBUFFER (buf); + + if (! PER_BUFFER_VALUE_P (b, idx)) + PER_BUFFER_VALUE (b, offset) = newval; } - break; - - case Lisp_Misc_Buffer_Objfwd: - { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; - - if (!(NILP (type) || NILP (newval) - || (XINT (type) == LISP_INT_TAG - ? INTEGERP (newval) - : XTYPE (newval) == XINT (type)))) - buffer_slot_type_mismatch (newval, XINT (type)); - - if (buf == NULL) - buf = current_buffer; - PER_BUFFER_VALUE (buf, offset) = newval; - } - break; - - case Lisp_Misc_Kboard_Objfwd: - { - char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ()); - char *p = base + XKBOARD_OBJFWD (valcontents)->offset; - *(Lisp_Object *) p = newval; - } - break; - - default: - goto def; } break; + case Lisp_Fwd_Buffer_Obj: + { + int offset = XBUFFER_OBJFWD (valcontents)->offset; + Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; + + if (!(NILP (type) || NILP (newval) + || (XINT (type) == LISP_INT_TAG + ? INTEGERP (newval) + : XTYPE (newval) == XINT (type)))) + buffer_slot_type_mismatch (newval, XINT (type)); + + if (buf == NULL) + buf = current_buffer; + PER_BUFFER_VALUE (buf, offset) = newval; + } + break; + + case Lisp_Fwd_Kboard_Obj: + { + char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ()); + char *p = base + XKBOARD_OBJFWD (valcontents)->offset; + *(Lisp_Object *) p = newval; + } + break; + default: - def: - valcontents = SYMBOL_VALUE (symbol); - if (BUFFER_LOCAL_VALUEP (valcontents)) - XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval; - else - SET_SYMBOL_VALUE (symbol, newval); + abort (); /* goto def; */ } } @@ -1017,25 +1033,22 @@ void swap_in_global_binding (symbol) - Lisp_Object symbol; + struct Lisp_Symbol *symbol; { - Lisp_Object valcontents = SYMBOL_VALUE (symbol); - struct Lisp_Buffer_Local_Value *blv = XBUFFER_LOCAL_VALUE (valcontents); - Lisp_Object cdr = blv->cdr; + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol); /* Unload the previously loaded binding. */ - Fsetcdr (XCAR (cdr), - do_symval_forwarding (blv->realvalue)); + if (blv->fwd) + SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); /* Select the global binding in the symbol. */ - XSETCAR (cdr, cdr); - store_symval_forwarding (symbol, blv->realvalue, XCDR (cdr), NULL); + blv->valcell = blv->defcell; + if (blv->fwd) + store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL); /* Indicate that the global binding is set up now. */ - blv->frame = Qnil; - blv->buffer = Qnil; - blv->found_for_frame = 0; - blv->found_for_buffer = 0; + blv->where = Qnil; + SET_BLV_FOUND (blv, 0); } /* Set up the buffer-local symbol SYMBOL for validity in the current buffer. @@ -1045,55 +1058,50 @@ Return the value forwarded one step past the buffer-local stage. This could be another forwarding pointer. */ -static Lisp_Object -swap_in_symval_forwarding (symbol, valcontents) - Lisp_Object symbol, valcontents; +static void +swap_in_symval_forwarding (symbol, blv) + struct Lisp_Symbol *symbol; + struct Lisp_Buffer_Local_Value *blv; { register Lisp_Object tem1; - tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; + eassert (blv == SYMBOL_BLV (symbol)); + + tem1 = blv->where; if (NILP (tem1) - || current_buffer != XBUFFER (tem1) - || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame - && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))) + || (blv->frame_local + ? !EQ (selected_frame, tem1) + : current_buffer != XBUFFER (tem1))) { - struct Lisp_Symbol *sym = XSYMBOL (symbol); - if (sym->indirect_variable) - { - sym = indirect_variable (sym); - XSETSYMBOL (symbol, sym); - } /* Unload the previously loaded binding. */ - tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - Fsetcdr (tem1, - do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); + tem1 = blv->valcell; + if (blv->fwd) + SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ - tem1 = assq_no_quit (symbol, current_buffer->local_var_alist); - XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; - if (NILP (tem1)) - { - if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) - tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist); - if (! NILP (tem1)) - XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1; - else - tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr; - } - else - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; + { + Lisp_Object var; + XSETSYMBOL (var, symbol); + if (blv->frame_local) + { + tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist); + blv->where = selected_frame; + } + else + { + tem1 = assq_no_quit (var, current_buffer->local_var_alist); + XSETBUFFER (blv->where, current_buffer); + } + } + if (!(blv->found = !NILP (tem1))) + tem1 = blv->defcell; /* Load the new binding. */ - XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1); - XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer); - XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; - store_symval_forwarding (symbol, - XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - Fcdr (tem1), NULL); + blv->valcell = tem1; + if (blv->fwd) + store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL); } - return XBUFFER_LOCAL_VALUE (valcontents)->realvalue; } /* Find the value of a symbol, returning Qunbound if it's not bound. @@ -1106,16 +1114,27 @@ find_symbol_value (symbol) Lisp_Object symbol; { - register Lisp_Object valcontents; - register Lisp_Object val; + struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); - valcontents = SYMBOL_VALUE (symbol); - - if (BUFFER_LOCAL_VALUEP (valcontents)) - valcontents = swap_in_symval_forwarding (symbol, valcontents); - - return do_symval_forwarding (valcontents); + sym = XSYMBOL (symbol); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + swap_in_symval_forwarding (sym, blv); + return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv); + } + /* FALLTHROUGH */ + case SYMBOL_FORWARDED: + return do_symval_forwarding (SYMBOL_FWD (sym)); + default: abort (); + } } DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, @@ -1137,26 +1156,25 @@ (symbol, newval) register Lisp_Object symbol, newval; { - return set_internal (symbol, newval, current_buffer, 0); + set_internal (symbol, newval, current_buffer, 0); + return newval; } /* Return 1 if SYMBOL currently has a let-binding which was made in the buffer that is now current. */ static int -let_shadows_buffer_binding_p (symbol) - struct Lisp_Symbol *symbol; +let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) { - volatile struct specbinding *p; + struct specbinding *p; for (p = specpdl_ptr - 1; p >= specpdl; p--) if (p->func == NULL && CONSP (p->symbol)) { struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); - if ((symbol == let_bound_symbol - || (let_bound_symbol->indirect_variable - && symbol == indirect_variable (let_bound_symbol))) + eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); + if (symbol == let_bound_symbol && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) break; } @@ -1164,6 +1182,19 @@ return p >= specpdl; } +static int +let_shadows_global_binding_p (symbol) + Lisp_Object symbol; +{ + struct specbinding *p; + + for (p = specpdl_ptr - 1; p >= specpdl; p--) + if (p->func == NULL && EQ (p->symbol, symbol)) + break; + + return p >= specpdl; +} + /* Store the value NEWVAL into SYMBOL. If buffer-locality is an issue, BUF specifies which buffer to use. (0 stands for the current buffer.) @@ -1172,133 +1203,155 @@ local in every buffer where it is set, then we make it local. If BINDFLAG is nonzero, we don't do that. */ -Lisp_Object +void set_internal (symbol, newval, buf, bindflag) register Lisp_Object symbol, newval; struct buffer *buf; int bindflag; { int voide = EQ (newval, Qunbound); - - register Lisp_Object valcontents, innercontents, tem1, current_alist_element; + struct Lisp_Symbol *sym; + Lisp_Object tem1; if (buf == 0) buf = current_buffer; /* If restoring in a dead buffer, do nothing. */ if (NILP (buf->name)) - return newval; + return; CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol) - && (NILP (Fkeywordp (symbol)) - || !EQ (newval, SYMBOL_VALUE (symbol)))) - xsignal1 (Qsetting_constant, symbol); - - innercontents = valcontents = SYMBOL_VALUE (symbol); - - if (BUFFER_OBJFWDP (valcontents)) + if (SYMBOL_CONSTANT_P (symbol)) { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - int idx = PER_BUFFER_IDX (offset); - if (idx > 0 - && !bindflag - && !let_shadows_buffer_binding_p (XSYMBOL (symbol))) - SET_PER_BUFFER_VALUE_P (buf, idx, 1); + if (NILP (Fkeywordp (symbol)) + || !EQ (newval, Fsymbol_value (symbol))) + xsignal1 (Qsetting_constant, symbol); + else + /* Allow setting keywords to their own value. */ + return; } - else if (BUFFER_LOCAL_VALUEP (valcontents)) + + sym = XSYMBOL (symbol); + + start: + switch (sym->redirect) { - /* valcontents is a struct Lisp_Buffer_Local_Value. */ - if (XSYMBOL (symbol)->indirect_variable) - XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol))); - - /* What binding is loaded right now? */ - current_alist_element - = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - - /* If the current buffer is not the buffer whose binding is - loaded, or if there may be frame-local bindings and the frame - isn't the right one, or if it's a Lisp_Buffer_Local_Value and - the default binding is loaded, the loaded binding may be the - wrong one. */ - if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer) - || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer) - || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame - && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)) - /* Also unload a global binding (if the var is local_if_set). */ - || (EQ (XCAR (current_alist_element), - current_alist_element))) - { - /* The currently loaded binding is not necessarily valid. - We need to unload it, and choose a new binding. */ - - /* Write out `realvalue' to the old loaded binding. */ - Fsetcdr (current_alist_element, - do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); - - /* Find the new binding. */ - tem1 = Fassq (symbol, buf->local_var_alist); - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; - XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; - - if (NILP (tem1)) + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + Lisp_Object tmp; XSETBUFFER (tmp, buf); + + /* If the current buffer is not the buffer whose binding is + loaded, or if there may be frame-local bindings and the frame + isn't the right one, or if it's a Lisp_Buffer_Local_Value and + the default binding is loaded, the loaded binding may be the + wrong one. */ + if (!EQ (blv->where, + blv->frame_local ? selected_frame : tmp) + /* Also unload a global binding (if the var is local_if_set). */ + || (EQ (blv->valcell, blv->defcell))) + { + /* The currently loaded binding is not necessarily valid. + We need to unload it, and choose a new binding. */ + + /* Write out `realvalue' to the old loaded binding. */ + if (blv->fwd) + SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); + + /* Find the new binding. */ { - /* This buffer still sees the default value. */ - - /* If the variable is not local_if_set, - or if this is `let' rather than `set', - make CURRENT-ALIST-ELEMENT point to itself, - indicating that we're seeing the default value. - Likewise if the variable has been let-bound - in the current buffer. */ - if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set - || let_shadows_buffer_binding_p (XSYMBOL (symbol))) + XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ + if (blv->frame_local) { - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; - - if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) - tem1 = Fassq (symbol, - XFRAME (selected_frame)->param_alist); - - if (! NILP (tem1)) - XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1; - else - tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr; + tem1 = Fassq (symbol, XFRAME (selected_frame)->param_alist); + blv->where = selected_frame; } - /* If it's a Lisp_Buffer_Local_Value, being set not bound, - and we're not within a let that was made for this buffer, - create a new buffer-local binding for the variable. - That means, give this buffer a new assoc for a local value - and load that binding. */ else { - tem1 = Fcons (symbol, XCDR (current_alist_element)); - buf->local_var_alist - = Fcons (tem1, buf->local_var_alist); + tem1 = Fassq (symbol, buf->local_var_alist); + blv->where = tmp; } } - - /* Record which binding is now loaded. */ - XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1); - - /* Set `buffer' and `frame' slots for the binding now loaded. */ - XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf); - XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; - } - innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue; - - /* Store the new value in the cons-cell. */ - XSETCDR (XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr), newval); + blv->found = 1; + + if (NILP (tem1)) + { + /* This buffer still sees the default value. */ + + /* If the variable is a Lisp_Some_Buffer_Local_Value, + or if this is `let' rather than `set', + make CURRENT-ALIST-ELEMENT point to itself, + indicating that we're seeing the default value. + Likewise if the variable has been let-bound + in the current buffer. */ + if (bindflag || !blv->local_if_set + || let_shadows_buffer_binding_p (sym)) + { + blv->found = 0; + tem1 = blv->defcell; + } + /* If it's a local_if_set, being set not bound, + and we're not within a let that was made for this buffer, + create a new buffer-local binding for the variable. + That means, give this buffer a new assoc for a local value + and load that binding. */ + else + { + /* local_if_set is only supported for buffer-local + bindings, not for frame-local bindings. */ + eassert (!blv->frame_local); + tem1 = Fcons (symbol, XCDR (blv->defcell)); + buf->local_var_alist + = Fcons (tem1, buf->local_var_alist); + } + } + + /* Record which binding is now loaded. */ + blv->valcell = tem1; + } + + /* Store the new value in the cons cell. */ + SET_BLV_VALUE (blv, newval); + + if (blv->fwd) + { + if (voide) + /* If storing void (making the symbol void), forward only through + buffer-local indicator, not through Lisp_Objfwd, etc. */ + blv->fwd = NULL; + else + store_symval_forwarding (blv->fwd, newval, buf); + } + break; + } + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *innercontents = SYMBOL_FWD (sym); + if (BUFFER_OBJFWDP (innercontents)) + { + int offset = XBUFFER_OBJFWD (innercontents)->offset; + int idx = PER_BUFFER_IDX (offset); + if (idx > 0 + && !bindflag + && !let_shadows_buffer_binding_p (sym)) + SET_PER_BUFFER_VALUE_P (buf, idx, 1); + } + + if (voide) + { /* If storing void (making the symbol void), forward only through + buffer-local indicator, not through Lisp_Objfwd, etc. */ + sym->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (sym, newval); + } + else + store_symval_forwarding (/* sym, */ innercontents, newval, buf); + break; + } + default: abort (); } - - /* If storing void (making the symbol void), forward only through - buffer-local indicator, not through Lisp_Objfwd, etc. */ - if (voide) - store_symval_forwarding (symbol, Qnil, newval, buf); - else - store_symval_forwarding (symbol, innercontents, newval, buf); - - return newval; + return; } /* Access or set a buffer-local symbol's default value. */ @@ -1310,38 +1363,46 @@ default_value (symbol) Lisp_Object symbol; { - register Lisp_Object valcontents; + struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); - valcontents = SYMBOL_VALUE (symbol); - - /* For a built-in buffer-local variable, get the default value - rather than letting do_symval_forwarding get the current value. */ - if (BUFFER_OBJFWDP (valcontents)) - { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - if (PER_BUFFER_IDX (offset) != 0) - return PER_BUFFER_DEFAULT (offset); - } - - /* Handle user-created local variables. */ - if (BUFFER_LOCAL_VALUEP (valcontents)) - { - /* If var is set up for a buffer that lacks a local value for it, - the current value is nominally the default value. - But the `realvalue' slot may be more up to date, since - ordinary setq stores just that slot. So use that. */ - Lisp_Object current_alist_element, alist_element_car; - current_alist_element - = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - alist_element_car = XCAR (current_alist_element); - if (EQ (alist_element_car, current_alist_element)) - return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue); - else - return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - } - /* For other variables, get the current value. */ - return do_symval_forwarding (valcontents); + sym = XSYMBOL (symbol); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); + case SYMBOL_LOCALIZED: + { + /* If var is set up for a buffer that lacks a local value for it, + the current value is nominally the default value. + But the `realvalue' slot may be more up to date, since + ordinary setq stores just that slot. So use that. */ + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + if (blv->fwd && EQ (blv->valcell, blv->defcell)) + return do_symval_forwarding (blv->fwd); + else + return XCDR (blv->defcell); + } + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); + + /* For a built-in buffer-local variable, get the default value + rather than letting do_symval_forwarding get the current value. */ + if (BUFFER_OBJFWDP (valcontents)) + { + int offset = XBUFFER_OBJFWD (valcontents)->offset; + if (PER_BUFFER_IDX (offset) != 0) + return PER_BUFFER_DEFAULT (offset); + } + + /* For other variables, get the current value. */ + return do_symval_forwarding (valcontents); + } + default: abort (); + } } DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0, @@ -1381,50 +1442,68 @@ (symbol, value) Lisp_Object symbol, value; { - register Lisp_Object valcontents, current_alist_element, alist_element_buffer; + struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); - valcontents = SYMBOL_VALUE (symbol); - - /* Handle variables like case-fold-search that have special slots - in the buffer. Make them work apparently like Lisp_Buffer_Local_Value - variables. */ - if (BUFFER_OBJFWDP (valcontents)) - { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - int idx = PER_BUFFER_IDX (offset); - - PER_BUFFER_DEFAULT (offset) = value; - - /* If this variable is not always local in all buffers, - set it in the buffers that don't nominally have a local value. */ - if (idx > 0) - { - struct buffer *b; - - for (b = all_buffers; b; b = b->next) - if (!PER_BUFFER_VALUE_P (b, idx)) - PER_BUFFER_VALUE (b, offset) = value; - } - return value; - } - - if (!BUFFER_LOCAL_VALUEP (valcontents)) - return Fset (symbol, value); - - /* Store new value into the DEFAULT-VALUE slot. */ - XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value); - - /* If the default binding is now loaded, set the REALVALUE slot too. */ - current_alist_element - = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); - alist_element_buffer = Fcar (current_alist_element); - if (EQ (alist_element_buffer, current_alist_element)) - store_symval_forwarding (symbol, - XBUFFER_LOCAL_VALUE (valcontents)->realvalue, - value, NULL); - - return value; + if (SYMBOL_CONSTANT_P (symbol)) + { + if (NILP (Fkeywordp (symbol)) + || !EQ (value, Fdefault_value (symbol))) + xsignal1 (Qsetting_constant, symbol); + else + /* Allow setting keywords to their own value. */ + return value; + } + sym = XSYMBOL (symbol); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return Fset (symbol, value); + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + + /* Store new value into the DEFAULT-VALUE slot. */ + XSETCDR (blv->defcell, value); + + /* If the default binding is now loaded, set the REALVALUE slot too. */ + if (blv->fwd && EQ (blv->defcell, blv->valcell)) + store_symval_forwarding (blv->fwd, value, NULL); + return value; + } + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); + + /* Handle variables like case-fold-search that have special slots + in the buffer. + Make them work apparently like Lisp_Buffer_Local_Value variables. */ + if (BUFFER_OBJFWDP (valcontents)) + { + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); + + PER_BUFFER_DEFAULT (offset) = value; + + /* If this variable is not always local in all buffers, + set it in the buffers that don't nominally have a local value. */ + if (idx > 0) + { + struct buffer *b; + + for (b = all_buffers; b; b = b->next) + if (!PER_BUFFER_VALUE_P (b, idx)) + PER_BUFFER_VALUE (b, offset) = value; + } + return value; + } + else + return Fset (symbol, value); + } + default: abort (); + } } DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0, @@ -1468,6 +1547,35 @@ /* Lisp functions for creating and removing buffer-local variables. */ +union Lisp_Val_Fwd + { + Lisp_Object value; + union Lisp_Fwd *fwd; + }; + +static struct Lisp_Buffer_Local_Value * +make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents) +{ + struct Lisp_Buffer_Local_Value *blv + = xmalloc (sizeof (struct Lisp_Buffer_Local_Value)); + Lisp_Object symbol; XSETSYMBOL (symbol, sym); + Lisp_Object tem = Fcons (symbol, (forwarded + ? do_symval_forwarding (valcontents.fwd) + : valcontents.value)); + /* Buffer_Local_Values cannot have as realval a buffer-local + or keyboard-local forwarding. */ + eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd))); + eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd))); + blv->fwd = forwarded ? valcontents.fwd : NULL; + blv->where = Qnil; + blv->frame_local = 0; + blv->local_if_set = 0; + blv->defcell = tem; + blv->valcell = tem; + SET_BLV_FOUND (blv, 0); + return blv; +} + DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", doc: /* Make VARIABLE become buffer-local whenever it is set. @@ -1485,42 +1593,58 @@ (variable) register Lisp_Object variable; { - register Lisp_Object tem, valcontents, newval; struct Lisp_Symbol *sym; + struct Lisp_Buffer_Local_Value *blv = NULL; + union Lisp_Val_Fwd valcontents; + int forwarded; CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - - valcontents = sym->value; - if (sym->constant || KBOARD_OBJFWDP (valcontents)) - error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); - - if (BUFFER_OBJFWDP (valcontents)) - return variable; - else if (BUFFER_LOCAL_VALUEP (valcontents)) - { - if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) - error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); - newval = valcontents; - } - else - { - if (EQ (valcontents, Qunbound)) - sym->value = Qnil; - tem = Fcons (Qnil, Fsymbol_value (variable)); - XSETCAR (tem, tem); - newval = allocate_misc (); - XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; - XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer (); - XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; - XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; - XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; - XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; - XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - sym->value = newval; - } - XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1; + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: + forwarded = 0; valcontents.value = SYMBOL_VAL (sym); + if (EQ (valcontents.value, Qunbound)) + valcontents.value = Qnil; + break; + case SYMBOL_LOCALIZED: + blv = SYMBOL_BLV (sym); + if (blv->frame_local) + error ("Symbol %s may not be buffer-local", + SDATA (SYMBOL_NAME (variable))); + break; + case SYMBOL_FORWARDED: + forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym); + if (KBOARD_OBJFWDP (valcontents.fwd)) + error ("Symbol %s may not be buffer-local", + SDATA (SYMBOL_NAME (variable))); + else if (BUFFER_OBJFWDP (valcontents.fwd)) + return variable; + break; + default: abort (); + } + + if (sym->constant) + error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); + + if (!blv) + { + blv = make_blv (sym, forwarded, valcontents); + sym->redirect = SYMBOL_LOCALIZED; + SET_SYMBOL_BLV (sym, blv); + { + Lisp_Object symbol; + XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */ + if (let_shadows_global_binding_p (symbol)) + error ("Making %s buffer-local while let-bound!", + SDATA (SYMBOL_NAME (variable))); + } + } + + blv->local_if_set = 1; return variable; } @@ -1547,82 +1671,95 @@ (variable) register Lisp_Object variable; { - register Lisp_Object tem, valcontents; + register Lisp_Object tem; + int forwarded; + union Lisp_Val_Fwd valcontents; struct Lisp_Symbol *sym; + struct Lisp_Buffer_Local_Value *blv = NULL; CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - - valcontents = sym->value; - if (sym->constant || KBOARD_OBJFWDP (valcontents) - || (BUFFER_LOCAL_VALUEP (valcontents) - && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame))) - error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); - - if ((BUFFER_LOCAL_VALUEP (valcontents) - && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set) - || BUFFER_OBJFWDP (valcontents)) + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: + forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break; + case SYMBOL_LOCALIZED: + blv = SYMBOL_BLV (sym); + if (blv->frame_local) + error ("Symbol %s may not be buffer-local", + SDATA (SYMBOL_NAME (variable))); + break; + case SYMBOL_FORWARDED: + forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym); + if (KBOARD_OBJFWDP (valcontents.fwd)) + error ("Symbol %s may not be buffer-local", + SDATA (SYMBOL_NAME (variable))); + break; + default: abort (); + } + + if (sym->constant) + error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); + + if (blv ? blv->local_if_set + : (forwarded && BUFFER_OBJFWDP (valcontents.fwd))) { tem = Fboundp (variable); - /* Make sure the symbol has a local value in this particular buffer, by setting it to the same value it already has. */ Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound)); return variable; } - /* Make sure symbol is set up to hold per-buffer values. */ - if (!BUFFER_LOCAL_VALUEP (valcontents)) + if (!blv) { - Lisp_Object newval; - tem = Fcons (Qnil, do_symval_forwarding (valcontents)); - XSETCAR (tem, tem); - newval = allocate_misc (); - XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; - XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; - XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; - XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0; - XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; - XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; - XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; - XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - sym->value = newval; + blv = make_blv (sym, forwarded, valcontents); + sym->redirect = SYMBOL_LOCALIZED; + SET_SYMBOL_BLV (sym, blv); + { + Lisp_Object symbol; + XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */ + if (let_shadows_global_binding_p (symbol)) + error ("Making %s local to %s while let-bound!", + SDATA (SYMBOL_NAME (variable)), SDATA (current_buffer->name)); + } } + /* Make sure this buffer has its own value of symbol. */ - XSETSYMBOL (variable, sym); /* Propagate variable indirections. */ + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ tem = Fassq (variable, current_buffer->local_var_alist); if (NILP (tem)) { + if (let_shadows_buffer_binding_p (sym)) + message ("Making %s buffer-local while locally let-bound!", + SDATA (SYMBOL_NAME (variable))); + /* Swap out any local binding for some other buffer, and make sure the current value is permanently recorded, if it's the default value. */ find_symbol_value (variable); current_buffer->local_var_alist - = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (sym->value)->cdr)), + = Fcons (Fcons (variable, XCDR (blv->defcell)), current_buffer->local_var_alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value. */ - { - Lisp_Object *pvalbuf; - - valcontents = sym->value; - - pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; - if (current_buffer == XBUFFER (*pvalbuf)) - *pvalbuf = Qnil; - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; - } + if (current_buffer == XBUFFER (blv->where)) + blv->where = Qnil; + /* blv->valcell = blv->defcell; + * SET_BLV_FOUND (blv, 0); */ + blv->found = 0; } /* If the symbol forwards into a C variable, then load the binding for this buffer now. If C code modifies the variable before we load the binding in, then that new value will clobber the default binding the next time we unload it. */ - valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue; - if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents)) - swap_in_symval_forwarding (variable, sym->value); + if (blv->fwd) + swap_in_symval_forwarding (sym, blv); return variable; } @@ -1634,31 +1771,43 @@ (variable) register Lisp_Object variable; { - register Lisp_Object tem, valcontents; + register Lisp_Object tem; + struct Lisp_Buffer_Local_Value *blv; struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - - valcontents = sym->value; - - if (BUFFER_OBJFWDP (valcontents)) + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - int idx = PER_BUFFER_IDX (offset); + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return variable; + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); + if (BUFFER_OBJFWDP (valcontents)) + { + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); - if (idx > 0) - { - SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); - PER_BUFFER_VALUE (current_buffer, offset) - = PER_BUFFER_DEFAULT (offset); - } - return variable; + if (idx > 0) + { + SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); + PER_BUFFER_VALUE (current_buffer, offset) + = PER_BUFFER_DEFAULT (offset); + } + } + return variable; + } + case SYMBOL_LOCALIZED: + blv = SYMBOL_BLV (sym); + if (blv->frame_local) + return variable; + break; + default: abort (); } - if (!BUFFER_LOCAL_VALUEP (valcontents)) - return variable; - /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = Fassq (variable, current_buffer->local_var_alist); @@ -1670,14 +1819,13 @@ loaded, recompute its value. We have to do it now, or else forwarded objects won't work right. */ { - Lisp_Object *pvalbuf, buf; - valcontents = sym->value; - pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; - XSETBUFFER (buf, current_buffer); - if (EQ (buf, *pvalbuf)) + Lisp_Object buf; XSETBUFFER (buf, current_buffer); + if (EQ (buf, blv->where)) { - *pvalbuf = Qnil; - XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; + blv->where = Qnil; + /* blv->valcell = blv->defcell; + * SET_BLV_FOUND (blv, 0); */ + blv->found = 0; find_symbol_value (variable); } } @@ -1712,39 +1860,45 @@ (variable) register Lisp_Object variable; { - register Lisp_Object tem, valcontents, newval; + int forwarded; + union Lisp_Val_Fwd valcontents; struct Lisp_Symbol *sym; + struct Lisp_Buffer_Local_Value *blv = NULL; CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - - valcontents = sym->value; - if (sym->constant || KBOARD_OBJFWDP (valcontents) - || BUFFER_OBJFWDP (valcontents)) - error ("Symbol %s may not be frame-local", SDATA (sym->xname)); - - if (BUFFER_LOCAL_VALUEP (valcontents)) + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) { - if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame) - error ("Symbol %s may not be frame-local", SDATA (sym->xname)); - return variable; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: + forwarded = 0; valcontents.value = SYMBOL_VAL (sym); + if (EQ (valcontents.value, Qunbound)) + valcontents.value = Qnil; + break; + case SYMBOL_LOCALIZED: + if (SYMBOL_BLV (sym)->frame_local) + return variable; + else + error ("Symbol %s may not be frame-local", + SDATA (SYMBOL_NAME (variable))); + case SYMBOL_FORWARDED: + forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym); + if (KBOARD_OBJFWDP (valcontents.fwd) || BUFFER_OBJFWDP (valcontents.fwd)) + error ("Symbol %s may not be frame-local", + SDATA (SYMBOL_NAME (variable))); + break; + default: abort (); } - if (EQ (valcontents, Qunbound)) - sym->value = Qnil; - tem = Fcons (Qnil, Fsymbol_value (variable)); - XSETCAR (tem, tem); - newval = allocate_misc (); - XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; - XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; - XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; - XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0; - XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; - XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; - XBUFFER_LOCAL_VALUE (newval)->check_frame = 1; - XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - sym->value = newval; + if (sym->constant) + error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); + + blv = make_blv (sym, forwarded, valcontents); + blv->frame_local = 1; + sym->redirect = SYMBOL_LOCALIZED; + SET_SYMBOL_BLV (sym, blv); return variable; } @@ -1755,7 +1909,6 @@ (variable, buffer) register Lisp_Object variable, buffer; { - Lisp_Object valcontents; register struct buffer *buf; struct Lisp_Symbol *sym; @@ -1768,29 +1921,46 @@ } CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - XSETSYMBOL (variable, sym); - - valcontents = sym->value; - if (BUFFER_LOCAL_VALUEP (valcontents)) - { - Lisp_Object tail, elt; - - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) - { - elt = XCAR (tail); - if (EQ (variable, XCAR (elt))) - return Qt; - } - } - if (BUFFER_OBJFWDP (valcontents)) - { - int offset = XBUFFER_OBJFWD (valcontents)->offset; - int idx = PER_BUFFER_IDX (offset); - if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) - return Qt; - } - return Qnil; + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return Qnil; + case SYMBOL_LOCALIZED: + { + Lisp_Object tail, elt, tmp; + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + XSETBUFFER (tmp, buf); + + for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + if (EQ (variable, XCAR (elt))) + { + eassert (!blv->frame_local); + eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp)); + return Qt; + } + } + eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp)); + return Qnil; + } + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); + if (BUFFER_OBJFWDP (valcontents)) + { + int offset = XBUFFER_OBJFWD (valcontents)->offset; + int idx = PER_BUFFER_IDX (offset); + if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) + return Qt; + } + return Qnil; + } + default: abort (); + } } DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, @@ -1804,40 +1974,29 @@ (variable, buffer) register Lisp_Object variable, buffer; { - Lisp_Object valcontents; - register struct buffer *buf; struct Lisp_Symbol *sym; - if (NILP (buffer)) - buf = current_buffer; - else - { - CHECK_BUFFER (buffer); - buf = XBUFFER (buffer); - } - CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); - XSETSYMBOL (variable, sym); - - valcontents = sym->value; - - if (BUFFER_OBJFWDP (valcontents)) - /* All these slots become local if they are set. */ - return Qt; - else if (BUFFER_LOCAL_VALUEP (valcontents)) + sym = XSYMBOL (variable); + + start: + switch (sym->redirect) { - Lisp_Object tail, elt; - if (XBUFFER_LOCAL_VALUE (valcontents)->local_if_set) - return Qt; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) - { - elt = XCAR (tail); - if (EQ (variable, XCAR (elt))) - return Qt; - } + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return Qnil; + case SYMBOL_LOCALIZED: + { + struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + if (blv->local_if_set) + return Qt; + XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + return Flocal_variable_p (variable, buffer); + } + case SYMBOL_FORWARDED: + /* All BUFFER_OBJFWD slots become local if they are set. */ + return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil); + default: abort (); } - return Qnil; } DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus, @@ -1849,30 +2008,40 @@ (variable) register Lisp_Object variable; { - Lisp_Object valcontents; struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - sym = indirect_variable (XSYMBOL (variable)); + sym = XSYMBOL (variable); /* Make sure the current binding is actually swapped in. */ find_symbol_value (variable); - valcontents = sym->value; - - if (BUFFER_LOCAL_VALUEP (valcontents) - || BUFFER_OBJFWDP (valcontents)) + start: + switch (sym->redirect) { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: return Qnil; + case SYMBOL_FORWARDED: + { + union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); + if (KBOARD_OBJFWDP (valcontents)) + return Fframe_terminal (Fselected_frame ()); + else if (!BUFFER_OBJFWDP (valcontents)) + return Qnil; + } + /* FALLTHROUGH */ + case SYMBOL_LOCALIZED: /* For a local variable, record both the symbol and which buffer's or frame's value we are saving. */ if (!NILP (Flocal_variable_p (variable, Qnil))) return Fcurrent_buffer (); - else if (BUFFER_LOCAL_VALUEP (valcontents) - && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) - return XBUFFER_LOCAL_VALUE (valcontents)->frame; + else if (sym->redirect == SYMBOL_LOCALIZED + && BLV_FOUND (SYMBOL_BLV (sym))) + return SYMBOL_BLV (sym)->where; + else + return Qnil; + default: abort (); } - - return Qnil; } /* This code is disabled now that we use the selected frame to return === modified file 'src/eval.c' --- src/eval.c 2010-01-13 08:35:10 +0000 +++ src/eval.c 2010-04-20 01:50:52 +0000 @@ -767,24 +767,46 @@ CHECK_SYMBOL (new_alias); CHECK_SYMBOL (base_variable); - if (SYMBOL_CONSTANT_P (new_alias)) - error ("Cannot make a constant an alias"); - sym = XSYMBOL (new_alias); + + if (sym->constant) + if (sym->redirect == SYMBOL_VARALIAS) + sym->constant = 0; /* Reset. */ + else + /* Not sure why. */ + error ("Cannot make a constant an alias"); + + switch (sym->redirect) + { + case SYMBOL_FORWARDED: + error ("Cannot make an internal variable an alias"); + case SYMBOL_LOCALIZED: + error ("Don't know how to make a localized variable an alias"); + } + /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html - If n_a is bound, but b_v is not, set the value of b_v to n_a. - This is for the sake of define-obsolete-variable-alias and user - customizations. */ - if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias))) - XSYMBOL(base_variable)->value = sym->value; - sym->indirect_variable = 1; - sym->value = base_variable; + If n_a is bound, but b_v is not, set the value of b_v to n_a, + so that old-code that affects n_a before the aliasing is setup + still works. */ + if (NILP (Fboundp (base_variable))) + set_internal (base_variable, find_symbol_value (new_alias), NULL, 1); + + { + struct specbinding *p; + + for (p = specpdl_ptr - 1; p >= specpdl; p--) + if (p->func == NULL + && (EQ (new_alias, + CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol))) + error ("Don't know how to make a let-bound variable an alias"); + } + + sym->redirect = SYMBOL_VARALIAS; + SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); sym->constant = SYMBOL_CONSTANT_P (base_variable); LOADHIST_ATTACH (new_alias); - if (!NILP (docstring)) - Fput (new_alias, Qvariable_documentation, docstring); - else - Fput (new_alias, Qvariable_documentation, Qnil); + /* Even if docstring is nil: remove old docstring. */ + Fput (new_alias, Qvariable_documentation, docstring); return base_variable; } @@ -944,7 +966,7 @@ return Qnil; /* If indirect and there's an alias loop, don't check anything else. */ - if (XSYMBOL (variable)->indirect_variable + if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS && NILP (internal_condition_case_1 (lisp_indirect_variable, variable, Qt, user_variable_p_eh))) return Qnil; @@ -968,11 +990,11 @@ || (!NILP (Fget (variable, intern ("custom-autoload"))))) return Qt; - if (!XSYMBOL (variable)->indirect_variable) + if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS)) return Qnil; /* An indirect variable? Let's follow the chain. */ - variable = XSYMBOL (variable)->value; + XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable))); } } @@ -3263,78 +3285,94 @@ specbind (symbol, value) Lisp_Object symbol, value; { - Lisp_Object valcontents; + struct Lisp_Symbol *sym; + + eassert (!handling_signal); CHECK_SYMBOL (symbol); + sym = XSYMBOL (symbol); if (specpdl_ptr == specpdl + specpdl_size) grow_specpdl (); - /* The most common case is that of a non-constant symbol with a - trivial value. Make that as fast as we can. */ - valcontents = SYMBOL_VALUE (symbol); - if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol)) - { - specpdl_ptr->symbol = symbol; - specpdl_ptr->old_value = valcontents; - specpdl_ptr->func = NULL; - ++specpdl_ptr; - SET_SYMBOL_VALUE (symbol, value); - } - else - { - Lisp_Object ovalue = find_symbol_value (symbol); - specpdl_ptr->func = 0; - specpdl_ptr->old_value = ovalue; - - valcontents = XSYMBOL (symbol)->value; - - if (BUFFER_LOCAL_VALUEP (valcontents) - || BUFFER_OBJFWDP (valcontents)) - { - Lisp_Object where, current_buffer; - - current_buffer = Fcurrent_buffer (); - - /* For a local variable, record both the symbol and which - buffer's or frame's value we are saving. */ - if (!NILP (Flocal_variable_p (symbol, Qnil))) - where = current_buffer; - else if (BUFFER_LOCAL_VALUEP (valcontents) - && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) - where = XBUFFER_LOCAL_VALUE (valcontents)->frame; + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: + sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; + case SYMBOL_PLAINVAL: + { /* The most common case is that of a non-constant symbol with a + trivial value. Make that as fast as we can. */ + specpdl_ptr->symbol = symbol; + specpdl_ptr->old_value = SYMBOL_VAL (sym); + specpdl_ptr->func = NULL; + ++specpdl_ptr; + if (!sym->constant) + SET_SYMBOL_VAL (sym, value); else - where = Qnil; - - /* We're not using the `unused' slot in the specbinding - structure because this would mean we have to do more - work for simple variables. */ - specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer)); - - /* If SYMBOL is a per-buffer variable which doesn't have a - buffer-local value here, make the `let' change the global - value by changing the value of SYMBOL in all buffers not - having their own value. This is consistent with what - happens with other buffer-local variables. */ - if (NILP (where) - && BUFFER_OBJFWDP (valcontents)) - { - ++specpdl_ptr; - Fset_default (symbol, value); - return; - } + set_internal (symbol, value, 0, 1); + break; } - else - specpdl_ptr->symbol = symbol; - - specpdl_ptr++; - /* We used to do - if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)) - store_symval_forwarding (symbol, ovalue, value, NULL); - else - but ovalue comes from find_symbol_value which should never return - such an internal value. */ - eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))); - set_internal (symbol, value, 0, 1); + case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: + { + Lisp_Object ovalue = find_symbol_value (symbol); + specpdl_ptr->func = 0; + specpdl_ptr->old_value = ovalue; + + eassert (sym->redirect != SYMBOL_LOCALIZED + || (EQ (SYMBOL_BLV (sym)->where, + SYMBOL_BLV (sym)->frame_local ? + Fselected_frame () : Fcurrent_buffer ()))); + + if (sym->redirect == SYMBOL_LOCALIZED + || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) + { + Lisp_Object where, cur_buf = Fcurrent_buffer (); + + /* For a local variable, record both the symbol and which + buffer's or frame's value we are saving. */ + if (!NILP (Flocal_variable_p (symbol, Qnil))) + { + eassert (sym->redirect != SYMBOL_LOCALIZED + || (BLV_FOUND (SYMBOL_BLV (sym)) + && EQ (cur_buf, SYMBOL_BLV (sym)->where))); + where = cur_buf; + } + else if (sym->redirect == SYMBOL_LOCALIZED + && BLV_FOUND (SYMBOL_BLV (sym))) + where = SYMBOL_BLV (sym)->where; + else + where = Qnil; + + /* We're not using the `unused' slot in the specbinding + structure because this would mean we have to do more + work for simple variables. */ + /* FIXME: The third value `current_buffer' is only used in + let_shadows_buffer_binding_p which is itself only used + in set_internal for local_if_set. */ + specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf)); + + /* If SYMBOL is a per-buffer variable which doesn't have a + buffer-local value here, make the `let' change the global + value by changing the value of SYMBOL in all buffers not + having their own value. This is consistent with what + happens with other buffer-local variables. */ + if (NILP (where) + && sym->redirect == SYMBOL_FORWARDED) + { + eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); + ++specpdl_ptr; + Fset_default (symbol, value); + return; + } + } + else + specpdl_ptr->symbol = symbol; + + specpdl_ptr++; + set_internal (symbol, value, 0, 1); + break; + } + default: abort (); } } @@ -3394,7 +3432,12 @@ if (NILP (where)) Fset_default (symbol, this_binding.old_value); else if (BUFFERP (where)) - set_internal (symbol, this_binding.old_value, XBUFFER (where), 1); + if (!NILP (Flocal_variable_p (symbol, where))) + set_internal (symbol, this_binding.old_value, XBUFFER (where), 1); + /* else if (!NILP (Fbuffer_live_p (where))) + error ("Unbinding local %s to global!", symbol); */ + else + ; else set_internal (symbol, this_binding.old_value, NULL, 1); } @@ -3403,8 +3446,9 @@ /* If variable has a trivial value (no forwarding), we can just set it. No need to check for constant symbols here, since that was already done by specbind. */ - if (!MISCP (SYMBOL_VALUE (this_binding.symbol))) - SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value); + if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL) + SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol), + this_binding.old_value); else set_internal (this_binding.symbol, this_binding.old_value, 0, 1); } === modified file 'src/frame.c' --- src/frame.c 2010-03-24 18:02:56 +0000 +++ src/frame.c 2010-04-20 01:50:52 +0000 @@ -2298,13 +2298,20 @@ without messing up the symbol's status. */ if (SYMBOLP (prop)) { - Lisp_Object valcontents; - valcontents = SYMBOL_VALUE (prop); - if ((BUFFER_LOCAL_VALUEP (valcontents)) - && XBUFFER_LOCAL_VALUE (valcontents)->check_frame - && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame - && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f) - swap_in_global_binding (prop); + struct Lisp_Symbol *sym = XSYMBOL (prop); + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break; + case SYMBOL_LOCALIZED: + { struct Lisp_Buffer_Local_Value *blv = sym->val.blv; + if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f) + swap_in_global_binding (sym); + break; + } + default: abort (); + } } /* The tty color needed to be set before the frame's parameter @@ -2520,6 +2527,8 @@ || EQ (parameter, Qbackground_mode)) value = Fcdr (Fassq (parameter, f->param_alist)); else + /* FIXME: Avoid this code path at all (as well as code duplication) + by sharing more code with Fframe_parameters. */ value = Fcdr (Fassq (parameter, Fframe_parameters (frame))); } === modified file 'src/insdel.c' --- src/insdel.c 2010-01-13 08:35:10 +0000 +++ src/insdel.c 2010-04-20 01:50:52 +0000 @@ -54,7 +54,7 @@ Lisp_Object Fcombine_after_change_execute (); /* Non-nil means don't call the after-change-functions right away, - just record an element in Vcombine_after_change_calls_list. */ + just record an element in combine_after_change_list. */ Lisp_Object Vcombine_after_change_calls; /* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT) === modified file 'src/keyboard.c' --- src/keyboard.c 2010-04-02 03:10:33 +0000 +++ src/keyboard.c 2010-04-20 01:50:52 +0000 @@ -1520,7 +1520,6 @@ command_loop_1 () { Lisp_Object cmd; - int lose; Lisp_Object keybuf[30]; int i; int prev_modiff = 0; === modified file 'src/lisp.h' --- src/lisp.h 2010-03-05 23:08:18 +0000 +++ src/lisp.h 2010-04-20 01:50:52 +0000 @@ -223,13 +223,7 @@ { Lisp_Misc_Free = 0x5eab, Lisp_Misc_Marker, - Lisp_Misc_Intfwd, - Lisp_Misc_Boolfwd, - Lisp_Misc_Objfwd, - Lisp_Misc_Buffer_Objfwd, - Lisp_Misc_Buffer_Local_Value, Lisp_Misc_Overlay, - Lisp_Misc_Kboard_Objfwd, Lisp_Misc_Save_Value, /* Currently floats are not a misc type, but let's define this in case we want to change that. */ @@ -238,6 +232,18 @@ Lisp_Misc_Limit }; +/* These are the types of forwarding objects used in the value slot + of symbols for special built-in variables whose value is stored in + C variables. */ +enum Lisp_Fwd_Type + { + Lisp_Fwd_Int, /* Fwd to a C `int' variable. */ + Lisp_Fwd_Bool, /* Fwd to a C boolean var. */ + Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */ + Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */ + Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */ + }; + #ifndef GCTYPEBITS #define GCTYPEBITS 3 #endif @@ -566,17 +572,19 @@ #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC(a)->u_any)) #define XMISCTYPE(a) (XMISCANY (a)->type) #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC(a)->u_marker)) -#define XINTFWD(a) (eassert (INTFWDP (a)), &(XMISC(a)->u_intfwd)) -#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &(XMISC(a)->u_boolfwd)) -#define XOBJFWD(a) (eassert (OBJFWDP (a)), &(XMISC(a)->u_objfwd)) #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC(a)->u_overlay)) #define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC(a)->u_save_value)) + +/* Forwarding object types. */ + +#define XFWDTYPE(a) (a->u_intfwd.type) +#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd)) +#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd)) +#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd)) #define XBUFFER_OBJFWD(a) \ - (eassert (BUFFER_OBJFWDP (a)), &(XMISC(a)->u_buffer_objfwd)) -#define XBUFFER_LOCAL_VALUE(a) \ - (eassert (BUFFER_LOCAL_VALUEP (a)), &(XMISC(a)->u_buffer_local_value)) + (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd)) #define XKBOARD_OBJFWD(a) \ - (eassert (KBOARD_OBJFWDP (a)), &(XMISC(a)->u_kboard_objfwd)) + (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd)) /* Pseudovector types. */ @@ -988,19 +996,32 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 }; +enum symbol_redirect +{ + SYMBOL_PLAINVAL = 4, + SYMBOL_VARALIAS = 1, + SYMBOL_LOCALIZED = 2, + SYMBOL_FORWARDED = 3 +}; + /* In a symbol, the markbit of the plist is used as the gc mark bit */ struct Lisp_Symbol { unsigned gcmarkbit : 1; - /* Non-zero means symbol serves as a variable alias. The symbol - holding the real value is found in the value slot. */ - unsigned indirect_variable : 1; + /* Indicates where the value can be found: + 0 : it's a plain var, the value is in the `value' field. + 1 : it's a varalias, the value is really in the `alias' symbol. + 2 : it's a localized var, the value is in the `blv' object. + 3 : it's a forwarding variable, the value is in `forward'. + */ + enum symbol_redirect redirect : 3; /* Non-zero means symbol is constant, i.e. changing its value - should signal an error. */ - unsigned constant : 1; + should signal an error. If the value is 3, then the var + can be changed, but only by `defconst'. */ + unsigned constant : 2; /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ @@ -1013,10 +1034,15 @@ Lisp_Object xname; /* Value of the symbol or Qunbound if unbound. If this symbol is a - defvaralias, `value' contains the symbol for which it is an + defvaralias, `alias' contains the symbol for which it is an alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get and set a symbol's value, to take defvaralias into account. */ - Lisp_Object value; + union { + Lisp_Object value; + struct Lisp_Symbol *alias; + struct Lisp_Buffer_Local_Value *blv; + union Lisp_Fwd *fwd; + } val; /* Function value of the symbol or Qunbound if not fboundp. */ Lisp_Object function; @@ -1030,6 +1056,23 @@ /* Value is name of symbol. */ +#define SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) +#define SYMBOL_ALIAS(sym) \ + (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) +#define SYMBOL_BLV(sym) \ + (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) +#define SYMBOL_FWD(sym) \ + (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) +#define SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +#define SET_SYMBOL_ALIAS(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) +#define SET_SYMBOL_BLV(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) +#define SET_SYMBOL_FWD(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) + #define SYMBOL_NAME(sym) \ LISP_MAKE_RVALUE (XSYMBOL (sym)->xname) @@ -1049,24 +1092,6 @@ #define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant -/* Value is the value of SYM, with defvaralias taken into - account. */ - -#define SYMBOL_VALUE(sym) \ - (XSYMBOL (sym)->indirect_variable \ - ? indirect_variable (XSYMBOL (sym))->value \ - : XSYMBOL (sym)->value) - -/* Set SYM's value to VAL, taking defvaralias into account. */ - -#define SET_SYMBOL_VALUE(sym, val) \ - do { \ - if (XSYMBOL (sym)->indirect_variable) \ - indirect_variable (XSYMBOL (sym))->value = (val); \ - else \ - XSYMBOL (sym)->value = (val); \ - } while (0) - /*********************************************************************** Hash Tables @@ -1200,9 +1225,11 @@ struct Lisp_Misc_Any /* Supertype of all Misc types. */ { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Marker */ + enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_??? */ unsigned gcmarkbit : 1; int spacer : 15; + /* Make it as long as "Lisp_Free without padding". */ + void *fill; }; struct Lisp_Marker @@ -1225,7 +1252,7 @@ - Fmarker_buffer - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain. - unchain_marker: to find the list from which to unchain. - - Fkill_buffer: to unchain the markers of current indirect buffer. + - Fkill_buffer: to only unchain the markers of current indirect buffer. */ struct buffer *buffer; @@ -1239,7 +1266,10 @@ struct Lisp_Marker *next; /* This is the char position where the marker points. */ EMACS_INT charpos; - /* This is the byte position. */ + /* This is the byte position. + It's mostly used as a charpos<->bytepos cache (i.e. it's not directly + used to implement the functionality of markers, but rather to (ab)use + markers as a cache for char<->byte mappings). */ EMACS_INT bytepos; }; @@ -1249,9 +1279,7 @@ specified int variable. */ struct Lisp_Intfwd { - int type : 16; /* = Lisp_Misc_Intfwd */ - unsigned gcmarkbit : 1; - int spacer : 15; + enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */ EMACS_INT *intvar; }; @@ -1261,9 +1289,7 @@ nil if it is zero. */ struct Lisp_Boolfwd { - int type : 16; /* = Lisp_Misc_Boolfwd */ - unsigned gcmarkbit : 1; - int spacer : 15; + enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */ int *boolvar; }; @@ -1273,9 +1299,7 @@ specified variable. */ struct Lisp_Objfwd { - int type : 16; /* = Lisp_Misc_Objfwd */ - unsigned gcmarkbit : 1; - int spacer : 15; + enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */ Lisp_Object *objvar; }; @@ -1283,11 +1307,9 @@ current buffer. Value is byte index of slot within buffer. */ struct Lisp_Buffer_Objfwd { - int type : 16; /* = Lisp_Misc_Buffer_Objfwd */ - unsigned gcmarkbit : 1; - int spacer : 15; + enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */ + int offset; Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */ - int offset; }; /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when @@ -1316,48 +1338,51 @@ struct Lisp_Buffer_Local_Value { - int type : 16; /* = Lisp_Misc_Buffer_Local_Value */ - unsigned gcmarkbit : 1; - int spacer : 11; - /* 1 means that merely setting the variable creates a local binding for the current buffer */ unsigned int local_if_set : 1; - /* 1 means this variable is allowed to have frame-local bindings, - so check for them when looking for the proper binding. */ - unsigned int check_frame : 1; - /* 1 means that the binding now loaded was found - as a local binding for the buffer in the `buffer' slot. */ - unsigned int found_for_buffer : 1; - /* 1 means that the binding now loaded was found - as a local binding for the frame in the `frame' slot. */ - unsigned int found_for_frame : 1; - Lisp_Object realvalue; - /* The buffer and frame for which the loaded binding was found. */ - /* Having both is only needed if we want to allow variables that are - both buffer local and frame local (in which case, we currently give - precedence to the buffer-local binding). I don't think such - a combination is desirable. --Stef */ - Lisp_Object buffer, frame; - - /* A cons cell, (LOADED-BINDING . DEFAULT-VALUE). - - LOADED-BINDING is the binding now loaded. It is a cons cell - whose cdr is the binding's value. The cons cell may be an - element of a buffer's local-variable alist, or an element of a - frame's parameter alist, or it may be this cons cell. - - DEFAULT-VALUE is the variable's default value, seen when the - current buffer and selected frame do not have their own - bindings for the variable. When the default binding is loaded, - LOADED-BINDING is actually this very cons cell; thus, its car - points to itself. */ - Lisp_Object cdr; + /* 1 means this variable can have frame-local bindings, otherwise, it is + can have buffer-local bindings. The two cannot be combined. */ + unsigned int frame_local : 1; + /* 1 means that the binding now loaded was found. + Presumably equivalent to (defcell!=valcell) */ + unsigned int found : 1; + /* If non-NULL, a forwarding to the C var where it should also be set. */ + union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */ + /* The buffer or frame for which the loaded binding was found. */ + Lisp_Object where; + /* A cons cell that holds the default value. It has the form + (SYMBOL . DEFAULT-VALUE). */ + Lisp_Object defcell; + /* The cons cell from `where's parameter alist. + It always has the form (SYMBOL . VALUE) + Note that if `forward' is non-nil, VALUE may be out of date. + Also if the currently loaded binding is the default binding, then + this is `eq'ual to defcell. */ + Lisp_Object valcell; }; +#define BLV_FOUND(blv) \ + (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found) +#define SET_BLV_FOUND(blv, v) \ + (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v)) + +#define BLV_VALUE(blv) (XCDR ((blv)->valcell)) +#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v)) + /* START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */ struct Lisp_Overlay +/* An overlay's real data content is: + - plist + - buffer + - insertion type of both ends + - start & start_byte + - end & end_byte + - next (singly linked list of overlays). + - start_next and end_next (singly linked list of markers). + I.e. 9words plus 2 bits, 3words of which are for external linked lists. +*/ { enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */ unsigned gcmarkbit : 1; @@ -1370,9 +1395,7 @@ current kboard. */ struct Lisp_Kboard_Objfwd { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Kboard_Objfwd */ - unsigned gcmarkbit : 1; - int spacer : 15; + enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */ int offset; }; @@ -1401,9 +1424,9 @@ #ifdef USE_LSB_TAG /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment. This assumes that Lisp_Marker is the largest of the alternatives and - that Lisp_Intfwd has the same size as "Lisp_Free w/o padding". */ + that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */ char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1) - << GCTYPEBITS) - sizeof (struct Lisp_Intfwd)]; + << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)]; #endif }; @@ -1414,15 +1437,18 @@ { struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ struct Lisp_Free u_free; /* Includes padding to force alignment. */ - struct Lisp_Marker u_marker; - struct Lisp_Intfwd u_intfwd; - struct Lisp_Boolfwd u_boolfwd; - struct Lisp_Objfwd u_objfwd; - struct Lisp_Buffer_Objfwd u_buffer_objfwd; - struct Lisp_Buffer_Local_Value u_buffer_local_value; - struct Lisp_Overlay u_overlay; - struct Lisp_Kboard_Objfwd u_kboard_objfwd; - struct Lisp_Save_Value u_save_value; + struct Lisp_Marker u_marker; /* 5 */ + struct Lisp_Overlay u_overlay; /* 5 */ + struct Lisp_Save_Value u_save_value; /* 3 */ + }; + +union Lisp_Fwd + { + struct Lisp_Intfwd u_intfwd; /* 2 */ + struct Lisp_Boolfwd u_boolfwd; /* 2 */ + struct Lisp_Objfwd u_objfwd; /* 2 */ + struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */ + struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */ }; /* Lisp floating point type */ @@ -1564,15 +1590,13 @@ #define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd) -#define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd) -#define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd) -#define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd) -#define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value) -#define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value) -#define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd) #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) +#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) +#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) +#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) +#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj) +#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj) /* True if object X is a pseudovector whose code is CODE. */ #define PSEUDOVECTORP(x, code) \ @@ -1789,24 +1813,44 @@ #define MANY -2 #define UNEVALLED -1 -extern void defvar_lisp (const char *, Lisp_Object *); -extern void defvar_lisp_nopro (const char *, Lisp_Object *); -extern void defvar_bool (const char *, int *); -extern void defvar_int (const char *, EMACS_INT *); -extern void defvar_kboard (const char *, int); +extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *); +extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *); +extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *); +extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *); +extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); /* Macros we use to define forwarded Lisp variables. These are used in the syms_of_FILENAME functions. */ -#define DEFVAR_LISP(lname, vname, doc) defvar_lisp (lname, vname) -#define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname) -#define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname) -#define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname) +#define DEFVAR_LISP(lname, vname, doc) \ + do { \ + static struct Lisp_Objfwd o_fwd; \ + defvar_lisp (&o_fwd, lname, vname); \ + } while (0) +#define DEFVAR_LISP_NOPRO(lname, vname, doc) \ + do { \ + static struct Lisp_Objfwd o_fwd; \ + defvar_lisp_nopro (&o_fwd, lname, vname); \ + } while (0) +#define DEFVAR_BOOL(lname, vname, doc) \ + do { \ + static struct Lisp_Boolfwd b_fwd; \ + defvar_bool (&b_fwd, lname, vname); \ + } while (0) +#define DEFVAR_INT(lname, vname, doc) \ + do { \ + static struct Lisp_Intfwd i_fwd; \ + defvar_int (&i_fwd, lname, vname); \ + } while (0) -#define DEFVAR_KBOARD(lname, vname, doc) \ - defvar_kboard (lname, \ - (int)((char *)(¤t_kboard->vname) \ - - (char *)current_kboard)) +#define DEFVAR_KBOARD(lname, vname, doc) \ + do { \ + static struct Lisp_Kboard_Objfwd ko_fwd; \ + defvar_kboard (&ko_fwd, \ + lname, \ + (int)((char *)(¤t_kboard->vname) \ + - (char *)current_kboard)); \ + } while (0) @@ -2341,13 +2385,11 @@ extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object)) NO_RETURN; extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; -extern void store_symval_forwarding P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, struct buffer *)); -extern Lisp_Object do_symval_forwarding P_ ((Lisp_Object)); -extern Lisp_Object set_internal P_ ((Lisp_Object, Lisp_Object, struct buffer *, int)); +extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); +extern void set_internal (Lisp_Object, Lisp_Object, struct buffer *, int); extern void syms_of_data P_ ((void)); extern void init_data P_ ((void)); -extern void swap_in_global_binding P_ ((Lisp_Object)); +extern void swap_in_global_binding P_ ((struct Lisp_Symbol *)); /* Defined in cmds.c */ EXFUN (Fend_of_line, 1); @@ -3388,6 +3430,7 @@ extern void fatal P_ ((const char *msgid, ...)) NO_RETURN; /* Defined in terminal.c */ +EXFUN (Fframe_terminal, 1); EXFUN (Fdelete_terminal, 2); extern void syms_of_terminal P_ ((void)); === modified file 'src/lread.c' --- src/lread.c 2010-04-02 03:10:33 +0000 +++ src/lread.c 2010-04-20 01:50:52 +0000 @@ -3687,7 +3687,8 @@ && EQ (obarray, initial_obarray)) { XSYMBOL (sym)->constant = 1; - XSYMBOL (sym)->value = sym; + XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (XSYMBOL (sym), sym); } ptr = &XVECTOR (obarray)->contents[XINT (tem)]; @@ -3768,8 +3769,6 @@ error ("Attempt to unintern t or nil"); */ XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; - XSYMBOL (tem)->constant = 0; - XSYMBOL (tem)->indirect_variable = 0; hash = oblookup_last_bucket_number; @@ -3914,35 +3913,31 @@ init_obarray () { Lisp_Object oblength; - int hash; - Lisp_Object *tem; XSETFASTINT (oblength, OBARRAY_SIZE); - Qnil = Fmake_symbol (make_pure_c_string ("nil")); Vobarray = Fmake_vector (oblength, make_number (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); - /* Intern nil in the obarray */ - XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; - XSYMBOL (Qnil)->constant = 1; - - /* These locals are to kludge around a pyramid compiler bug. */ - hash = hash_string ("nil", 3); - /* Separate statement here to avoid VAXC bug. */ - hash %= OBARRAY_SIZE; - tem = &XVECTOR (Vobarray)->contents[hash]; - *tem = Qnil; Qunbound = Fmake_symbol (make_pure_c_string ("unbound")); - XSYMBOL (Qnil)->function = Qunbound; - XSYMBOL (Qunbound)->value = Qunbound; + /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the + NILP (Vpurify_flag) check in intern_c_string. */ + Qnil = make_number (-1); Vpurify_flag = make_number (1); + Qnil = intern_c_string ("nil"); + + /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, + so those two need to be fixed manally. */ + SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); XSYMBOL (Qunbound)->function = Qunbound; + XSYMBOL (Qunbound)->plist = Qnil; + /* XSYMBOL (Qnil)->function = Qunbound; */ + SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); + XSYMBOL (Qnil)->constant = 1; + XSYMBOL (Qnil)->plist = Qnil; Qt = intern_c_string ("t"); - XSYMBOL (Qnil)->value = Qnil; - XSYMBOL (Qnil)->plist = Qnil; - XSYMBOL (Qt)->value = Qt; + SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); XSYMBOL (Qt)->constant = 1; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ @@ -3981,27 +3976,29 @@ to a C variable of type int. Sample call: DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ void -defvar_int (const char *namestring, EMACS_INT *address) +defvar_int (struct Lisp_Intfwd *i_fwd, + const char *namestring, EMACS_INT *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Intfwd; - XINTFWD (val)->intvar = address; - SET_SYMBOL_VALUE (sym, val); + i_fwd->type = Lisp_Fwd_Int; + i_fwd->intvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); } /* Similar but define a variable whose value is t if address contains 1, nil if address contains 0. */ void -defvar_bool (const char *namestring, int *address) +defvar_bool (struct Lisp_Boolfwd *b_fwd, + const char *namestring, int *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Boolfwd; - XBOOLFWD (val)->boolvar = address; - SET_SYMBOL_VALUE (sym, val); + b_fwd->type = Lisp_Fwd_Bool; + b_fwd->boolvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -4011,20 +4008,22 @@ gc-marked for some other reason, since marking the same slot twice can cause trouble with strings. */ void -defvar_lisp_nopro (const char *namestring, Lisp_Object *address) +defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd, + const char *namestring, Lisp_Object *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Objfwd; - XOBJFWD (val)->objvar = address; - SET_SYMBOL_VALUE (sym, val); + o_fwd->type = Lisp_Fwd_Obj; + o_fwd->objvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); } void -defvar_lisp (const char *namestring, Lisp_Object *address) +defvar_lisp (struct Lisp_Objfwd *o_fwd, + const char *namestring, Lisp_Object *address) { - defvar_lisp_nopro (namestring, address); + defvar_lisp_nopro (o_fwd, namestring, address); staticpro (address); } @@ -4032,14 +4031,15 @@ at a particular offset in the current kboard object. */ void -defvar_kboard (const char *namestring, int offset) +defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd, + const char *namestring, int offset) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; - XKBOARD_OBJFWD (val)->offset = offset; - SET_SYMBOL_VALUE (sym, val); + ko_fwd->type = Lisp_Fwd_Kboard_Obj; + ko_fwd->offset = offset; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); } /* Record the value of load-path used at the start of dumping === modified file 'src/print.c' --- src/print.c 2010-01-13 08:35:10 +0000 +++ src/print.c 2010-04-20 01:50:52 +0000 @@ -2267,70 +2267,6 @@ strout ("#", -1, -1, printcharfun, 0); break; - case Lisp_Misc_Intfwd: - sprintf (buf, "#", (long) *XINTFWD (obj)->intvar); - strout (buf, -1, -1, printcharfun, 0); - break; - - case Lisp_Misc_Boolfwd: - sprintf (buf, "#", - (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); - strout (buf, -1, -1, printcharfun, 0); - break; - - case Lisp_Misc_Objfwd: - strout ("#objvar, printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Buffer_Objfwd: - strout ("#offset), - printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Kboard_Objfwd: - strout ("#offset), - printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Buffer_Local_Value: - strout ("#local_if_set) - strout ("[local-if-set] ", -1, -1, printcharfun, 0); - strout ("[realvalue] ", -1, -1, printcharfun, 0); - print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue, - printcharfun, escapeflag); - if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer) - strout ("[local in buffer] ", -1, -1, printcharfun, 0); - else - strout ("[buffer] ", -1, -1, printcharfun, 0); - print_object (XBUFFER_LOCAL_VALUE (obj)->buffer, - printcharfun, escapeflag); - if (XBUFFER_LOCAL_VALUE (obj)->check_frame) - { - if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame) - strout ("[local in frame] ", -1, -1, printcharfun, 0); - else - strout ("[frame] ", -1, -1, printcharfun, 0); - print_object (XBUFFER_LOCAL_VALUE (obj)->frame, - printcharfun, escapeflag); - } - strout ("[alist-elt] ", -1, -1, printcharfun, 0); - print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr), - printcharfun, escapeflag); - strout ("[default-value] ", -1, -1, printcharfun, 0); - print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr), - printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - case Lisp_Misc_Save_Value: strout ("#value)); + tem = Fassq (val, Fsymbol_value (tty_color_mode_alist)); color_mode = CONSP (tem) ? XCDR (tem) : Qnil; } + else + color_mode = Qnil; mode = INTEGERP (color_mode) ? XINT (color_mode) : 0; === modified file 'src/xdisp.c' --- src/xdisp.c 2010-04-19 15:35:15 +0000 +++ src/xdisp.c 2010-04-20 01:50:52 +0000 @@ -11592,7 +11592,7 @@ select_frame_for_redisplay (frame) Lisp_Object frame; { - Lisp_Object tail, symbol, val; + Lisp_Object tail, tem; Lisp_Object old = selected_frame; struct Lisp_Symbol *sym; @@ -11600,20 +11600,18 @@ selected_frame = frame; - do - { - for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail)) - if (CONSP (XCAR (tail)) - && (symbol = XCAR (XCAR (tail)), - SYMBOLP (symbol)) - && (sym = indirect_variable (XSYMBOL (symbol)), - val = sym->value, - (BUFFER_LOCAL_VALUEP (val))) - && XBUFFER_LOCAL_VALUE (val)->check_frame) - /* Use find_symbol_value rather than Fsymbol_value - to avoid an error if it is void. */ - find_symbol_value (symbol); - } while (!EQ (frame, old) && (frame = old, 1)); + do { + for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail)) + if (CONSP (XCAR (tail)) + && (tem = XCAR (XCAR (tail)), + SYMBOLP (tem)) + && (sym = indirect_variable (XSYMBOL (tem)), + sym->redirect == SYMBOL_LOCALIZED) + && sym->val.blv->frame_local) + /* Use find_symbol_value rather than Fsymbol_value + to avoid an error if it is void. */ + find_symbol_value (tem); + } while (!EQ (frame, old) && (frame = old, 1)); } ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.