[COMMIT] Remove a redundant double division, number-mp.c:bignum_ceil().
12 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1334434691 -3600
# Node ID 7aa144d1404b8ce10cbbb3dfb0faf0e31f04b475
# Parent 5d3bb11008322a79591b3535a0658ab36d6610f2
Remove a redundant double division, number-mp.c:bignum_ceil().
src/ChangeLog addition:
2012-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
* number-mp.c (bignum_ceil): Remove a redundant double division
from this function.
diff -r 5d3bb1100832 -r 7aa144d1404b src/ChangeLog
--- a/src/ChangeLog Sat Apr 07 21:57:31 2012 +0100
+++ b/src/ChangeLog Sat Apr 14 21:18:11 2012 +0100
＠＠ -5,6 +5,11 ＠＠
find it. It wasn't needed anyway, so remove the include under
cygwin.
+2012-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * number-mp.c (bignum_ceil): Remove a redundant double division
+ from this function.
+
2012-01-08 Aidan Kehoe <kehoea(a)parhasard.net>
* device-x.c:
diff -r 5d3bb1100832 -r 7aa144d1404b src/number-mp.c
--- a/src/number-mp.c Sat Apr 07 21:57:31 2012 +0100
+++ b/src/number-mp.c Sat Apr 14 21:18:11 2012 +0100
＠＠ -322,7 +322,7 ＠＠
void bignum_ceil (bignum quotient, bignum N, bignum D)
{
MP_MDIV (N, D, quotient, intern_bignum);
- MP_MDIV (N, D, quotient, intern_bignum);
+
if (MP_MCMP (intern_bignum, bignum_zero) != 0)
{
short signN = MP_MCMP (N, bignum_zero);
--
‘Iodine deficiency was endemic in parts of the UK until, through what has been
described as “an unplanned and accidental public health triumph”, iodine was
added to cattle feed to improve milk production in the 1930s.’
(EN Pearce, Lancet, June 2011)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: Remove a redundant double division, number-mp.c:bignum_ceil().
12 years, 8 months
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/changeset/7aa144d1404b/
changeset: 7aa144d1404b
user: kehoea
date: 2012-04-14 22:18:11
summary: Remove a redundant double division, number-mp.c:bignum_ceil().
src/ChangeLog addition:
2012-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
* number-mp.c (bignum_ceil): Remove a redundant double division
from this function.
affected #: 2 files
diff -r 5d3bb11008322a79591b3535a0658ab36d6610f2 -r 7aa144d1404b8ce10cbbb3dfb0faf0e31f04b475 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -5,6 +5,11 ＠＠
find it. It wasn't needed anyway, so remove the include under
cygwin.
+2012-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * number-mp.c (bignum_ceil): Remove a redundant double division
+ from this function.
+
2012-01-08 Aidan Kehoe <kehoea(a)parhasard.net>
* device-x.c:
diff -r 5d3bb11008322a79591b3535a0658ab36d6610f2 -r 7aa144d1404b8ce10cbbb3dfb0faf0e31f04b475 src/number-mp.c
--- a/src/number-mp.c
+++ b/src/number-mp.c
＠＠ -322,7 +322,7 ＠＠
void bignum_ceil (bignum quotient, bignum N, bignum D)
{
MP_MDIV (N, D, quotient, intern_bignum);
- MP_MDIV (N, D, quotient, intern_bignum);
+
if (MP_MCMP (intern_bignum, bignum_zero) != 0)
{
short signN = MP_MCMP (N, bignum_zero);
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/cc-mode: acm: Make imenu work again for Objective C Mode.
12 years, 8 months
Bitbucket
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/changeset/29c4b1d0c74b/
changeset: 29c4b1d0c74b
user: acm
date: 2012-04-11 18:56:34
summary: Make imenu work again for Objective C Mode.
cc-menus.el (cc-imenu-objc-generic-expression): Correct the *-index
values, these having been disturbed by a previous change in 2011-08.
affected #: 1 file
diff -r c08db355955badb6c1bdec66c7a9b4aa51be8b15 -r 29c4b1d0c74b93f571485cdd6c881437827eec93 cc-menus.el
--- a/cc-menus.el
+++ b/cc-menus.el
＠＠ -66,6 +66,20 ＠＠
A sample value might look like: `\\(_P\\|_PROTO\\)'.")
+;; *Warning for cc-mode developers*
+;;
+;; `cc-imenu-objc-generic-expression' elements depend on
+;; `cc-imenu-c++-generic-expression'. So if you change this
+;; expression, you need to change following variables,
+;; `cc-imenu-objc-generic-expression-*-index',
+;; too. `cc-imenu-objc-function' uses these *-index variables, in
+;; order to know where the each regexp *group \\(foobar\\)* elements
+;; are started.
+;;
+;; *-index variables are initialized during `cc-imenu-objc-generic-expression'
+;; being initialized.
+;;
+
(defvar cc-imenu-c++-generic-expression
`(
;; Try to match ::operator definitions first. Otherwise `X::operator new ()'
＠＠ -190,20 +204,6 ＠＠
)) 1))
"Imenu generic expression for Java mode. See `imenu-generic-expression'.")
-;; *Warning for cc-mode developers*
-;;
-;; `cc-imenu-objc-generic-expression' elements depend on
-;; `cc-imenu-c++-generic-expression'. So if you change this
-;; expression, you need to change following variables,
-;; `cc-imenu-objc-generic-expression-*-index',
-;; too. `cc-imenu-objc-function' uses these *-index variables, in
-;; order to know where the each regexp *group \\(foobar\\)* elements
-;; are started.
-;;
-;; *-index variables are initialized during `cc-imenu-objc-generic-expression'
-;; being initialized.
-;;
-
;; Internal variables
(defvar cc-imenu-objc-generic-expression-noreturn-index nil)
(defvar cc-imenu-objc-generic-expression-general-func-index nil)
＠＠ -223,7 +223,7 ＠＠
"\\|"
;; > General function name regexp
;; Pick a token by (match-string 3)
- (car (cdr (nth 2 cc-imenu-c++-generic-expression))) ; -> index += 5
+ (car (cdr (nth 2 cc-imenu-c++-generic-expression))) ; -> index += 6
(prog2 (setq cc-imenu-objc-generic-expression-general-func-index 3) "")
;; > Special case for definitions using phony prototype macros like:
;; > `int main _PROTO( (int argc,char *argv[]) )'.
＠＠ -232,11 +232,11 ＠＠
(concat
"\\|"
(car (cdr (nth 3 cc-imenu-c++-generic-expression))) ; -> index += 1
- (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 9) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 10) "")
)
- (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 8) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-objc-base-index 9) "")
"") ; -> index += 0
- (prog2 (setq cc-imenu-objc-generic-expression-proto-index 8) "")
+ (prog2 (setq cc-imenu-objc-generic-expression-proto-index 9) "")
;;
;; For Objective-C
;; Pick a token by (match-string 8 or 9)
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/cc-mode: acm: Correct two search limits in c-before-change-check_<>-operators.
12 years, 8 months
Bitbucket
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/changeset/c08db355955b/
changeset: c08db355955b
user: acm
date: 2012-04-08 15:42:00
summary: Correct two search limits in c-before-change-check_<>-operators.
cc-engine.el (c-before-change-check-<>-operators): Make the correction.
cc-mode.texi (c-offsets-alist): Correct a typo.
affected #: 2 files
diff -r e56d1804baae761390362fb17dac8eaee611010f -r c08db355955badb6c1bdec66c7a9b4aa51be8b15 cc-engine.el
--- a/cc-engine.el
+++ b/cc-engine.el
＠＠ -5414,7 +5414,7 ＠＠
new-beg new-end need-new-beg need-new-end)
;; Locate the barrier before the changed region
(goto-char (if beg-lit-limits (car beg-lit-limits) beg))
- (c-syntactic-skip-backward "^;{}" (max (- beg 2048) (point-min)))
+ (c-syntactic-skip-backward "^;{}" (c-determine-limit 512))
(setq new-beg (point))
;; Remove the syntax-table/category properties from each pertinent <...>
＠＠ -5426,8 +5426,7 ＠＠
;; Locate the barrier after END.
(goto-char (if end-lit-limits (cdr end-lit-limits) end))
- (c-syntactic-re-search-forward "[;{}]"
- (min (+ end 2048) (point-max)) 'end)
+ (c-syntactic-re-search-forward "[;{}]" (c-determine-+ve-limit 512) 'end)
(setq new-end (point))
;; Remove syntax-table properties from the remaining pertinent <...>
diff -r e56d1804baae761390362fb17dac8eaee611010f -r c08db355955badb6c1bdec66c7a9b4aa51be8b15 cc-mode.texi
--- a/cc-mode.texi
+++ b/cc-mode.texi
＠＠ -5185,7 +5185,7 ＠＠
＠comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
This section explains the structure and semantics of the style
-variable ＠code{c-offset-alist}, the principal variable for configuring
+variable ＠code{c-offsets-alist}, the principal variable for configuring
indentation. Details of how to set it up, and its relationship to
＠ccmode{}'s style system are given in ＠ref{Style Variables}.
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Remove some utility functions from the global namespace, lisp/
12 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
Not done for functions like #'fontcolor-property-1 in fontcolor.el because
it wouldn’t give a decrease in the size of the dumped XEmacs, and so is less
clearly a win.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1333832251 -3600
# Node ID 5d3bb11008322a79591b3535a0658ab36d6610f2
# Parent 0df3cedee9ac6e12eac0e246466909560da38b3b
Remove some utility functions from the global namespace, lisp/
lisp/ChangeLog addition:
2012-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
Remove some utility functions from the global namespace, it's more
appropriate to have them as labels (that is, lexically-visible
functions.)
* behavior.el:
* behavior.el (behavior-menu-filter-1): Moved to being a label.
* behavior.el (behavior-menu-filter): Use the label.
* cus-edit.el (custom-load-symbol-1): Moved to being a label.
* cus-edit.el (custom-load-symbol): Use the label.
* menubar.el (find-menu-item-1): Moved to being a label.
* menubar.el (find-menu-item): Use the label.
* window-xemacs.el:
* window-xemacs.el (display-buffer-1): Moved to being a label.
* window-xemacs.el (display-buffer): Use the label; use (block
...) instead of (catch ...), use prog1 instead of needlessly
binding a variable.
diff -r 0df3cedee9ac -r 5d3bb1100832 lisp/ChangeLog
--- a/lisp/ChangeLog Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/ChangeLog Sat Apr 07 21:57:31 2012 +0100
＠＠ -1,3 +1,21 ＠＠
+2012-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Remove some utility functions from the global namespace, it's more
+ appropriate to have them as labels (that is, lexically-visible
+ functions.)
+ * behavior.el:
+ * behavior.el (behavior-menu-filter-1): Moved to being a label.
+ * behavior.el (behavior-menu-filter): Use the label.
+ * cus-edit.el (custom-load-symbol-1): Moved to being a label.
+ * cus-edit.el (custom-load-symbol): Use the label.
+ * menubar.el (find-menu-item-1): Moved to being a label.
+ * menubar.el (find-menu-item): Use the label.
+ * window-xemacs.el:
+ * window-xemacs.el (display-buffer-1): Moved to being a label.
+ * window-xemacs.el (display-buffer): Use the label; use (block
+ ...) instead of (catch ...), use prog1 instead of needlessly
+ binding a variable.
+
2012-03-02 Aidan Kehoe <kehoea(a)parhasard.net>
* select.el (select-coerce):
diff -r 0df3cedee9ac -r 5d3bb1100832 lisp/behavior.el
--- a/lisp/behavior.el Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/behavior.el Sat Apr 07 21:57:31 2012 +0100
＠＠ -414,90 +414,96 ＠＠
)
)
-(defun behavior-menu-filter-1 (menu group)
- (submenu-generate-accelerator-spec
- (let* (
- ;;options
- ;;help
- (enable
- (menu-split-long-menu
- (menu-sort-menu
- (let ((group-plist (gethash group behavior-group-hash-table)))
- (loop for behavior in (getf group-plist :children)
- nconc (if (behavior-group-p behavior)
- (list
- (cons (getf
- (gethash behavior behavior-group-hash-table)
- :short-doc)
- (behavior-menu-filter-1 menu behavior)))
- (let* ((plist (gethash behavior behavior-hash-table))
- (commands (getf plist :commands)))
- (nconc
- (if (getf plist :enable)
- `([,(format "%s (%s) [toggle]"
- (getf plist :short-doc)
- behavior)
- (if (memq ',behavior
- enabled-behavior-list)
- (disable-behavior ',behavior)
- (enable-behavior ',behavior))
- :active ,(if (getf plist :disable) t
- (not (memq
- ',behavior
- enabled-behavior-list)))
- :style toggle
- :selected (memq ',behavior
- enabled-behavior-list)]))
- (cond ((null commands) nil)
- ((and (eq (length commands) 1)
- (vectorp (elt commands 0)))
- (let ((comm (copy-sequence
- (elt commands 0))))
- (setf (elt comm 0)
- (format "%s (%s)"
- (elt comm 0) behavior))
- (list comm)))
- (t (list
- (cons (format "%s (%s) Commands"
- (getf plist :short-doc)
- behavior)
- commands)))))))))
- ))
- )
- )
- enable)
- '(?p)))
-
(defun behavior-menu-filter (menu)
- (append
- `(("%_Package Utilities"
- ("%_Set Download Site"
- ("%_Official Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-download-menu)))))
- ("%_Pre-Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-pre-release-download-menu)))))
- ("%_Site Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-site-release-download-menu))))))
- "--:shadowEtchedIn"
- ["%_Update Package Index" package-get-update-base]
- ["%_List and Install" pui-list-packages]
- ["U%_pdate Installed Packages" package-get-update-all]
- ["%_Help" (Info-goto-node "(xemacs)Packages")])
- "----")
- (behavior-menu-filter-1 menu nil)))
+ (labels
+ ((behavior-menu-filter-1 (menu group)
+ (submenu-generate-accelerator-spec
+ (let* ((enable
+ (menu-split-long-menu
+ (menu-sort-menu
+ (let ((group-plist (gethash group
+ behavior-group-hash-table)))
+ (loop for behavior in (getf group-plist :children)
+ nconc (if (behavior-group-p behavior)
+ (list
+ (cons (getf
+ (gethash behavior
+ behavior-group-hash-table)
+ :short-doc)
+ (behavior-menu-filter-1
+ menu behavior)))
+ (let* ((plist (gethash behavior
+ behavior-hash-table))
+ (commands (getf plist :commands)))
+ (nconc
+ (if (getf plist :enable)
+ `([,(format "%s (%s) [toggle]"
+ (getf plist :short-doc)
+ behavior)
+ (if (memq ',behavior
+ enabled-behavior-list)
+ (disable-behavior ',behavior)
+ (enable-behavior ',behavior))
+ :active ,(if (getf plist :disable)
+ t
+ (not
+ (memq
+ ',behavior
+ enabled-behavior-list)))
+ :style toggle
+ :selected (memq
+ ',behavior
+ enabled-behavior-list)]))
+ (cond ((null commands) nil)
+ ((and (eq (length commands) 1)
+ (vectorp (elt commands 0)))
+ (let ((comm (copy-sequence
+ (elt commands 0))))
+ (setf (elt comm 0)
+ (format "%s (%s)"
+ (elt comm 0)
+ behavior))
+ (list comm)))
+ (t (list
+ (cons (format "%s (%s) Commands"
+ (getf plist
+ :short-doc)
+ behavior)
+ commands)))))))))
+ ))
+ )
+ )
+ enable)
+ '(?p))))
+ (append
+ `(("%_Package Utilities"
+ ("%_Set Download Site"
+ ("%_Official Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-download-menu)))))
+ ("%_Pre-Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-pre-release-download-menu)))))
+ ("%_Site Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-site-release-download-menu))))))
+ "--:shadowEtchedIn"
+ ["%_Update Package Index" package-get-update-base]
+ ["%_List and Install" pui-list-packages]
+ ["U%_pdate Installed Packages" package-get-update-all]
+ ["%_Help" (Info-goto-node "(xemacs)Packages")])
+ "----")
+ (behavior-menu-filter-1 menu nil))))
;; Initialize top-level group.
(puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table)
(provide 'behavior)
-;;; finder-inf.el ends here
+;;; behavior.el ends here
diff -r 0df3cedee9ac -r 5d3bb1100832 lisp/cus-edit.el
--- a/lisp/cus-edit.el Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/cus-edit.el Sat Apr 07 21:57:31 2012 +0100
＠＠ -1684,33 +1684,28 ＠＠
(defun custom-load-symbol (symbol)
"Load all dependencies for SYMBOL."
- (unless custom-load-recursion
- (let ((custom-load-recursion t)
- (loads (get symbol 'custom-loads))
- load)
- (while loads
- (setq load (car loads)
- loads (cdr loads))
- (custom-load-symbol-1 load)))))
-
-(defun custom-load-symbol-1 (load)
- (cond ((symbolp load)
- (condition-case nil
- (require load)
- (error nil)))
- ;; Don't reload a file already loaded.
- ((and (boundp 'preloaded-file-list)
- (member load preloaded-file-list)))
- ((assoc load load-history))
- ((assoc (locate-library load) load-history))
- (t
- (condition-case nil
- ;; Without this, we would load cus-edit recursively.
- ;; We are still loading it when we call this,
- ;; and it is not in load-history yet.
- (or (equal load "cus-edit")
- (load-library load))
- (error nil)))))
+ (labels
+ ((custom-load-symbol-1 (load)
+ (cond ((symbolp load)
+ (condition-case nil
+ (require load)
+ (error nil)))
+ ;; Don't reload a file already loaded.
+ ((and (boundp 'preloaded-file-list)
+ (member load preloaded-file-list)))
+ ((assoc load load-history))
+ ((assoc (locate-library load) load-history))
+ (t
+ (condition-case nil
+ ;; Without this, we would load cus-edit recursively.
+ ;; We are still loading it when we call this,
+ ;; and it is not in load-history yet.
+ (or (equal load "cus-edit")
+ (load-library load))
+ (error nil))))))
+ (unless custom-load-recursion
+ (let ((custom-load-recursion t))
+ (map nil #'custom-load-symbol-1 (get symbol 'custom-loads))))))
(defvar custom-already-loaded-custom-defines nil
"List of already-loaded `custom-defines' files.")
diff -r 0df3cedee9ac -r 5d3bb1100832 lisp/menubar.el
--- a/lisp/menubar.el Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/menubar.el Sat Apr 07 21:57:31 2012 +0100
＠＠ -178,35 +178,36 ＠＠
the item found.
If the item does not exist, the car of the returned value is nil.
If some menu in the ITEM-PATH-LIST does not exist, an error is signalled."
- (find-menu-item-1 menubar item-path-list))
-
-(defun find-menu-item-1 (menubar item-path-list &optional parent)
- (check-argument-type 'listp item-path-list)
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (when (stringp (car rest))
- (setq rest (cdr rest)))
- (while (keywordp (car rest))
- (setq rest (cddr rest)))
- (while rest
- (if (and (car rest)
- (stringp (car item-path-list))
- (= 0 (compare-menu-text (car item-path-list)
- (menu-item-text (car rest)))))
- (setq result (car rest)
- rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (cond ((consp result)
- (find-menu-item-1 (cdr result) (cdr item-path-list) result))
- (result
- (signal 'error (list (gettext "not a submenu") result)))
- (t
- (signal 'error (list (gettext "no such submenu")
- (car item-path-list)))))
- (cons result parent)))))
+ (labels
+ ((find-menu-item-1 (menubar item-path-list &optional parent)
+ (check-argument-type 'listp item-path-list)
+ (if (not (consp menubar))
+ nil
+ (let ((rest menubar)
+ result)
+ (when (stringp (car rest))
+ (setq rest (cdr rest)))
+ (while (keywordp (car rest))
+ (setq rest (cddr rest)))
+ (while rest
+ (if (and (car rest)
+ (stringp (car item-path-list))
+ (= 0 (compare-menu-text (car item-path-list)
+ (menu-item-text (car rest)))))
+ (setq result (car rest)
+ rest nil)
+ (setq rest (cdr rest))))
+ (if (cdr item-path-list)
+ (cond ((consp result)
+ (find-menu-item-1 (cdr result) (cdr item-path-list)
+ result))
+ (result
+ (signal 'error (list (gettext "not a submenu") result)))
+ (t
+ (signal 'error (list (gettext "no such submenu")
+ (car item-path-list)))))
+ (cons result parent))))))
+ (find-menu-item-1 menubar item-path-list)))
(defun add-menu-item-1 (leaf-p menu-path new-item before in-menu)
;; This code looks like it could be cleaned up some more
diff -r 0df3cedee9ac -r 5d3bb1100832 lisp/window-xemacs.el
--- a/lisp/window-xemacs.el Fri Mar 02 18:26:14 2012 +0000
+++ b/lisp/window-xemacs.el Sat Apr 07 21:57:31 2012 +0100
＠＠ -756,18 +756,11 ＠＠
:type 'integer
:group 'windows)
-;; Deiconify the frame containing the window WINDOW, then return WINDOW.
-
-(defun display-buffer-1 (window)
- (if (frame-iconified-p (window-frame window))
- (make-frame-visible (window-frame window)))
- window)
-
;; Can you believe that all of this crap was formerly in C?
;; Praise Jesus that it's not there any more.
(defun display-buffer (buffer &optional not-this-window-p override-frame
- shrink-to-fit)
+ shrink-to-fit)
"Make BUFFER appear in some window on the current frame, but don't select it.
BUFFER can be a buffer or a buffer name.
If BUFFER is shown already in some window in the current frame,
＠＠ -797,271 +790,275 ＠＠
Returns the window displaying BUFFER."
(interactive "BDisplay buffer:\nP")
- (let ((wconfig (current-window-configuration))
- (result
- ;; We just simulate a `return' in C. This function is way ugly
- ;; and does `returns' all over the place and there's no sense
- ;; in trying to rewrite it to be more Lispy.
- (catch 'done
- (let (window old-frame target-frame explicit-frame shrink-it)
- (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
- (setq buffer (get-buffer buffer))
- (check-argument-type 'bufferp buffer)
+ (let ((wconfig (current-window-configuration)))
+ (prog1
+ ;; We just simulate a `return' in C. This function is way
+ ;; ugly and does `returns' all over the place and there's
+ ;; no sense in trying to rewrite it to be more Lispy.
+ (block nil
+ (labels
+ ((display-buffer-1 (window)
+ ;; Deiconify the frame containing the window WINDOW, then
+ ;; return WINDOW.
+ (if (frame-iconified-p (window-frame window))
+ (make-frame-visible (window-frame window)))
+ window))
+ (let (window old-frame target-frame explicit-frame shrink-it)
+ (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
+ (setq buffer (get-buffer buffer))
+ (check-argument-type 'bufferp buffer)
- (setq explicit-frame
- (if pre-display-buffer-function
- (funcall pre-display-buffer-function buffer
- not-this-window-p
- override-frame
- shrink-to-fit)))
+ (setq explicit-frame
+ (if pre-display-buffer-function
+ (funcall pre-display-buffer-function buffer
+ not-this-window-p
+ override-frame
+ shrink-to-fit)))
- ;; Give the user the ability to completely reimplement
- ;; this function via the `display-buffer-function'.
- (if display-buffer-function
- (throw 'done
- (funcall display-buffer-function buffer
- not-this-window-p
- override-frame
- shrink-to-fit)))
+ ;; Give the user the ability to completely reimplement
+ ;; this function via the `display-buffer-function'.
+ (if display-buffer-function
+ (return (funcall display-buffer-function buffer
+ not-this-window-p
+ override-frame
+ shrink-to-fit)))
- ;; If the buffer has a dedicated frame, that takes
- ;; precedence over the current frame, and over what the
- ;; pre-display-buffer-function did.
- (let ((dedi (buffer-dedicated-frame buffer)))
- (if (frame-live-p dedi) (setq explicit-frame dedi)))
+ ;; If the buffer has a dedicated frame, that takes
+ ;; precedence over the current frame, and over what the
+ ;; pre-display-buffer-function did.
+ (let ((dedi (buffer-dedicated-frame buffer)))
+ (if (frame-live-p dedi) (setq explicit-frame dedi)))
- ;; if override-frame is supplied, that takes precedence over
- ;; everything. This is gonna look bad if the
- ;; pre-display-buffer-function raised some other frame
- ;; already.
- (if override-frame
- (progn
- (check-argument-type 'frame-live-p override-frame)
- (setq explicit-frame override-frame)))
+ ;; if override-frame is supplied, that takes precedence over
+ ;; everything. This is gonna look bad if the
+ ;; pre-display-buffer-function raised some other frame already.
+ (if override-frame
+ (progn
+ (check-argument-type 'frame-live-p override-frame)
+ (setq explicit-frame override-frame)))
- (setq target-frame
- (or explicit-frame
- (last-nonminibuf-frame)
- (selected-frame)))
+ (setq target-frame
+ (or explicit-frame
+ (last-nonminibuf-frame)
+ (selected-frame)))
- ;; If we have switched frames, then set not-this-window-p
- ;; to false. Switching frames means that selected-window
- ;; is no longer the same as it was on entry -- it's the
- ;; selected-window of target_frame instead of old_frame,
- ;; so it's a fine candidate for display.
- (if (not (eq old-frame target-frame))
- (setq not-this-window-p nil))
+ ;; If we have switched frames, then set not-this-window-p to
+ ;; false. Switching frames means that selected-window is no
+ ;; longer the same as it was on entry -- it's the
+ ;; selected-window of target_frame instead of old_frame, so
+ ;; it's a fine candidate for display.
+ (if (not (eq old-frame target-frame))
+ (setq not-this-window-p nil))
- ;; if it's in the selected window, and that's ok, then we're done.
- (if (and (not not-this-window-p)
- (eq buffer (window-buffer (selected-window))))
- (throw 'done (display-buffer-1 (selected-window))))
+ ;; if it's in the selected window, and that's ok, then we're
+ ;; done.
+ (if (and (not not-this-window-p)
+ (eq buffer (window-buffer (selected-window))))
+ (return (display-buffer-1 (selected-window))))
- ;; See if the user has specified this buffer should appear
- ;; in the selected window.
+ ;; See if the user has specified this buffer should
+ ;; appear in the selected window.
- (if not-this-window-p
- nil
+ (if not-this-window-p
+ nil
+ (if (or (member (buffer-name buffer) same-window-buffer-names)
+ (assoc (buffer-name buffer) same-window-buffer-names))
+ (progn
+ (switch-to-buffer buffer)
+ (return (display-buffer-1 (selected-window)))))
- (if (or (member (buffer-name buffer) same-window-buffer-names)
- (assoc (buffer-name buffer) same-window-buffer-names))
- (progn
- (switch-to-buffer buffer)
- (throw 'done (display-buffer-1 (selected-window)))))
+ (let ((tem same-window-regexps))
+ (while tem
+ (let ((car (car tem)))
+ (if (or
+ (and (stringp car)
+ (string-match car (buffer-name buffer)))
+ (and (consp car) (stringp (car car))
+ (string-match (car car) (buffer-name buffer))))
+ (progn
+ (switch-to-buffer buffer)
+ (return (display-buffer-1 (selected-window))))))
+ (setq tem (cdr tem)))))
- (let ((tem same-window-regexps))
- (while tem
- (let ((car (car tem)))
- (if (or
- (and (stringp car)
- (string-match car (buffer-name buffer)))
- (and (consp car) (stringp (car car))
- (string-match (car car) (buffer-name buffer))))
- (progn
- (switch-to-buffer buffer)
- (throw 'done (display-buffer-1
- (selected-window))))))
- (setq tem (cdr tem)))))
+ ;; If pop-up-frames, look for a window showing BUFFER
+ ;; on any visible or iconified frame. Otherwise search
+ ;; only the current frame.
+ (if (and (not explicit-frame)
+ (or pop-up-frames (not (last-nonminibuf-frame))))
+ (setq target-frame 0))
- ;; If pop-up-frames, look for a window showing BUFFER on
- ;; any visible or iconified frame. Otherwise search only
- ;; the current frame.
- (if (and (not explicit-frame)
- (or pop-up-frames (not (last-nonminibuf-frame))))
- (setq target-frame 0))
+ ;; Otherwise, find some window that it's already in,
+ ;; and return that, unless that window is the selected
+ ;; window and that isn't ok. What a contorted mess!
+ (setq window (or (if (not explicit-frame)
+ ;; search the selected frame
+ ;; first if the user didn't
+ ;; specify an explicit frame.
+ (get-buffer-window buffer nil))
+ (get-buffer-window buffer target-frame)))
+ (if (and window
+ (or (not not-this-window-p)
+ (not (eq window (selected-window)))))
+ (return (display-buffer-1 window)))
+ ;; Certain buffer names get special handling.
+ (if special-display-function
+ (progn
+ (if (member (buffer-name buffer)
+ special-display-buffer-names)
+ (return (funcall special-display-function buffer)))
- ;; Otherwise, find some window that it's already in, and
- ;; return that, unless that window is the selected window
- ;; and that isn't ok. What a contorted mess!
- (setq window (or (if (not explicit-frame)
- ;; search the selected frame
- ;; first if the user didn't
- ;; specify an explicit frame.
- (get-buffer-window buffer nil))
- (get-buffer-window buffer target-frame)))
- (if (and window
- (or (not not-this-window-p)
- (not (eq window (selected-window)))))
- (throw 'done (display-buffer-1 window)))
+ (let ((tem (assoc (buffer-name buffer)
+ special-display-buffer-names)))
+ (if tem
+ (return (funcall special-display-function
+ buffer (cdr tem)))))
- ;; Certain buffer names get special handling.
- (if special-display-function
- (progn
- (if (member (buffer-name buffer)
- special-display-buffer-names)
- (throw 'done (funcall special-display-function buffer)))
+ (let ((tem special-display-regexps))
+ (while tem
+ (let ((car (car tem)))
+ (if (and (stringp car)
+ (string-match car (buffer-name buffer)))
+ (return
+ (funcall special-display-function buffer)))
+ (if (and (consp car)
+ (stringp (car car))
+ (string-match (car car)
+ (buffer-name buffer)))
+ (return (funcall special-display-function buffer
+ (cdr car)))))
+ (setq tem (cdr tem))))))
- (let ((tem (assoc (buffer-name buffer)
- special-display-buffer-names)))
- (if tem
- (throw 'done (funcall special-display-function
- buffer (cdr tem)))))
+ ;; If there are no frames open that have more than a minibuffer,
+ ;; we need to create a new frame.
+ (if (or pop-up-frames
+ (null (last-nonminibuf-frame)))
+ (progn
+ (setq window (frame-selected-window
+ (funcall pop-up-frame-function)))
+ (set-window-buffer window buffer)
+ (return (display-buffer-1 window))))
- (let ((tem special-display-regexps))
- (while tem
- (let ((car (car tem)))
- (if (and (stringp car)
- (string-match car (buffer-name buffer)))
- (throw 'done
- (funcall special-display-function buffer)))
- (if (and (consp car)
- (stringp (car car))
- (string-match (car car)
- (buffer-name buffer)))
- (throw 'done (funcall
- special-display-function buffer
- (cdr car)))))
- (setq tem (cdr tem))))))
+ ;; Otherwise, make it be in some window, splitting if
+ ;; appropriate/possible. Do not split a window if we
+ ;; are displaying the buffer in a different frame than
+ ;; that which was current when we were called. (It is
+ ;; already in a different window by virtue of being in
+ ;; another frame.)
+ (if (or (and pop-up-windows (eq target-frame old-frame))
+ (eq 'only (frame-property (selected-frame) 'minibuffer))
+ ;; If the current frame is a special display frame,
+ ;; don't try to reuse its windows.
+ (window-dedicated-p
+ (frame-root-window (selected-frame))))
+ (progn
+ (if (eq 'only (frame-property (selected-frame)
+ 'minibuffer))
+ (setq target-frame (last-nonminibuf-frame)))
- ;; If there are no frames open that have more than a minibuffer,
- ;; we need to create a new frame.
- (if (or pop-up-frames
- (null (last-nonminibuf-frame)))
- (progn
- (setq window (frame-selected-window
- (funcall pop-up-frame-function)))
- (set-window-buffer window buffer)
- (throw 'done (display-buffer-1 window))))
+ ;; Don't try to create a window if would get an error with
+ ;; height.
+ (if (< split-height-threshold (* 2 window-min-height))
+ (setq split-height-threshold (* 2 window-min-height)))
- ;; Otherwise, make it be in some window, splitting if
- ;; appropriate/possible. Do not split a window if we are
- ;; displaying the buffer in a different frame than that which
- ;; was current when we were called. (It is already in a
- ;; different window by virtue of being in another frame.)
- (if (or (and pop-up-windows (eq target-frame old-frame))
- (eq 'only (frame-property (selected-frame) 'minibuffer))
- ;; If the current frame is a special display frame,
- ;; don't try to reuse its windows.
- (window-dedicated-p (frame-root-window (selected-frame))))
- (progn
- (if (eq 'only (frame-property (selected-frame) 'minibuffer))
- (setq target-frame (last-nonminibuf-frame)))
+ ;; Same with width.
+ (if (< split-width-threshold (* 2 window-min-width))
+ (setq split-width-threshold (* 2 window-min-width)))
- ;; Don't try to create a window if would get an error with
- ;; height.
- (if (< split-height-threshold (* 2 window-min-height))
- (setq split-height-threshold (* 2 window-min-height)))
+ ;; If the frame we would try to split cannot be split,
+ ;; try other frames.
+ (if (frame-property (if (null target-frame)
+ (selected-frame)
+ (last-nonminibuf-frame))
+ 'unsplittable)
+ (setq window
+ ;; Try visible frames first.
+ (or (get-largest-window 'visible)
+ ;; If that didn't work, try iconified frames.
+ (get-largest-window 0)
+ (get-largest-window t)))
+ (setq window (get-largest-window target-frame)))
- ;; Same with width.
- (if (< split-width-threshold (* 2 window-min-width))
- (setq split-width-threshold (* 2 window-min-width)))
+ ;; If we got a tall enough full-width window that
+ ;; can be split, split it.
+ (if (and window
+ (not (frame-property (window-frame window)
+ 'unsplittable))
+ (>= (window-height window) split-height-threshold)
+ (or (>= (window-width window)
+ split-width-threshold)
+ (and (window-leftmost-p window)
+ (window-rightmost-p window))))
+ (setq window (split-window window))
+ (let (upper other)
+ (setq window (get-lru-window target-frame))
+ ;; If the LRU window is selected, and big enough,
+ ;; and can be split, split it.
+ (if (and window
+ (not (frame-property (window-frame window)
+ 'unsplittable))
+ (or (eq window (selected-window))
+ (not (window-parent window)))
+ (>= (window-height window)
+ (* 2 window-min-height)))
+ (setq window (split-window window)))
+ ;; If get-lru-window returned nil, try other
+ ;; approaches. Try visible frames first.
+ (or window
+ (setq window (or (get-largest-window 'visible)
+ ;; If that didn't work, try
+ ;; iconified frames.
+ (get-largest-window 0)
+ ;; Try invisible frames.
+ (get-largest-window t)
+ ;; As a last resort, make
+ ;; a new frame.
+ (frame-selected-window
+ (funcall
+ pop-up-frame-function)))))
+ ;; If window appears above or below another,
+ ;; even out their heights.
+ (if (window-previous-child window)
+ (setq other (window-previous-child window)
+ upper other))
+ (if (window-next-child window)
+ (setq other (window-next-child window)
+ upper window))
+ ;; Check that OTHER and WINDOW are vertically arrayed.
+ (if (and other
+ (not (= (nth 1 (window-pixel-edges other))
+ (nth 1 (window-pixel-edges window))))
+ (> (window-pixel-height other)
+ (window-pixel-height window)))
+ (enlarge-window (- (/ (+ (window-height other)
+ (window-height window))
+ 2)
+ (window-height upper))
+ nil upper))
+ ;; Klaus Berndl <klaus.berndl(a)sdm.de>: Only in
+ ;; this situation we shrink-to-fit but we can do
+ ;; this first after we have displayed buffer in
+ ;; window (s.b. (set-window-buffer window buffer))
+ (setq shrink-it shrink-to-fit))))
- ;; If the frame we would try to split cannot be split,
- ;; try other frames.
- (if (frame-property (if (null target-frame)
- (selected-frame)
- (last-nonminibuf-frame))
- 'unsplittable)
- (setq window
- ;; Try visible frames first.
- (or (get-largest-window 'visible)
- ;; If that didn't work, try iconified frames.
- (get-largest-window 0)
- (get-largest-window t)))
- (setq window (get-largest-window target-frame)))
+ (setq window (get-lru-window target-frame)))
- ;; If we got a tall enough full-width window that
- ;; can be split, split it.
- (if (and window
- (not (frame-property (window-frame window)
- 'unsplittable))
- (>= (window-height window) split-height-threshold)
- (or (>= (window-width window)
- split-width-threshold)
- (and (window-leftmost-p window)
- (window-rightmost-p window))))
- (setq window (split-window window))
- (let (upper other)
- (setq window (get-lru-window target-frame))
- ;; If the LRU window is selected, and big enough,
- ;; and can be split, split it.
- (if (and window
- (not (frame-property (window-frame window)
- 'unsplittable))
- (or (eq window (selected-window))
- (not (window-parent window)))
- (>= (window-height window)
- (* 2 window-min-height)))
- (setq window (split-window window)))
- ;; If get-lru-window returned nil, try other approaches.
- ;; Try visible frames first.
- (or window
- (setq window (or (get-largest-window 'visible)
- ;; If that didn't work, try
- ;; iconified frames.
- (get-largest-window 0)
- ;; Try invisible frames.
- (get-largest-window t)
- ;; As a last resort, make
- ;; a new frame.
- (frame-selected-window
- (funcall
- pop-up-frame-function)))))
- ;; If window appears above or below another,
- ;; even out their heights.
- (if (window-previous-child window)
- (setq other (window-previous-child window)
- upper other))
- (if (window-next-child window)
- (setq other (window-next-child window)
- upper window))
- ;; Check that OTHER and WINDOW are vertically arrayed.
- (if (and other
- (not (= (nth 1 (window-pixel-edges other))
- (nth 1 (window-pixel-edges window))))
- (> (window-pixel-height other)
- (window-pixel-height window)))
- (enlarge-window (- (/ (+ (window-height other)
- (window-height window))
- 2)
- (window-height upper))
- nil upper))
- ;; Klaus Berndl <klaus.berndl(a)sdm.de>: Only in
- ;; this situation we shrink-to-fit but we can do
- ;; this first after we have displayed buffer in
- ;; window (s.b. (set-window-buffer window buffer))
- (setq shrink-it shrink-to-fit))))
+ ;; Bring the window's previous buffer to the top of the
+ ;; MRU chain.
+ (if (window-buffer window)
+ (save-excursion
+ (save-selected-window
+ (select-window window)
+ (record-buffer (window-buffer window)))))
- (setq window (get-lru-window target-frame)))
+ (set-window-buffer window buffer)
- ;; Bring the window's previous buffer to the top of the MRU chain.
- (if (window-buffer window)
- (save-excursion
- (save-selected-window
- (select-window window)
- (record-buffer (window-buffer window)))))
-
- (set-window-buffer window buffer)
-
- ;; Now window's previous buffer has been brought to the top
- ;; of the MRU chain and window displays buffer - now we can
- ;; shrink-to-fit if necessary
- (if shrink-it
- (shrink-window-if-larger-than-buffer window))
-
- (display-buffer-1 window)))))
- (or (equal wconfig (current-window-configuration))
- (push-window-configuration wconfig))
- result))
+ ;; Now window's previous buffer has been brought to the
+ ;; top of the MRU chain and window displays buffer -
+ ;; now we can shrink-to-fit if necessary
+ (if shrink-it
+ (shrink-window-if-larger-than-buffer window))
+ (display-buffer-1 window)))) ;; End of prog1's 1th form.
+ (or (equal wconfig (current-window-configuration))
+ (push-window-configuration wconfig)))))
;;; window-xemacs.el ends here
--
‘Iodine deficiency was endemic in parts of the UK until, through what has been
described as “an unplanned and accidental public health triumph”, iodine was
added to cattle feed to improve milk production in the 1930s.’
(EN Pearce, Lancet, June 2011)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: Remove some utility functions from the global namespace, lisp/
12 years, 8 months
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/changeset/5d3bb1100832/
changeset: 5d3bb1100832
user: kehoea
date: 2012-04-07 22:57:31
summary: Remove some utility functions from the global namespace, lisp/
lisp/ChangeLog addition:
2012-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
Remove some utility functions from the global namespace, it's more
appropriate to have them as labels (that is, lexically-visible
functions.)
* behavior.el:
* behavior.el (behavior-menu-filter-1): Moved to being a label.
* behavior.el (behavior-menu-filter): Use the label.
* cus-edit.el (custom-load-symbol-1): Moved to being a label.
* cus-edit.el (custom-load-symbol): Use the label.
* menubar.el (find-menu-item-1): Moved to being a label.
* menubar.el (find-menu-item): Use the label.
* window-xemacs.el:
* window-xemacs.el (display-buffer-1): Moved to being a label.
* window-xemacs.el (display-buffer): Use the label; use (block
...) instead of (catch ...), use prog1 instead of needlessly
binding a variable.
affected #: 5 files
diff -r 0df3cedee9ac6e12eac0e246466909560da38b3b -r 5d3bb11008322a79591b3535a0658ab36d6610f2 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
＠＠ -1,3 +1,21 ＠＠
+2012-04-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Remove some utility functions from the global namespace, it's more
+ appropriate to have them as labels (that is, lexically-visible
+ functions.)
+ * behavior.el:
+ * behavior.el (behavior-menu-filter-1): Moved to being a label.
+ * behavior.el (behavior-menu-filter): Use the label.
+ * cus-edit.el (custom-load-symbol-1): Moved to being a label.
+ * cus-edit.el (custom-load-symbol): Use the label.
+ * menubar.el (find-menu-item-1): Moved to being a label.
+ * menubar.el (find-menu-item): Use the label.
+ * window-xemacs.el:
+ * window-xemacs.el (display-buffer-1): Moved to being a label.
+ * window-xemacs.el (display-buffer): Use the label; use (block
+ ...) instead of (catch ...), use prog1 instead of needlessly
+ binding a variable.
+
2012-03-02 Aidan Kehoe <kehoea(a)parhasard.net>
* select.el (select-coerce):
diff -r 0df3cedee9ac6e12eac0e246466909560da38b3b -r 5d3bb11008322a79591b3535a0658ab36d6610f2 lisp/behavior.el
--- a/lisp/behavior.el
+++ b/lisp/behavior.el
＠＠ -414,90 +414,96 ＠＠
)
)
-(defun behavior-menu-filter-1 (menu group)
- (submenu-generate-accelerator-spec
- (let* (
- ;;options
- ;;help
- (enable
- (menu-split-long-menu
- (menu-sort-menu
- (let ((group-plist (gethash group behavior-group-hash-table)))
- (loop for behavior in (getf group-plist :children)
- nconc (if (behavior-group-p behavior)
- (list
- (cons (getf
- (gethash behavior behavior-group-hash-table)
- :short-doc)
- (behavior-menu-filter-1 menu behavior)))
- (let* ((plist (gethash behavior behavior-hash-table))
- (commands (getf plist :commands)))
- (nconc
- (if (getf plist :enable)
- `([,(format "%s (%s) [toggle]"
- (getf plist :short-doc)
- behavior)
- (if (memq ',behavior
- enabled-behavior-list)
- (disable-behavior ',behavior)
- (enable-behavior ',behavior))
- :active ,(if (getf plist :disable) t
- (not (memq
- ',behavior
- enabled-behavior-list)))
- :style toggle
- :selected (memq ',behavior
- enabled-behavior-list)]))
- (cond ((null commands) nil)
- ((and (eq (length commands) 1)
- (vectorp (elt commands 0)))
- (let ((comm (copy-sequence
- (elt commands 0))))
- (setf (elt comm 0)
- (format "%s (%s)"
- (elt comm 0) behavior))
- (list comm)))
- (t (list
- (cons (format "%s (%s) Commands"
- (getf plist :short-doc)
- behavior)
- commands)))))))))
- ))
- )
- )
- enable)
- '(?p)))
-
(defun behavior-menu-filter (menu)
- (append
- `(("%_Package Utilities"
- ("%_Set Download Site"
- ("%_Official Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-download-menu)))))
- ("%_Pre-Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-pre-release-download-menu)))))
- ("%_Site Releases"
- :filter ,#'(lambda (&rest junk)
- (menu-split-long-menu
- (submenu-generate-accelerator-spec
- (package-ui-site-release-download-menu))))))
- "--:shadowEtchedIn"
- ["%_Update Package Index" package-get-update-base]
- ["%_List and Install" pui-list-packages]
- ["U%_pdate Installed Packages" package-get-update-all]
- ["%_Help" (Info-goto-node "(xemacs)Packages")])
- "----")
- (behavior-menu-filter-1 menu nil)))
+ (labels
+ ((behavior-menu-filter-1 (menu group)
+ (submenu-generate-accelerator-spec
+ (let* ((enable
+ (menu-split-long-menu
+ (menu-sort-menu
+ (let ((group-plist (gethash group
+ behavior-group-hash-table)))
+ (loop for behavior in (getf group-plist :children)
+ nconc (if (behavior-group-p behavior)
+ (list
+ (cons (getf
+ (gethash behavior
+ behavior-group-hash-table)
+ :short-doc)
+ (behavior-menu-filter-1
+ menu behavior)))
+ (let* ((plist (gethash behavior
+ behavior-hash-table))
+ (commands (getf plist :commands)))
+ (nconc
+ (if (getf plist :enable)
+ `([,(format "%s (%s) [toggle]"
+ (getf plist :short-doc)
+ behavior)
+ (if (memq ',behavior
+ enabled-behavior-list)
+ (disable-behavior ',behavior)
+ (enable-behavior ',behavior))
+ :active ,(if (getf plist :disable)
+ t
+ (not
+ (memq
+ ',behavior
+ enabled-behavior-list)))
+ :style toggle
+ :selected (memq
+ ',behavior
+ enabled-behavior-list)]))
+ (cond ((null commands) nil)
+ ((and (eq (length commands) 1)
+ (vectorp (elt commands 0)))
+ (let ((comm (copy-sequence
+ (elt commands 0))))
+ (setf (elt comm 0)
+ (format "%s (%s)"
+ (elt comm 0)
+ behavior))
+ (list comm)))
+ (t (list
+ (cons (format "%s (%s) Commands"
+ (getf plist
+ :short-doc)
+ behavior)
+ commands)))))))))
+ ))
+ )
+ )
+ enable)
+ '(?p))))
+ (append
+ `(("%_Package Utilities"
+ ("%_Set Download Site"
+ ("%_Official Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-download-menu)))))
+ ("%_Pre-Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-pre-release-download-menu)))))
+ ("%_Site Releases"
+ :filter ,#'(lambda (&rest junk)
+ (menu-split-long-menu
+ (submenu-generate-accelerator-spec
+ (package-ui-site-release-download-menu))))))
+ "--:shadowEtchedIn"
+ ["%_Update Package Index" package-get-update-base]
+ ["%_List and Install" pui-list-packages]
+ ["U%_pdate Installed Packages" package-get-update-all]
+ ["%_Help" (Info-goto-node "(xemacs)Packages")])
+ "----")
+ (behavior-menu-filter-1 menu nil))))
;; Initialize top-level group.
(puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table)
(provide 'behavior)
-;;; finder-inf.el ends here
+;;; behavior.el ends here
diff -r 0df3cedee9ac6e12eac0e246466909560da38b3b -r 5d3bb11008322a79591b3535a0658ab36d6610f2 lisp/cus-edit.el
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
＠＠ -1684,33 +1684,28 ＠＠
(defun custom-load-symbol (symbol)
"Load all dependencies for SYMBOL."
- (unless custom-load-recursion
- (let ((custom-load-recursion t)
- (loads (get symbol 'custom-loads))
- load)
- (while loads
- (setq load (car loads)
- loads (cdr loads))
- (custom-load-symbol-1 load)))))
-
-(defun custom-load-symbol-1 (load)
- (cond ((symbolp load)
- (condition-case nil
- (require load)
- (error nil)))
- ;; Don't reload a file already loaded.
- ((and (boundp 'preloaded-file-list)
- (member load preloaded-file-list)))
- ((assoc load load-history))
- ((assoc (locate-library load) load-history))
- (t
- (condition-case nil
- ;; Without this, we would load cus-edit recursively.
- ;; We are still loading it when we call this,
- ;; and it is not in load-history yet.
- (or (equal load "cus-edit")
- (load-library load))
- (error nil)))))
+ (labels
+ ((custom-load-symbol-1 (load)
+ (cond ((symbolp load)
+ (condition-case nil
+ (require load)
+ (error nil)))
+ ;; Don't reload a file already loaded.
+ ((and (boundp 'preloaded-file-list)
+ (member load preloaded-file-list)))
+ ((assoc load load-history))
+ ((assoc (locate-library load) load-history))
+ (t
+ (condition-case nil
+ ;; Without this, we would load cus-edit recursively.
+ ;; We are still loading it when we call this,
+ ;; and it is not in load-history yet.
+ (or (equal load "cus-edit")
+ (load-library load))
+ (error nil))))))
+ (unless custom-load-recursion
+ (let ((custom-load-recursion t))
+ (map nil #'custom-load-symbol-1 (get symbol 'custom-loads))))))
(defvar custom-already-loaded-custom-defines nil
"List of already-loaded `custom-defines' files.")
diff -r 0df3cedee9ac6e12eac0e246466909560da38b3b -r 5d3bb11008322a79591b3535a0658ab36d6610f2 lisp/menubar.el
--- a/lisp/menubar.el
+++ b/lisp/menubar.el
＠＠ -178,35 +178,36 ＠＠
the item found.
If the item does not exist, the car of the returned value is nil.
If some menu in the ITEM-PATH-LIST does not exist, an error is signalled."
- (find-menu-item-1 menubar item-path-list))
-
-(defun find-menu-item-1 (menubar item-path-list &optional parent)
- (check-argument-type 'listp item-path-list)
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (when (stringp (car rest))
- (setq rest (cdr rest)))
- (while (keywordp (car rest))
- (setq rest (cddr rest)))
- (while rest
- (if (and (car rest)
- (stringp (car item-path-list))
- (= 0 (compare-menu-text (car item-path-list)
- (menu-item-text (car rest)))))
- (setq result (car rest)
- rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (cond ((consp result)
- (find-menu-item-1 (cdr result) (cdr item-path-list) result))
- (result
- (signal 'error (list (gettext "not a submenu") result)))
- (t
- (signal 'error (list (gettext "no such submenu")
- (car item-path-list)))))
- (cons result parent)))))
+ (labels
+ ((find-menu-item-1 (menubar item-path-list &optional parent)
+ (check-argument-type 'listp item-path-list)
+ (if (not (consp menubar))
+ nil
+ (let ((rest menubar)
+ result)
+ (when (stringp (car rest))
+ (setq rest (cdr rest)))
+ (while (keywordp (car rest))
+ (setq rest (cddr rest)))
+ (while rest
+ (if (and (car rest)
+ (stringp (car item-path-list))
+ (= 0 (compare-menu-text (car item-path-list)
+ (menu-item-text (car rest)))))
+ (setq result (car rest)
+ rest nil)
+ (setq rest (cdr rest))))
+ (if (cdr item-path-list)
+ (cond ((consp result)
+ (find-menu-item-1 (cdr result) (cdr item-path-list)
+ result))
+ (result
+ (signal 'error (list (gettext "not a submenu") result)))
+ (t
+ (signal 'error (list (gettext "no such submenu")
+ (car item-path-list)))))
+ (cons result parent))))))
+ (find-menu-item-1 menubar item-path-list)))
(defun add-menu-item-1 (leaf-p menu-path new-item before in-menu)
;; This code looks like it could be cleaned up some more
diff -r 0df3cedee9ac6e12eac0e246466909560da38b3b -r 5d3bb11008322a79591b3535a0658ab36d6610f2 lisp/window-xemacs.el
--- a/lisp/window-xemacs.el
+++ b/lisp/window-xemacs.el
＠＠ -756,18 +756,11 ＠＠
:type 'integer
:group 'windows)
-;; Deiconify the frame containing the window WINDOW, then return WINDOW.
-
-(defun display-buffer-1 (window)
- (if (frame-iconified-p (window-frame window))
- (make-frame-visible (window-frame window)))
- window)
-
;; Can you believe that all of this crap was formerly in C?
;; Praise Jesus that it's not there any more.
(defun display-buffer (buffer &optional not-this-window-p override-frame
- shrink-to-fit)
+ shrink-to-fit)
"Make BUFFER appear in some window on the current frame, but don't select it.
BUFFER can be a buffer or a buffer name.
If BUFFER is shown already in some window in the current frame,
＠＠ -797,271 +790,275 ＠＠
Returns the window displaying BUFFER."
(interactive "BDisplay buffer:\nP")
- (let ((wconfig (current-window-configuration))
- (result
- ;; We just simulate a `return' in C. This function is way ugly
- ;; and does `returns' all over the place and there's no sense
- ;; in trying to rewrite it to be more Lispy.
- (catch 'done
- (let (window old-frame target-frame explicit-frame shrink-it)
- (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
- (setq buffer (get-buffer buffer))
- (check-argument-type 'bufferp buffer)
+ (let ((wconfig (current-window-configuration)))
+ (prog1
+ ;; We just simulate a `return' in C. This function is way
+ ;; ugly and does `returns' all over the place and there's
+ ;; no sense in trying to rewrite it to be more Lispy.
+ (block nil
+ (labels
+ ((display-buffer-1 (window)
+ ;; Deiconify the frame containing the window WINDOW, then
+ ;; return WINDOW.
+ (if (frame-iconified-p (window-frame window))
+ (make-frame-visible (window-frame window)))
+ window))
+ (let (window old-frame target-frame explicit-frame shrink-it)
+ (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
+ (setq buffer (get-buffer buffer))
+ (check-argument-type 'bufferp buffer)
- (setq explicit-frame
- (if pre-display-buffer-function
- (funcall pre-display-buffer-function buffer
- not-this-window-p
- override-frame
- shrink-to-fit)))
+ (setq explicit-frame
+ (if pre-display-buffer-function
+ (funcall pre-display-buffer-function buffer
+ not-this-window-p
+ override-frame
+ shrink-to-fit)))
- ;; Give the user the ability to completely reimplement
- ;; this function via the `display-buffer-function'.
- (if display-buffer-function
- (throw 'done
- (funcall display-buffer-function buffer
- not-this-window-p
- override-frame
- shrink-to-fit)))
+ ;; Give the user the ability to completely reimplement
+ ;; this function via the `display-buffer-function'.
+ (if display-buffer-function
+ (return (funcall display-buffer-function buffer
+ not-this-window-p
+ override-frame
+ shrink-to-fit)))
- ;; If the buffer has a dedicated frame, that takes
- ;; precedence over the current frame, and over what the
- ;; pre-display-buffer-function did.
- (let ((dedi (buffer-dedicated-frame buffer)))
- (if (frame-live-p dedi) (setq explicit-frame dedi)))
+ ;; If the buffer has a dedicated frame, that takes
+ ;; precedence over the current frame, and over what the
+ ;; pre-display-buffer-function did.
+ (let ((dedi (buffer-dedicated-frame buffer)))
+ (if (frame-live-p dedi) (setq explicit-frame dedi)))
- ;; if override-frame is supplied, that takes precedence over
- ;; everything. This is gonna look bad if the
- ;; pre-display-buffer-function raised some other frame
- ;; already.
- (if override-frame
- (progn
- (check-argument-type 'frame-live-p override-frame)
- (setq explicit-frame override-frame)))
+ ;; if override-frame is supplied, that takes precedence over
+ ;; everything. This is gonna look bad if the
+ ;; pre-display-buffer-function raised some other frame already.
+ (if override-frame
+ (progn
+ (check-argument-type 'frame-live-p override-frame)
+ (setq explicit-frame override-frame)))
- (setq target-frame
- (or explicit-frame
- (last-nonminibuf-frame)
- (selected-frame)))
+ (setq target-frame
+ (or explicit-frame
+ (last-nonminibuf-frame)
+ (selected-frame)))
- ;; If we have switched frames, then set not-this-window-p
- ;; to false. Switching frames means that selected-window
- ;; is no longer the same as it was on entry -- it's the
- ;; selected-window of target_frame instead of old_frame,
- ;; so it's a fine candidate for display.
- (if (not (eq old-frame target-frame))
- (setq not-this-window-p nil))
+ ;; If we have switched frames, then set not-this-window-p to
+ ;; false. Switching frames means that selected-window is no
+ ;; longer the same as it was on entry -- it's the
+ ;; selected-window of target_frame instead of old_frame, so
+ ;; it's a fine candidate for display.
+ (if (not (eq old-frame target-frame))
+ (setq not-this-window-p nil))
- ;; if it's in the selected window, and that's ok, then we're done.
- (if (and (not not-this-window-p)
- (eq buffer (window-buffer (selected-window))))
- (throw 'done (display-buffer-1 (selected-window))))
+ ;; if it's in the selected window, and that's ok, then we're
+ ;; done.
+ (if (and (not not-this-window-p)
+ (eq buffer (window-buffer (selected-window))))
+ (return (display-buffer-1 (selected-window))))
- ;; See if the user has specified this buffer should appear
- ;; in the selected window.
+ ;; See if the user has specified this buffer should
+ ;; appear in the selected window.
- (if not-this-window-p
- nil
+ (if not-this-window-p
+ nil
+ (if (or (member (buffer-name buffer) same-window-buffer-names)
+ (assoc (buffer-name buffer) same-window-buffer-names))
+ (progn
+ (switch-to-buffer buffer)
+ (return (display-buffer-1 (selected-window)))))
- (if (or (member (buffer-name buffer) same-window-buffer-names)
- (assoc (buffer-name buffer) same-window-buffer-names))
- (progn
- (switch-to-buffer buffer)
- (throw 'done (display-buffer-1 (selected-window)))))
+ (let ((tem same-window-regexps))
+ (while tem
+ (let ((car (car tem)))
+ (if (or
+ (and (stringp car)
+ (string-match car (buffer-name buffer)))
+ (and (consp car) (stringp (car car))
+ (string-match (car car) (buffer-name buffer))))
+ (progn
+ (switch-to-buffer buffer)
+ (return (display-buffer-1 (selected-window))))))
+ (setq tem (cdr tem)))))
- (let ((tem same-window-regexps))
- (while tem
- (let ((car (car tem)))
- (if (or
- (and (stringp car)
- (string-match car (buffer-name buffer)))
- (and (consp car) (stringp (car car))
- (string-match (car car) (buffer-name buffer))))
- (progn
- (switch-to-buffer buffer)
- (throw 'done (display-buffer-1
- (selected-window))))))
- (setq tem (cdr tem)))))
+ ;; If pop-up-frames, look for a window showing BUFFER
+ ;; on any visible or iconified frame. Otherwise search
+ ;; only the current frame.
+ (if (and (not explicit-frame)
+ (or pop-up-frames (not (last-nonminibuf-frame))))
+ (setq target-frame 0))
- ;; If pop-up-frames, look for a window showing BUFFER on
- ;; any visible or iconified frame. Otherwise search only
- ;; the current frame.
- (if (and (not explicit-frame)
- (or pop-up-frames (not (last-nonminibuf-frame))))
- (setq target-frame 0))
+ ;; Otherwise, find some window that it's already in,
+ ;; and return that, unless that window is the selected
+ ;; window and that isn't ok. What a contorted mess!
+ (setq window (or (if (not explicit-frame)
+ ;; search the selected frame
+ ;; first if the user didn't
+ ;; specify an explicit frame.
+ (get-buffer-window buffer nil))
+ (get-buffer-window buffer target-frame)))
+ (if (and window
+ (or (not not-this-window-p)
+ (not (eq window (selected-window)))))
+ (return (display-buffer-1 window)))
+ ;; Certain buffer names get special handling.
+ (if special-display-function
+ (progn
+ (if (member (buffer-name buffer)
+ special-display-buffer-names)
+ (return (funcall special-display-function buffer)))
- ;; Otherwise, find some window that it's already in, and
- ;; return that, unless that window is the selected window
- ;; and that isn't ok. What a contorted mess!
- (setq window (or (if (not explicit-frame)
- ;; search the selected frame
- ;; first if the user didn't
- ;; specify an explicit frame.
- (get-buffer-window buffer nil))
- (get-buffer-window buffer target-frame)))
- (if (and window
- (or (not not-this-window-p)
- (not (eq window (selected-window)))))
- (throw 'done (display-buffer-1 window)))
+ (let ((tem (assoc (buffer-name buffer)
+ special-display-buffer-names)))
+ (if tem
+ (return (funcall special-display-function
+ buffer (cdr tem)))))
- ;; Certain buffer names get special handling.
- (if special-display-function
- (progn
- (if (member (buffer-name buffer)
- special-display-buffer-names)
- (throw 'done (funcall special-display-function buffer)))
+ (let ((tem special-display-regexps))
+ (while tem
+ (let ((car (car tem)))
+ (if (and (stringp car)
+ (string-match car (buffer-name buffer)))
+ (return
+ (funcall special-display-function buffer)))
+ (if (and (consp car)
+ (stringp (car car))
+ (string-match (car car)
+ (buffer-name buffer)))
+ (return (funcall special-display-function buffer
+ (cdr car)))))
+ (setq tem (cdr tem))))))
- (let ((tem (assoc (buffer-name buffer)
- special-display-buffer-names)))
- (if tem
- (throw 'done (funcall special-display-function
- buffer (cdr tem)))))
+ ;; If there are no frames open that have more than a minibuffer,
+ ;; we need to create a new frame.
+ (if (or pop-up-frames
+ (null (last-nonminibuf-frame)))
+ (progn
+ (setq window (frame-selected-window
+ (funcall pop-up-frame-function)))
+ (set-window-buffer window buffer)
+ (return (display-buffer-1 window))))
- (let ((tem special-display-regexps))
- (while tem
- (let ((car (car tem)))
- (if (and (stringp car)
- (string-match car (buffer-name buffer)))
- (throw 'done
- (funcall special-display-function buffer)))
- (if (and (consp car)
- (stringp (car car))
- (string-match (car car)
- (buffer-name buffer)))
- (throw 'done (funcall
- special-display-function buffer
- (cdr car)))))
- (setq tem (cdr tem))))))
+ ;; Otherwise, make it be in some window, splitting if
+ ;; appropriate/possible. Do not split a window if we
+ ;; are displaying the buffer in a different frame than
+ ;; that which was current when we were called. (It is
+ ;; already in a different window by virtue of being in
+ ;; another frame.)
+ (if (or (and pop-up-windows (eq target-frame old-frame))
+ (eq 'only (frame-property (selected-frame) 'minibuffer))
+ ;; If the current frame is a special display frame,
+ ;; don't try to reuse its windows.
+ (window-dedicated-p
+ (frame-root-window (selected-frame))))
+ (progn
+ (if (eq 'only (frame-property (selected-frame)
+ 'minibuffer))
+ (setq target-frame (last-nonminibuf-frame)))
- ;; If there are no frames open that have more than a minibuffer,
- ;; we need to create a new frame.
- (if (or pop-up-frames
- (null (last-nonminibuf-frame)))
- (progn
- (setq window (frame-selected-window
- (funcall pop-up-frame-function)))
- (set-window-buffer window buffer)
- (throw 'done (display-buffer-1 window))))
+ ;; Don't try to create a window if would get an error with
+ ;; height.
+ (if (< split-height-threshold (* 2 window-min-height))
+ (setq split-height-threshold (* 2 window-min-height)))
- ;; Otherwise, make it be in some window, splitting if
- ;; appropriate/possible. Do not split a window if we are
- ;; displaying the buffer in a different frame than that which
- ;; was current when we were called. (It is already in a
- ;; different window by virtue of being in another frame.)
- (if (or (and pop-up-windows (eq target-frame old-frame))
- (eq 'only (frame-property (selected-frame) 'minibuffer))
- ;; If the current frame is a special display frame,
- ;; don't try to reuse its windows.
- (window-dedicated-p (frame-root-window (selected-frame))))
- (progn
- (if (eq 'only (frame-property (selected-frame) 'minibuffer))
- (setq target-frame (last-nonminibuf-frame)))
+ ;; Same with width.
+ (if (< split-width-threshold (* 2 window-min-width))
+ (setq split-width-threshold (* 2 window-min-width)))
- ;; Don't try to create a window if would get an error with
- ;; height.
- (if (< split-height-threshold (* 2 window-min-height))
- (setq split-height-threshold (* 2 window-min-height)))
+ ;; If the frame we would try to split cannot be split,
+ ;; try other frames.
+ (if (frame-property (if (null target-frame)
+ (selected-frame)
+ (last-nonminibuf-frame))
+ 'unsplittable)
+ (setq window
+ ;; Try visible frames first.
+ (or (get-largest-window 'visible)
+ ;; If that didn't work, try iconified frames.
+ (get-largest-window 0)
+ (get-largest-window t)))
+ (setq window (get-largest-window target-frame)))
- ;; Same with width.
- (if (< split-width-threshold (* 2 window-min-width))
- (setq split-width-threshold (* 2 window-min-width)))
+ ;; If we got a tall enough full-width window that
+ ;; can be split, split it.
+ (if (and window
+ (not (frame-property (window-frame window)
+ 'unsplittable))
+ (>= (window-height window) split-height-threshold)
+ (or (>= (window-width window)
+ split-width-threshold)
+ (and (window-leftmost-p window)
+ (window-rightmost-p window))))
+ (setq window (split-window window))
+ (let (upper other)
+ (setq window (get-lru-window target-frame))
+ ;; If the LRU window is selected, and big enough,
+ ;; and can be split, split it.
+ (if (and window
+ (not (frame-property (window-frame window)
+ 'unsplittable))
+ (or (eq window (selected-window))
+ (not (window-parent window)))
+ (>= (window-height window)
+ (* 2 window-min-height)))
+ (setq window (split-window window)))
+ ;; If get-lru-window returned nil, try other
+ ;; approaches. Try visible frames first.
+ (or window
+ (setq window (or (get-largest-window 'visible)
+ ;; If that didn't work, try
+ ;; iconified frames.
+ (get-largest-window 0)
+ ;; Try invisible frames.
+ (get-largest-window t)
+ ;; As a last resort, make
+ ;; a new frame.
+ (frame-selected-window
+ (funcall
+ pop-up-frame-function)))))
+ ;; If window appears above or below another,
+ ;; even out their heights.
+ (if (window-previous-child window)
+ (setq other (window-previous-child window)
+ upper other))
+ (if (window-next-child window)
+ (setq other (window-next-child window)
+ upper window))
+ ;; Check that OTHER and WINDOW are vertically arrayed.
+ (if (and other
+ (not (= (nth 1 (window-pixel-edges other))
+ (nth 1 (window-pixel-edges window))))
+ (> (window-pixel-height other)
+ (window-pixel-height window)))
+ (enlarge-window (- (/ (+ (window-height other)
+ (window-height window))
+ 2)
+ (window-height upper))
+ nil upper))
+ ;; Klaus Berndl <klaus.berndl(a)sdm.de>: Only in
+ ;; this situation we shrink-to-fit but we can do
+ ;; this first after we have displayed buffer in
+ ;; window (s.b. (set-window-buffer window buffer))
+ (setq shrink-it shrink-to-fit))))
- ;; If the frame we would try to split cannot be split,
- ;; try other frames.
- (if (frame-property (if (null target-frame)
- (selected-frame)
- (last-nonminibuf-frame))
- 'unsplittable)
- (setq window
- ;; Try visible frames first.
- (or (get-largest-window 'visible)
- ;; If that didn't work, try iconified frames.
- (get-largest-window 0)
- (get-largest-window t)))
- (setq window (get-largest-window target-frame)))
+ (setq window (get-lru-window target-frame)))
- ;; If we got a tall enough full-width window that
- ;; can be split, split it.
- (if (and window
- (not (frame-property (window-frame window)
- 'unsplittable))
- (>= (window-height window) split-height-threshold)
- (or (>= (window-width window)
- split-width-threshold)
- (and (window-leftmost-p window)
- (window-rightmost-p window))))
- (setq window (split-window window))
- (let (upper other)
- (setq window (get-lru-window target-frame))
- ;; If the LRU window is selected, and big enough,
- ;; and can be split, split it.
- (if (and window
- (not (frame-property (window-frame window)
- 'unsplittable))
- (or (eq window (selected-window))
- (not (window-parent window)))
- (>= (window-height window)
- (* 2 window-min-height)))
- (setq window (split-window window)))
- ;; If get-lru-window returned nil, try other approaches.
- ;; Try visible frames first.
- (or window
- (setq window (or (get-largest-window 'visible)
- ;; If that didn't work, try
- ;; iconified frames.
- (get-largest-window 0)
- ;; Try invisible frames.
- (get-largest-window t)
- ;; As a last resort, make
- ;; a new frame.
- (frame-selected-window
- (funcall
- pop-up-frame-function)))))
- ;; If window appears above or below another,
- ;; even out their heights.
- (if (window-previous-child window)
- (setq other (window-previous-child window)
- upper other))
- (if (window-next-child window)
- (setq other (window-next-child window)
- upper window))
- ;; Check that OTHER and WINDOW are vertically arrayed.
- (if (and other
- (not (= (nth 1 (window-pixel-edges other))
- (nth 1 (window-pixel-edges window))))
- (> (window-pixel-height other)
- (window-pixel-height window)))
- (enlarge-window (- (/ (+ (window-height other)
- (window-height window))
- 2)
- (window-height upper))
- nil upper))
- ;; Klaus Berndl <klaus.berndl(a)sdm.de>: Only in
- ;; this situation we shrink-to-fit but we can do
- ;; this first after we have displayed buffer in
- ;; window (s.b. (set-window-buffer window buffer))
- (setq shrink-it shrink-to-fit))))
+ ;; Bring the window's previous buffer to the top of the
+ ;; MRU chain.
+ (if (window-buffer window)
+ (save-excursion
+ (save-selected-window
+ (select-window window)
+ (record-buffer (window-buffer window)))))
- (setq window (get-lru-window target-frame)))
+ (set-window-buffer window buffer)
- ;; Bring the window's previous buffer to the top of the MRU chain.
- (if (window-buffer window)
- (save-excursion
- (save-selected-window
- (select-window window)
- (record-buffer (window-buffer window)))))
-
- (set-window-buffer window buffer)
-
- ;; Now window's previous buffer has been brought to the top
- ;; of the MRU chain and window displays buffer - now we can
- ;; shrink-to-fit if necessary
- (if shrink-it
- (shrink-window-if-larger-than-buffer window))
-
- (display-buffer-1 window)))))
- (or (equal wconfig (current-window-configuration))
- (push-window-configuration wconfig))
- result))
+ ;; Now window's previous buffer has been brought to the
+ ;; top of the MRU chain and window displays buffer -
+ ;; now we can shrink-to-fit if necessary
+ (if shrink-it
+ (shrink-window-if-larger-than-buffer window))
+ (display-buffer-1 window)))) ;; End of prog1's 1th form.
+ (or (equal wconfig (current-window-configuration))
+ (push-window-configuration wconfig)))))
;;; window-xemacs.el ends here
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments