Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 4833:4dd2389173fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sun, 10 Jan 2010 01:06:15 -0600
parents 0142cb4d1049
children 755ae5b97edb
comparison
equal deleted inserted replaced
4832:07fa38c30fdf 4833:4dd2389173fc
1116 (while plist 1116 (while plist
1117 (setq alist (cons (cons (car plist) (cadr plist)) alist)) 1117 (setq alist (cons (cons (car plist) (cadr plist)) alist))
1118 (setq plist (cddr plist))) 1118 (setq plist (cddr plist)))
1119 (nreverse alist))) 1119 (nreverse alist)))
1120 1120
1121 (defun map-plist (_mp_fun _mp_plist) 1121 ((macro
1122 "Map _MP_FUN (a function of two args) over each key/value pair in _MP_PLIST. 1122 . (lambda (map-plist-definition)
1123 "Replace the variable names in MAP-PLIST-DEFINITION with uninterned
1124 symbols, avoiding the risk of interference with variables in other functions
1125 introduced by dynamic scope."
1126 (if-fboundp 'nsublis
1127 (nsublis
1128 '((mp-function . #:function)
1129 (plist . #:plist)
1130 (result . #:result))
1131 map-plist-definition)
1132 map-plist-definition)))
1133 (defun map-plist (mp-function plist)
1134 "Map FUNCTION (a function of two args) over each key/value pair in PLIST.
1123 Return a list of the results." 1135 Return a list of the results."
1124 (let (_mp_result) 1136 (let (result)
1125 (while _mp_plist 1137 (while plist
1126 (push (funcall _mp_fun (car _mp_plist) (cadr _mp_plist)) _mp_result) 1138 (push (funcall mp-function (car plist) (cadr plist)) result)
1127 (setq _mp_plist (cddr _mp_plist))) 1139 (setq plist (cddr plist)))
1128 (nreverse _mp_result))) 1140 (nreverse result))))
1129 1141
1130 (defun destructive-plist-to-alist (plist) 1142 (defun destructive-plist-to-alist (plist)
1131 "Convert property list PLIST into the equivalent association-list form. 1143 "Convert property list PLIST into the equivalent association-list form.
1132 The alist is returned. This converts from 1144 The alist is returned. This converts from
1133 1145
1462 (let ((operation "unknown") 1474 (let ((operation "unknown")
1463 (error-form nil) 1475 (error-form nil)
1464 (no-backtrace nil) 1476 (no-backtrace nil)
1465 (class ''general) 1477 (class ''general)
1466 (level ''warning) 1478 (level ''warning)
1467 (resignal nil)) 1479 (resignal nil)
1480 (cte-cc-var '#:cte-cc-var)
1481 (call-trapping-errors-arg '#:call-trapping-errors-Ldc9FC5Hr))
1468 (let* ((keys '(operation error-form no-backtrace class level resignal)) 1482 (let* ((keys '(operation error-form no-backtrace class level resignal))
1469 (keys-with-colon 1483 (keys-with-colon
1470 (mapcar #'(lambda (sym) 1484 (mapcar #'(lambda (sym)
1471 (intern (concat ":" (symbol-name sym)))) keys))) 1485 (intern (concat ":" (symbol-name sym)))) keys)))
1472 (while (memq (car keys-body) keys-with-colon) 1486 (while (memq (car keys-body) keys-with-colon)
1473 (let* ((key-with-colon (pop keys-body)) 1487 (let* ((key-with-colon (pop keys-body))
1474 (key (intern (substring (symbol-name key-with-colon) 1)))) 1488 (key (intern (substring (symbol-name key-with-colon) 1))))
1475 (set key (pop keys-body))))) 1489 (set key (pop keys-body)))))
1476 `(condition-case ,(if resignal '__cte_cc_var__ nil) 1490 `(condition-case ,(if resignal cte-cc-var nil)
1477 (call-with-condition-handler 1491 (call-with-condition-handler
1478 #'(lambda (__call_trapping_errors_arg__) 1492 #'(lambda (,call-trapping-errors-arg)
1479 (let ((errstr (error-message-string 1493 (let ((errstr (error-message-string
1480 __call_trapping_errors_arg__))) 1494 ,call-trapping-errors-arg)))
1481 ,(if no-backtrace 1495 ,(if no-backtrace
1482 `(lwarn ,class ,level 1496 `(lwarn ,class ,level
1483 (if (warning-level-< 1497 (if (warning-level-<
1484 ,level 1498 ,level
1485 display-warning-minimum-level) 1499 display-warning-minimum-level)
1488 ,operation errstr) 1502 ,operation errstr)
1489 `(lwarn ,class ,level 1503 `(lwarn ,class ,level
1490 "Error in %s: %s\n\nBacktrace follows:\n\n%s" 1504 "Error in %s: %s\n\nBacktrace follows:\n\n%s"
1491 ,operation errstr 1505 ,operation errstr
1492 (backtrace-in-condition-handler-eliminating-handler 1506 (backtrace-in-condition-handler-eliminating-handler
1493 '__call_trapping_errors_arg__))))) 1507 ',call-trapping-errors-arg)))))
1494 #'(lambda () 1508 #'(lambda ()
1495 (progn ,@keys-body))) 1509 (progn ,@keys-body)))
1496 (error 1510 (error
1497 ,error-form 1511 ,error-form
1498 ,@(if resignal '((signal (car __cte_cc_var__) (cdr __cte_cc_var__))))) 1512 ,@(if resignal `((signal (car ,cte-cc-var) (cdr ,cte-cc-var)))))
1499 ))) 1513 )))
1500 1514
1501 ;;;; Miscellanea. 1515 ;;;; Miscellanea.
1502 1516
1503 ;; This is now in C. 1517 ;; This is now in C.