- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r2331 - in branches/bos/projects/bos: . m2 payment-website/images worldpay-test
by bknr＠bknr.net 17 Jan '08

17 Jan '08

Author: hhubner Date: 2008-01-17 10:24:19 -0500 (Thu, 17 Jan 2008) New Revision: 2331 Modified: branches/bos/projects/bos/README branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/m2/mail-generator.lisp branches/bos/projects/bos/m2/packages.lisp branches/bos/projects/bos/payment-website/images/header_ganzneu.gif branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp Log: Send out re-generated print certificate by email. Tag mails by sponsor country for filtering. Modified: branches/bos/projects/bos/README =================================================================== --- branches/bos/projects/bos/README 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/README 2008-01-17 15:24:19 UTC (rev 2331) @@ -4,7 +4,7 @@ Vorbereitung ------------ - - CMUCL 19a installieren, so dass "lisp" im Pfad ist + - CMUCL 19c installieren, so dass "lisp" im Pfad ist - Komplettes cvs auschecken: $ cvs -d :ext:bknr.net:/home/bknr/cvs co -d bknr.net . Modified: branches/bos/projects/bos/m2/m2.lisp =================================================================== --- branches/bos/projects/bos/m2/m2.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/m2.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -286,20 +286,34 @@ (defmethod contract-pdf-url ((contract contract)) (format nil "/certificate/~A" (store-object-id contract))) +(defmethod contract-certificates-generated-p (contract) + (and (probe-file (contract-pdf-pathname contract)) + (or (contract-download-only-p contract) + (probe-file (contract-pdf-pathname contract :print t))))) + +(defmethod contract-delete-certificate-files (contract) + (ignore-errors + (delete-file (contract-pdf-pathname contract)) + (delete-file (contract-pdf-pathname contract :print t)))) + +(defun wait-for-certificates (contract) + "Wait until the PDF generating process has generated the certificates" + (dotimes (i 10) + (when (contract-certificates-generated-p contract) + (return)) + (sleep 1)) + (unless (contract-certificates-generated-p contract) + (error "Cannot generate certificate"))) + (defmethod contract-issue-cert ((contract contract) name &key address language) - (if (contract-cert-issued contract) - (warn "can't re-issue cert for ~A" contract) - (progn - (make-certificate contract name :address address :language language) - (unless (contract-download-only-p contract) - (make-certificate contract name :address address :language language :print t)) - (dotimes (i 10) - (when (probe-file (contract-pdf-pathname contract)) - (return)) - (sleep 1)) - (if (probe-file (contract-pdf-pathname contract)) - (change-slot-values contract 'cert-issued t) - (error "Cannot generate certificate"))))) + (when (contract-cert-issued contract) + (warn "re-issuing cert for ~A" contract)) + (contract-delete-certificate-files contract) + (make-certificate contract name :address address :language language) + (unless (contract-download-only-p contract) + (make-certificate contract name :address address :language language :print t)) + (wait-for-certificates contract) + (change-slot-values contract 'cert-issued t)) (defmethod contract-image-tiles ((contract contract)) (let (image-tiles) Modified: branches/bos/projects/bos/m2/mail-generator.lisp =================================================================== --- branches/bos/projects/bos/m2/mail-generator.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/mail-generator.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -214,14 +214,40 @@ :content-type nil :more-headers t :text (with-output-to-string (s) + (format s "X-BOS-Sponsor-Country: ~A~%" (sponsor-country (contract-sponsor contract))) (print-mime s (make-instance 'multipart-mime :subtype "mixed" :content parts) t t)))) - (unless (contract-download-only-p contract) + (when (contract-pdf-pathname contract :print t) (delete-file (contract-pdf-pathname contract :print t)))) +(defun mail-print-pdf (contract) + (send-system-mail + :to (contract-office-email contract) + :subject (format nil "PDF certificate (regenerated) - Sponsor-ID ~D Contract-ID ~D" + (store-object-id (contract-sponsor contract)) + (store-object-id contract)) + :content-type nil + :more-headers t + :text (with-output-to-string (s) + (format s "X-BOS-Sponsor-Country: ~A~%" (sponsor-country (contract-sponsor contract))) + (print-mime s + (make-instance + 'multipart-mime + :subtype "mixed" + :content (list + (make-instance + 'mime + :type "application" + :subtype (format nil "pdf; name=\"contract-~A.pdf\"" + (store-object-id contract)) + :encoding :base64 + :content (file-contents (contract-pdf-pathname contract :print t))))) + t t))) + (delete-file (contract-pdf-pathname contract :print t))) + (defun mail-backoffice-sponsor-data (contract req) (with-query-params (req numsqm country email name address date language) (let ((parts (list (make-html-part (format nil " Modified: branches/bos/projects/bos/m2/packages.lisp =================================================================== --- branches/bos/projects/bos/m2/packages.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/packages.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -195,6 +195,7 @@ #:mail-manual-sponsor-data #:mail-backoffice-sponsor-data #:mail-worldpay-sponsor-data + #:mail-print-pdf #:*cert-download-directory*)) Modified: branches/bos/projects/bos/payment-website/images/header_ganzneu.gif =================================================================== (Binary files differ) Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -304,7 +304,8 @@ (t (error "invalid sponsor or contract id ~A" object-id-string))))) (defmethod handle-object-form ((handler cert-regen-handler) action (contract contract) req) - (with-bos-cms-page (req :title "Re-generate Certificate") + (with-bos-cms-page (req :title (format nil "Re-generate Certificate~@[~*s~]" + (not (contract-download-only-p contract)))) (html ((:form :name "form") ((:table) @@ -319,12 +320,14 @@ (html (:tr (:td (submit-button "regenerate" "regenerate"))))))))) -(defun confirm-cert-regen (req) - (with-bos-cms-page (req :title "Certificate generation request has been created") - (html - "Your certificate generation request has been created, please wait a few seconds before checking the PDF file"))) - (defmethod handle-object-form ((handler cert-regen-handler) (action (eql :regenerate)) (contract contract) req) (with-query-params (req name address language) - (bos.m2::make-certificate contract name :address address :language language)) - (confirm-cert-regen req)) \ No newline at end of file + (contract-issue-cert contract name :address address :language language)) + (with-bos-cms-page (req :title "Certificate has been recreated") + (html "The certificates for the sponsor have been re-generated.") + (unless (contract-download-only-p contract) + (mail-print-pdf contract) + (let ((sponsor (contract-sponsor contract))) + (html "The print certificate has been sent to the relevant BOS office address by email." + :br + (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))))) \ No newline at end of file

1 0

[bknr-cvs] r2296 - in branches/trunk-reorg/projects/scrabble: src website
by bknr＠bknr.net 02 Dec '07

02 Dec '07

Author: hhubner Date: 2007-12-02 18:36:27 -0500 (Sun, 02 Dec 2007) New Revision: 2296 Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: Gameplay fixes. Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-12-02 18:46:42 UTC (rev 2295) +++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-12-02 23:36:27 UTC (rev 2296) @@ -55,6 +55,7 @@ (encode-json-plist (list :type "move" :participant-login (user-login (player-of (participant-of move))) :score (score-of move) + :player-score (score-of (participant-of move)) :placed-tiles (placed-tiles-of move) :words (mapcar (lambda (word-cons) (list (car word-cons) (cdr word-cons))) @@ -64,12 +65,14 @@ (defmethod encode-json ((move move-withdrawal) stream) (encode-json-plist (list :type "move-withdrawal" :participant-login (user-login (player-of (participant-of move))) + :player-score (score-of (participant-of move)) :reason (or (reason-of move) "")) stream)) (defmethod encode-json ((move tile-swap) stream) (encode-json-plist (list :type "tile-swap" :participant-login (user-login (player-of (participant-of move))) + :player-score (score-of (participant-of move)) :reason (count-of move)) stream)) @@ -92,6 +95,7 @@ (start-session) (encode-json-plist (append (list :login (user-login (player-of participant)) :name (user-full-name (player-of participant)) + :score (score-of participant) :remaining-tiles) (list (if (eq (player-of participant) (session-value :user)) Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-12-02 18:46:42 UTC (rev 2295) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-12-02 23:36:27 UTC (rev 2296) @@ -1,4 +1,4 @@ -// -*- Java -*- (really Javascript) +// -*- JavaScript -*- var boardScoring = [["triple-word",null,null,"double-letter",null,null,null,"triple-word", null,null,null,"double-letter",null,null,"triple-word"], @@ -38,7 +38,7 @@ // Given the board and list of placed tiles, either throw an error or // return if the move is legal. - var positions = map(function (placement) { return [ placement[0], placement[1] ] }, placedTiles) + var positions = map(function (placement) { return [ placement.x, placement.y ] }, placedTiles) .sort(function (a, b) { return (a[0] - b[0]) || (a[1] - b[1])}); if (filter(partial(operator.ne, positions[0][0]), map(function (position) { return position[0] }, positions)).length @@ -133,6 +133,13 @@ nextTurn.style.textAlign = 'left'; setElementPosition(nextTurn, { x: border + 680, y: border + 665 }); appendChildNodes($('playfield'), nextTurn); + + var nextTurn = DIV({ id: 'status' }, ""); + nextTurn.style.position = 'absolute'; + nextTurn.style.width = '280px'; + nextTurn.style.textAlign = 'left'; + setElementPosition(nextTurn, { x: border + 680, y: border + 680 }); + appendChildNodes($('playfield'), nextTurn); } function setLetter(x, y, letter, isBlank) { @@ -147,22 +154,11 @@ } function placeLetter(x, y, tile) { - var mask = IMG({ src: 'images/mask.png'}); - mask.style.position = 'absolute'; - mask.style.top = '3px'; - mask.style.left = '3px'; - mask.style.zIndex = '20'; - appendChildNodes(board[x][y], mask); - board[x][y].letterNode = tile; - board[x][y].letter = tile.letter; - board[x][y].justPlaced = true; - tile.anim = new YAHOO.util.Motion(tile, { points: { to: [ border + x * 44 + 3, - border + y * 44 + 3 ]}}, - 0.15, - YAHOO.util.Easing.easeBoth); - tile.anim.animate(); } +function removeLastLetterFromMove() { +} + function letterAt(x, y) { return board[x][y].letter && !board[x][y].justPlaced; } @@ -239,28 +235,74 @@ var move = []; -function makeMove(x, y, letter, isBlank) { - move[move.length] = [x, y, letter, isBlank]; +function makeMask() +{ + var mask = IMG({ src: 'images/mask.png'}); + mask.style.position = 'absolute'; + mask.style.top = '3px'; + mask.style.left = '3px'; + mask.style.zIndex = '20'; + return mask; +} + +function addLetterToMove(x, y, tile) { + mask = makeMask(); + appendChildNodes(board[x][y], mask); + board[x][y].letterNode = tile; + board[x][y].letter = tile.letter; + board[x][y].justPlaced = true; + tile.mask = mask; + tile.anim = new YAHOO.util.Motion(tile, { points: { to: [ border + x * 44 + 3, + border + y * 44 + 3 ]}}, + 0.15, + YAHOO.util.Easing.easeBoth); + tile.anim.animate(); + + move[move.length] = { x: x, y: y, tile: tile }; try { checkMoveLegality(move); $('move').onclick = submitMove; - $('move').innerHTML = move.toString(); + $('move').innerHTML = "submit move"; + displayStatus(''); } catch (e) { + if (typeof e != 'string') { + alert(e.message); + } else { + displayStatus(e); + } $('move').onclick = undefined; $('move').innerHTML = e.toString(); } } -function clearMove() { +function confirmMove() { + for (var i = 0; i < move.length; i++) { + removeElement(move[i].tile.mask); + move[i].tile.mask = undefined; + } + cursor.clear(); move = []; $('move').onclick = null; - $('move').innerHTML = '[no move]'; + $('move').innerHTML = ''; + } +function moveAsString() { + // We internally keep the move as array of objects, but send it to the server rather unstructured: + var serverMessage = []; + for (var i = 0; i < move.length; i++) { + serverMessage.push(move[i].x); + serverMessage.push(move[i].y); + serverMessage.push(move[i].tile.letterName); + serverMessage.push(move[i].tile.letterName == undefined); + } + return serverMessage.toString(); +} + function submitMove() { - var queryString = MochiKit.Base.queryString({ move: move.toString(), game: gameID }); + var queryString = MochiKit.Base.queryString({ move: moveAsString(), game: gameID }); var res = MochiKit.Async.doXHR("/place-tiles", { method: 'POST', sendContent: queryString, @@ -270,20 +312,27 @@ function moveSuccess(result) { - var response; try { - response = eval('(' + result.responseText + ')'); + var response; + try { + response = eval('(' + result.responseText + ')'); + } + catch (e) { + alert("invalid JSON reply: " + result.responseText); + return; + } + if (response.error) { + alert(response.error); + } else { + confirmMove(); + alert(response.move.playerScore); + $('playfield')['score-' + response.move.participantLogin].innerHTML = response.move.playerScore.toString(); + displayMyTray(response.tray); + } } catch (e) { - alert("invalid JSON reply: " + result.responseText); - return; + alert('error during moveSuccess: ' + e.message); } - if (response.error) { - alert(response.error); - } else { - clearMove(); - makeMyTray(response.tray); - } } function moveFailure(e) @@ -315,18 +364,17 @@ } } if (tilePosition == -1) { - alert("You don't have letter + '" + letter + "'!"); + displayStatus('you-dont-have-that-letter', letter); } else { var isHoriz; if (move.length > 0) { - isHoriz = (move[0][0] != x); + isHoriz = (move[0].x != x); } cursor.advance(isHoriz); if (!letterAt(x, y)) { var tile = tray[tilePosition]; tray.splice(tilePosition, 1); - placeLetter(x, y, tile); - makeMove(x, y, tile.letterName, tile.letterName == undefined); + addLetterToMove(x, y, tile); } } } @@ -362,6 +410,10 @@ if (!letterAt(x, ++y)) break; break; + case backspaceKey: + if (move.length) { + removeLastLetterFromMove(); + } } if ((x >= 0) && (x <= 14) && (y >= 0) && (y <= 14)) { cursor.clear(); @@ -391,7 +443,7 @@ this.anim.animate(); } -function makeMyTray(letters) { +function displayMyTray(letters) { map(removeElement, tray); tray = []; for (var i = 0; i < letters.length; i++) { @@ -403,7 +455,7 @@ element.style.height = '34px'; element.style.zIndex = '10'; element.onclick = trayClick; - setElementPosition(element, { x: border + 194 + i * 40, y: border + 665 }); + setElementPosition(element, { x: border + i * 40, y: border + 665 }); tray[i] = element; } appendChildNodes($('playfield'), tray); @@ -428,7 +480,9 @@ var otherPlayerIndex = 0; -function makeTheirTray (name, tileCount) { +function makeTheirTray (participant) { + var tileCount = (typeof participant.remainingTiles == 'number') ? participant.remainingTiles : participant.remainingTiles.length; + var tray = []; for (var i = 0; i < tileCount; i++) { var element = IMG({src: 'images/null.png'}); @@ -441,12 +495,21 @@ } appendChildNodes($('playfield'), tray); - var nameTag = DIV(null, name); + var nameTag = DIV(null, participant.name); nameTag.style.position = 'absolute'; nameTag.style.width = '200px'; nameTag.style.textAlign = 'left'; setElementPosition(nameTag, { x: border + 680, y: border + 80 * otherPlayerIndex + 50 }); appendChildNodes($('playfield'), nameTag); + + var scoreTag = DIV(null, participant.score); + scoreTag.style.position = 'absolute'; + scoreTag.style.width = '80px'; + scoreTag.style.textAlign = 'right'; + setElementPosition(scoreTag, { x: border + 870, y: border + 80 * otherPlayerIndex + 50 }); + appendChildNodes($('playfield'), scoreTag); + $('playfield')['score-' + participant.login] = scoreTag; + otherPlayerIndex++; } @@ -465,32 +528,41 @@ return retval; } +function displayWhosTurnItIs(name) { + replaceChildNodes($('nextTurn'), + "Next: " + name); +} + function drawGameState (gameState) { - for (var i = 0; i < gameState.board.length; i++) { - var x = gameState.board[i][0]; - var y = gameState.board[i][1]; - var char = gameState.board[i][2]; - setLetter(x, y, char, gameState.board[i].length > 3); - } - var firstParticipant = gameState.participants[0]; - replaceChildNodes($('nextTurn'), - "It is " - + ((typeof firstParticipant.remainingTiles == 'number') ? (firstParticipant.name + "s") : "your") - + " turn"); - for (var i = 0; i < gameState.participants.length; i++) { - var participant = gameState.participants[i]; - if (typeof participant.remainingTiles == 'number') { - makeTheirTray(participant.name, participant.remainingTiles); - } else { - makeMyTray(participant.remainingTiles); + try { + for (var i = 0; i < gameState.board.length; i++) { + var x = gameState.board[i][0]; + var y = gameState.board[i][1]; + var char = gameState.board[i][2]; + setLetter(x, y, char, gameState.board[i].length > 3); } + var firstParticipant = gameState.participants[0]; + displayWhosTurnItIs(firstParticipant.name); + for (var i = 0; i < gameState.participants.length; i++) { + var participant = gameState.participants[i]; + makeTheirTray(participant); + if (typeof participant.remainingTiles != 'number') { + displayMyTray(participant.remainingTiles); + } + } + for (var i = 0; i < gameState.moves.length; i++) { + appendChildNodes($('gameLog'), DIV(null, renderMoveAsText(gameState.moves[i]))); + } } - for (var i = 0; i < gameState.moves.length; i++) { - appendChildNodes($('gameLog'), DIV(null, renderMoveAsText(gameState.moves[i]))); + catch (e) { + alert('error ' + e + ' in drawGameState'); } } -var legalLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".split(""); +function displayStatus(status) +{ + replaceChildNodes('status', status); +} function init() { makeBoard(); @@ -503,7 +575,7 @@ { fn: functionKeyPressed, scope: this, correctScope: true }); functionKeyListener.enable(); - var moveDisplay = DIV({ id: 'move' }, "[no move yet]"); + var moveDisplay = DIV({ id: 'move' }, ""); moveDisplay.style.color = 'white'; moveDisplay.style.position = 'absolute'; setElementPosition(moveDisplay, { x: border + 550, y: border + 665 });

1 0

[bknr-cvs] r2295 - in branches/trunk-reorg/thirdparty/slime: . CVS contrib contrib/CVS doc doc/CVS
by bknr＠bknr.net 02 Dec '07

02 Dec '07

Author: hhubner Date: 2007-12-02 13:46:42 -0500 (Sun, 02 Dec 2007) New Revision: 2295 Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries branches/trunk-reorg/thirdparty/slime/ChangeLog branches/trunk-reorg/thirdparty/slime/NEWS branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries branches/trunk-reorg/thirdparty/slime/doc/slime.texi branches/trunk-reorg/thirdparty/slime/slime.el branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp branches/trunk-reorg/thirdparty/slime/swank-loader.lisp branches/trunk-reorg/thirdparty/slime/swank.lisp Log: update slime from cvs Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/slime/CVS/Entries 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/CVS/Entries 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,9 +1,5 @@ -D/contrib//// -D/doc//// /.cvsignore/1.5/Thu Oct 11 14:10:25 2007// -/ChangeLog/1.1241/Wed Nov 14 21:30:35 2007// /HACKING/1.8/Thu Oct 11 14:10:25 2007// -/NEWS/1.8/Thu Oct 11 14:10:25 2007// /PROBLEMS/1.8/Thu Oct 11 14:10:25 2007// /README/1.14/Thu Oct 11 14:10:25 2007// /hyperspec.el/1.11/Thu Oct 11 14:10:25 2007// @@ -12,24 +8,28 @@ /nregex.lisp/1.4/Thu Oct 11 14:10:25 2007// /sbcl-pprint-patch.lisp/1.1/Thu Oct 11 14:10:25 2007// /slime-autoloads.el/1.3/Thu Oct 11 14:10:25 2007// -/slime.el/1.877/Wed Nov 14 21:30:35 2007// /swank-abcl.lisp/1.44/Wed Nov 14 21:30:35 2007// /swank-allegro.lisp/1.98/Thu Oct 11 14:10:25 2007// /swank-backend.lisp/1.126/Thu Oct 11 14:10:25 2007// /swank-clisp.lisp/1.64/Thu Oct 11 14:10:25 2007// -/swank-cmucl.lisp/1.174/Thu Oct 11 14:10:25 2007// /swank-corman.lisp/1.11/Thu Oct 11 14:10:25 2007// /swank-ecl.lisp/1.8/Thu Oct 11 14:10:25 2007// /swank-gray.lisp/1.10/Thu Oct 11 14:10:25 2007// -/swank-lispworks.lisp/1.92/Thu Oct 11 14:10:25 2007// -/swank-loader.lisp/1.74/Wed Nov 14 21:30:35 2007// /swank-openmcl.lisp/1.120/Wed Nov 14 21:30:35 2007// /swank-sbcl.lisp/1.185/Thu Oct 11 14:10:25 2007// /swank-scl.lisp/1.13/Thu Oct 11 14:10:25 2007// /swank-source-file-cache.lisp/1.8/Thu Oct 11 14:10:25 2007// /swank-source-path-parser.lisp/1.17/Thu Oct 11 14:10:25 2007// /swank.asd/1.5/Thu Oct 11 14:10:25 2007// -/swank.lisp/1.513/Wed Nov 14 21:30:35 2007// /test-all.sh/1.2/Thu Oct 11 14:10:25 2007// /test.sh/1.9/Thu Oct 11 14:10:25 2007// /xref.lisp/1.2/Thu Oct 11 14:10:25 2007// +D/contrib//// +D/doc//// +/ChangeLog/1.1254/Sun Dec 2 04:22:09 2007// +/NEWS/1.9/Sun Dec 2 04:22:09 2007// +/slime.el/1.882/Sun Dec 2 04:22:09 2007// +/swank-cmucl.lisp/1.175/Sun Dec 2 04:22:09 2007// +/swank-lispworks.lisp/1.93/Sun Dec 2 04:22:09 2007// +/swank-loader.lisp/1.75/Sun Dec 2 04:22:09 2007// +/swank.lisp/1.521/Sun Dec 2 04:22:09 2007// Modified: branches/trunk-reorg/thirdparty/slime/ChangeLog =================================================================== --- branches/trunk-reorg/thirdparty/slime/ChangeLog 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/ChangeLog 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,3 +1,118 @@ +2007-12-02 Alan Caulkins <fatman(a)maxint.net> + + Make it possible to close listening sockets. + + * swank.lisp (stop-server, restart-server): New functions. + (*listener-sockets*): New variable. + (setup-server): Store open sockets in *listener-sockets*. + +2007-12-02 Helmut Eller <heller(a)common-lisp.net> + + Add hook to customize the region used by C-c C-c. + Useful to recognize block declarations in CMUCL sources. + + * slime.el (slime-region-for-defun-function): New variable. + (slime-region-for-defun-at-point): Use it. + +2007-11-30 Helmut Eller <heller(a)common-lisp.net> + + Handle byte-functions without debug-info. + + * swank-cmucl.lisp (byte-function-location): Return an error + if the component has no debug-info. + +2007-11-30 Helmut Eller <heller(a)common-lisp.net> + + Disable the pretty-printer for backtraces. + Would be nice if we could print newlines in strings as \n. + + * swank.lisp (*backtrace-printer-bindings*): New varaible. + (backtrace, frame-locals-for-emacs): Use it. + +2007-11-29 Tobias C. Rittweiler <tcr(a)freebits.de> + + * swank.lisp (valid-function-name-p): Fixed wrt. setf functions. + +2007-11-29 Helmut Eller <heller(a)common-lisp.net> + + Prettify package names for slime-repl-set-package. + + * slime.el (slime-repl-set-package): slime-current-package may + have leading colons. Use slime-pretty-package-name to remove + them. Reported by Constantine Vetoshev. + (slime-pretty-current-package): New function. + (slime-set-package): Use it. + +2007-11-24 Helmut Eller <heller(a)common-lisp.net> + + Drop remaining dependencies on nregex. + + * swank-lispworks.lisp (unmangle-unfun): Use sys::setf-symbol-p + instead of regexp matching. + + * swank-loader.lisp (*sysdep-files*): Don't include nregex. + +2007-11-24 Helmut Eller <heller(a)common-lisp.net> + + Mirror *modules* in Emacs. + + * slime.el (slime-lisp-modules): New connction variable. + (slime-set-connection-info): Load requested modules. + (slime-required-modules): New variable. + (slime-require, slime-load-contribs): New functions. + + * swank.lisp (connection-info): Include *modules*. + (swank-require): Accept a list of modules as argument. + +2007-11-24 Helmut Eller <heller(a)common-lisp.net> + + * swank.lisp (parse-package): The old version didn't pass the + test-suite. Now use the reader directly instead of emulating it + half-heartedly. + + * slime.el (slime-search-buffer-package): Don't remove double + quotes or "#:", swank:parse-package takes care of that. + +2007-11-24 Helmut Eller <heller(a)common-lisp.net> + + * swank.lisp (apropos-symbols): Use simple search instead of + regexps. + (make-apropos-matcher): Used to be make-regexp-matcher. + + (*sldb-printer-bindings*): Set *print-right-margin* to + most-positive-fixnum. This prints each frame in the backtrace in a + single long line. But is suboptimal for other purposes, like + eval-in-frame. + + (setup-server): Initialize multiprocessing here, so that is also + done for create-server. + +2007-11-23 Tobias C. Rittweiler <tcr(a)freebits.de> + + * swank.lisp (swank-require): Fix typo (:key was used instead of + :test.) Reported by Stelian Ionescu. + +2007-11-22 Helmut Eller <heller(a)common-lisp.net> + + * swank.lisp (swank-require): Don't search the file if the + module-name is present in *modules*. That should avoid problems if + swank is included in a core file and moved to a different + location. Reported by John Wiegley. + +2007-11-19 Tobias C. Rittweiler <tcr(a)freebits.de> + + * slime.el (slime-repl-mode-map, slime-repl-read-mode), + (slime-compiler-notes-mode-map, slime-xref-mode-map), + (sldb-mode-map, slime-connection-list-mode-map), + (slime-inspector-mode-map): Added bindings for [return] in + addition to (kbd "RET"). The reason is that pressing enter in X is + translated to (kbd "RET") only if no binding for [return] is + active; if [return] is bound to something, pressing enter is + translated to this key binding henceforth, as was explained to me + by Pierre Gaston, thanks! This can cause quite confusing behaviour + as Andreas Davour faced in his post <cs9k5ofqbt7.fsf(a)Psilocybe.Update.UU.SE> + to comp.lang.lisp. + 2007-11-06 Helmut Eller <heller(a)common-lisp.net> * slime.el (slime-events-buffer, slime-inspector-buffer): Disable Modified: branches/trunk-reorg/thirdparty/slime/NEWS =================================================================== --- branches/trunk-reorg/thirdparty/slime/NEWS 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/NEWS 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,5 +1,54 @@ -* SLIME News -*- outline -*- +* SLIME News -*- outline -*- +* 3.0 (not released yet) + +** Removed Features +Some of the more esoteric features, like presentations or fuzzy +completion, are no longer enabled by default. A new directory +"contrib/" contains the code for these packages. To use them, you +must make some changes to your ~/.emacs. For details see, section +"Contributed Packages" in the manual. + +** Stepper +Juho Snellman implemented stepping commands for SBCL. + +** Completions +SLIME can now complete keywords and character names (like #\newline). + +* 2.0 (April 2006) + +** In-place macro expansion +Marco Baringer wrote a new minor mode to incrementally expand macros. + +** Improved arglist display +SLIME now recognizes `make-instance' calls and displays the correct +arglist if the classname is present. Similarly, for `defmethod' forms +SLIME displays the arguments of the generic function. + +** Persistent REPL history +SLIME now saves the command history from REPL buffers in a file and +reloads it for newly created REPL buffers. + +** Scieneer Common Lisp +Douglas Crosher added support for Scieneer Common Lisp. + +** SBCL +Various improvements to make SLIME work well with current SBCL versions. + +** Corman Common Lisp +Espen Wiborg added support for Corman Common Lisp. + +** Presentations +A new feature which associates objects in Lisp with their textual +represetation in Emacs. The text is clickable and operations on the +associated object can be invoked from a pop-up menu. + +** Security +SLIME has now a simple authentication mechanism: if the file +~/.slime-secret exists we verify that Emacs and Lisp can access it. +Since both parties have access to the same file system, we assume that +we can trust each other. + * 1.2 (March 2005) ** New inspector Modified: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,4 +1,3 @@ -/ChangeLog/1.64/Wed Nov 14 21:30:35 2007// /README/1.3/Thu Oct 11 14:10:25 2007// /bridge.el/1.1/Thu Oct 11 14:10:25 2007// /inferior-slime.el/1.2/Thu Oct 11 14:10:25 2007// @@ -9,7 +8,6 @@ /slime-editing-commands.el/1.5/Thu Oct 11 14:10:25 2007// /slime-fancy-inspector.el/1.2/Thu Oct 11 14:10:25 2007// /slime-fancy.el/1.4/Thu Oct 11 14:10:25 2007// -/slime-fuzzy.el/1.4/Thu Oct 11 14:10:25 2007// /slime-highlight-edits.el/1.3/Thu Oct 11 14:10:25 2007// /slime-parse.el/1.7/Thu Oct 11 14:10:25 2007// /slime-presentation-streams.el/1.2/Thu Oct 11 14:10:25 2007// @@ -19,12 +17,14 @@ /slime-tramp.el/1.2/Thu Oct 11 14:10:25 2007// /slime-typeout-frame.el/1.5/Thu Oct 11 14:10:25 2007// /slime-xref-browser.el/1.1/Thu Oct 11 14:10:25 2007// -/swank-arglists.lisp/1.12/Wed Nov 14 21:30:35 2007// /swank-asdf.lisp/1.1/Thu Oct 11 14:10:25 2007// /swank-c-p-c.lisp/1.2/Thu Oct 11 14:10:25 2007// -/swank-fancy-inspector.lisp/1.4/Thu Oct 11 14:10:25 2007// /swank-fuzzy.lisp/1.6/Thu Oct 11 14:10:25 2007// /swank-listener-hooks.lisp/1.1/Thu Oct 11 14:10:25 2007// /swank-presentation-streams.lisp/1.4/Thu Oct 11 14:10:25 2007// /swank-presentations.lisp/1.4/Thu Oct 11 14:10:25 2007// +/swank-fancy-inspector.lisp/1.5/Wed Nov 21 20:47:43 2007// +/ChangeLog/1.68/Sun Dec 2 04:22:09 2007// +/slime-fuzzy.el/1.5/Sun Dec 2 04:22:09 2007// +/swank-arglists.lisp/1.15/Sun Dec 2 04:22:10 2007// D Modified: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog =================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,3 +1,25 @@ +2007-11-27 Tobias C. Rittweiler <tcr(a)freebits.de> + + * swank-arglists.lisp (arglist-dispatch 'defmethod): Use + VALID-FUNCTION-NAME-P. Fixes error on certain `(defmethod (setf ...))' + forms. + +2007-11-27 Tobias C. Rittweiler <tcr(a)freebits.de> + + * swank-arglists.lisp (print-arglist): Print initforms in &optional and + &key lambda list specifiers as if by PRIN1 instead of PRINC. + Reported by Michael Weber. + +2007-11-24 Helmut Eller <heller(a)common-lisp.net> + + * slime-fuzzy.el: Use slime-require instead of a connected-hook. + +2007-11-20 Helmut Eller <heller(a)common-lisp.net> + + * swank-fancy-inspector.lisp (inspect-for-emacs function t): Don't + specialize the second argument, so that backend methods take + precedence. Reported by Maciej Katafiasz. + 2007-10-24 Tobias C. Rittweiler <tcr(a)freebits.de> * swank-arglist.lisp (decode-arglist): Fix incompatibility with Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el =================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el 2007-12-02 18:46:42 UTC (rev 2295) @@ -585,14 +585,12 @@ ;;; Initialization (defun slime-fuzzy-init () - (add-hook 'slime-connected-hook 'slime-fuzzy-on-connect) (slime-fuzzy-bind-keys)) (defun slime-fuzzy-bind-keys () (define-key slime-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol) (define-key slime-repl-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol)) -(defun slime-fuzzy-on-connect () - (slime-eval-async '(swank:swank-require :swank-fuzzy))) +(slime-require :swank-fuzzy) (provide 'slime-fuzzy) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -283,6 +283,7 @@ ;;; (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...)) ;;; +;; FIXME: This really ought to be rewritten. (defun print-arglist (arglist &key operator highlight) (let ((index 0) (need-space nil)) @@ -290,26 +291,29 @@ (typecase arg (arglist ; destructuring pattern (print-arglist arg)) - (optional-arg - (princ (encode-optional-arg arg))) + (optional-arg + (let ((enc-arg (encode-optional-arg arg))) + (if (symbolp enc-arg) + (princ enc-arg) + (destructuring-bind (var &optional (initform nil initform-p)) enc-arg + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (format t "~A~:[~; ~S~]" var initform-p initform)))))) (keyword-arg (let ((enc-arg (encode-keyword-arg arg))) (etypecase enc-arg (symbol (princ enc-arg)) - ((cons symbol) - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (princ (car enc-arg)) - (write-char #\space) - (pprint-fill *standard-output* (cdr enc-arg) nil))) + ((cons symbol) + (destructuring-bind (keyarg initform) enc-arg + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (format t "~A ~S" keyarg initform)))) ((cons cons) - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (prin1 (caar enc-arg)) - (write-char #\space) - (print-arg (keyword-arg.arg-name arg))) - (unless (null (cdr enc-arg)) - (write-char #\space)) - (pprint-fill *standard-output* (cdr enc-arg) nil)))))) + (destructuring-bind ((keyword-name var) &optional (initform nil initform-p)) + enc-arg + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (format t "~S ~A" keyword-name var)) + (when initform-p + (format t " ~S" initform)))))))) (t ; required formal or provided actual arg (if (keywordp arg) (prin1 arg) ; for &ANY args. @@ -1002,7 +1006,6 @@ (split-form-spec form-spec) (arglist-dispatch type operator arguments :remove-args remove-args)))) - (defmacro with-availability ((var) form &body body) `(let ((,var ,form)) (if (eql ,var :not-available) @@ -1039,9 +1042,7 @@ (not (null arguments)) ;have generic function name (notany #'listp (rest arguments))) ;don't have arglist yet (let* ((gf-name (first arguments)) - (gf (and (or (symbolp gf-name) - (and (listp gf-name) - (eql (first gf-name) 'setf))) + (gf (and (valid-function-name-p gf-name) (fboundp gf-name) (fdefinition gf-name)))) (when (typep gf 'generic-function) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -94,7 +94,7 @@ (t (list label ": " '(:newline) " " docstring '(:newline)))))) -(defmethod inspect-for-emacs ((f function) (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((f function) inspector) (declare (ignore inspector)) (values "A function." (append Modified: branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries =================================================================== --- branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries 2007-12-02 18:46:42 UTC (rev 2295) @@ -4,6 +4,6 @@ /slime-refcard.tex/1.1/Thu Oct 11 14:10:24 2007// /slime-small.eps/1.1/Thu Oct 11 14:10:24 2007// /slime-small.pdf/1.1/Thu Oct 11 14:10:24 2007// -/slime.texi/1.57/Thu Oct 11 14:10:24 2007// /texinfo-tabulate.awk/1.2/Thu Oct 11 14:10:24 2007// +/slime.texi/1.61/Sun Dec 2 04:22:10 2007// D Modified: branches/trunk-reorg/thirdparty/slime/doc/slime.texi =================================================================== --- branches/trunk-reorg/thirdparty/slime/doc/slime.texi 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/doc/slime.texi 2007-12-02 18:46:42 UTC (rev 2295) @@ -1,5 +1,5 @@ \input texinfo --@c %**start of header +@c %**start of header @setfilename slime.info @settitle The Superior Lisp Interaction Mode for Emacs @@ -7,12 +7,12 @@ @direntry * SLIME: (slime). Superior Lisp Interaction Mode for Emacs. @end direntry --@c %**end of header +@c %**end of header @set EDITION 3.0-alpha @set SLIMEVER 3.0-alpha @c @set UPDATED @today{} -@set UPDATED @code{$Date: 2007/09/17 13:44:48 $} +@set UPDATED @code{$Date: 2007/11/27 13:16:52 $} @set TITLE SLIME User Manual @settitle @value{TITLE}, version @value{EDITION} @@ -37,6 +37,7 @@ @end titlepage +@c Macros @macro SLIME @acronym{SLIME} @@ -90,6 +91,10 @@ @xref{\name\}. @end macro +@c Merge the variable and concept indices because both are rather short +@synindex cp vr + + @c @setchapternewpage off @c @shortcontents @contents @@ -110,14 +115,142 @@ * slime-mode:: * REPL:: * Debugger:: -* Extras:: +* Misc:: * Customization:: * Tips and Tricks:: +* Contributed Packages:: * Credits:: -@c * Index to Functions:: -* Key Index:: -* Command Index:: -* Variable Index:: +* Key Index:: +* Command Index:: +* Variable Index:: + +@detailmenu + --- The Detailed Node Listing --- + +Getting started + +* Platforms:: +* Downloading:: +* Installation:: +* Running:: +* Setup Tuning:: + +Downloading SLIME + +* CVS:: +* CVS Incantations:: + +Downloading from CVS + +* CVS Incantations:: + +Setup Tuning + +* Autoloading:: +* Multiple Lisps:: +* Loading Swank faster:: + +Using slime-mode + +* User-interface conventions:: +* Commands:: +* Semantic indentation:: +* Reader conditionals:: + +User-interface conventions + +* Temporary buffers:: +* Inferior-lisp:: +* Multithreading:: +* Key bindings:: + +Commands + +* Programming:: +* Compilation:: +* Evaluation:: +* Recovery:: +* Inspector:: +* Profiling:: +* Other:: + +Programming commands + +* Completion:: +* Indentation:: +* Documentation:: +* Cross-reference:: +* Finding definitions:: +* Macro-expansion:: +* Disassembly:: + +REPL: the ``top level'' + +* REPL commands:: +* Input Navigation:: +* Shortcuts:: + +SLDB: the SLIME debugger + +* Examining frames:: +* Restarts:: +* Frame Navigation:: +* Stepping:: +* Miscellaneous:: + +Misc + +* slime-selector:: +* slime-macroexpansion-minor-mode:: +* Multiple connections:: + +Customization + +* Emacs-side customization:: +* Lisp-side:: + +Emacs-side + +* Hooks:: + +Lisp-side (Swank) + +* Communication style:: +* Other configurables:: + +Tips and Tricks + +* Connecting to a remote lisp:: +* Global IO Redirection:: +* Auto-SLIME:: + +Connecting to a remote lisp + +* Setting up the lisp image:: +* Setting up Emacs:: +* Setting up pathname translations:: + +Contributed Packages + +* Loading Contribs:: +* Compound Completion:: +* Fuzzy Completion:: +* slime-autodoc-mode:: +* ASDF:: +* Banner:: +* Editing Commands:: +* Fancy Inspector:: +* Presentations:: +* Typeout frames:: +* TRAMP:: +* Documentation Links:: +* Xref and Class Browser:: +* Highlight Edits:: +* inferior-slime-mode:: +* Scratch Buffer:: +* slime-fancy:: + +@end detailmenu @end menu @c ----------------------- @@ -281,7 +414,7 @@ @section Installation With a Lisp implementation that can be started from the command-line, -installation just requires a few lines in your @file{~/.emacs}: +installation just requires a few lines in your @file{.emacs}: @vindex inferior-lisp-program @vindex load-path @@ -333,7 +466,6 @@ * Autoloading:: * Multiple Lisps:: * Loading Swank faster:: -* Loading Contribs:: @end menu @node Autoloading @@ -353,8 +485,8 @@ The only difference compared to the basic setup is the line @code{(require 'slime-autoloads)}. It tells Emacs that the rest of -@SLIME{} should be loaded when one of the commands @kbd{M-x slime} or -@kbd{M-x slime-connect} is executed the first time. +@SLIME{} should be loaded automatically when one of the commands +@kbd{M-x slime} or @kbd{M-x slime-connect} is executed the first time. @node Multiple Lisps @subsection Multiple Lisps @@ -391,10 +523,18 @@ @item PROGRAM-ARGS is a list of command line arguments. @item CODING-SYSTEM -the coding system for the connection. +the coding system for the connection. (@pxref{slime-net-coding-system}) @item INIT -@itemx INIT-FUNCTION - ... to be written ... +should be a function which takes two arguments: a filename and a +character encoding. The function should return a Lisp expression as a +string which instructs Lisp to start the Swank server and to write the +port number to the file. At startup, @SLIME{} starts the Lisp process +and sends the result of this function to Lisp's standard input. As +default, @code{slime-init-command} is used. An example is shown in +@ref{init-example,,Loading Swank faster}. +@itemx INIT-FUNCTION +should be a function which takes no arguments. It is called after +the connection is established. (See also @ref{slime-connected-hook}.) @end table @node Loading Swank faster @@ -426,15 +566,16 @@ @example shell$ sbcl * (load ".../slime/swank-loader.lisp") -* (save-lisp-and-die "sbcl.core-with-slime") +* (save-lisp-and-die "sbcl.core-with-swank") @end example @noindent Then add this to your @file{.emacs}: +@anchor{init-example} @lisp (setq slime-lisp-implementations - '((sbcl ("sbcl" "--core" "sbcl.core-with-slime") + '((sbcl ("sbcl" "--core" "sbcl.core-with-swank") :init (lambda (port-file _) (format "(swank:start-server %S)\n" port-file))))) @end lisp @@ -442,10 +583,6 @@ @noindent Similar setups should also work for other Lisp implementations. -@node Loading Contribs -@subsection Loading Contribs -... to be written ... - @node slime-mode @chapter Using slime-mode @@ -455,7 +592,6 @@ @menu * User-interface conventions:: -* Key bindings:: * Commands:: * Semantic indentation:: * Reader conditionals:: @@ -473,6 +609,7 @@ * Temporary buffers:: * Inferior-lisp:: * Multithreading:: +* Key bindings:: @end menu @c ----------------------- @@ -544,10 +681,28 @@ swank:*default-worker-thread-bindings*). @end example -@c ----------------------- + @node Key bindings -@section Key bindings +@subsection Key bindings +In general we try to make our key bindings fit with the overall Emacs +style. We also have the following somewhat unusual convention of our +own: when entering a three-key sequence, the final key can be pressed +either with control or unmodified. For example, the +@code{slime-describe-symbol} command is bound to @kbd{C-c C-d d}, but +it also works to type @kbd{C-c C-d C-d}. We're simply binding both key +sequences because some people like to hold control for all three keys +and others don't, and with the two-key prefix we're not afraid of +running out of keys. + +There is one exception to this rule, just to trip you up. We never +bind @kbd{C-h} anywhere in a key sequence, so @kbd{C-c C-d C-h} +doesn't do the same thing as @kbd{C-c C-d h}. This is because Emacs +has a built-in default so that typing a prefix followed by @kbd{C-h} +will display all bindings starting with that prefix, so @kbd{C-c C-d +C-h} will actually list the bindings for all documentation commands. +This feature is just a bit too useful to clobber! + @quotation @i{``Are you deliberately spiting Emacs's brilliant online help facilities? The gods will be angry!''} @end quotation @@ -570,7 +725,6 @@ @kbdanchorc{C-h l, view-lossage, ``Woah@comma{} what key chord did I just do?''} Shows you the literal sequence of keys you've pressed in order. - @c <key> is breaks links PDF, despite that it's not l it's C-h @c @kbdanchorc{ <key> l, , ``What starts with?''} @c Lists all keybindings that begin with @code{<key>} for the focus buffer mode. @@ -591,24 +745,6 @@ @noindent In this situation everywhere you see @kbd{C-h} in the documentation you would substitute @kbd{F1}. -In general we try to make our key bindings fit with the overall Emacs -style. We also have the following somewhat unusual convention of our -own: when entering a three-key sequence, the final key can be pressed -either with control or unmodified. For example, the -@code{slime-describe-symbol} command is bound to @kbd{C-c C-d d}, but -it also works to type @kbd{C-c C-d C-d}. We're simply binding both key -sequences because some people like to hold control for all three keys -and others don't, and with the two-key prefix we're not afraid of -running out of keys. - -There is one exception to this rule, just to trip you up. We never -bind @kbd{C-h} anywhere in a key sequence, so @kbd{C-c C-d C-h} -doesn't do the same thing as @kbd{C-c C-d h}. This is because Emacs -has a built-in default so that typing a prefix followed by @kbd{C-h} -will display all bindings starting with that prefix, so @kbd{C-c C-d -C-h} will actually list the bindings for all documentation commands. -This feature is just a bit too useful to clobber! - You can assign or change default key bindings globally using the @code{global-set-key} function in your @file{~/.emacs} file like this: @example @@ -659,7 +795,6 @@ @menu * Completion:: -* Closure:: * Indentation:: * Documentation:: * Cross-reference:: @@ -672,6 +807,9 @@ @node Completion @subsubsection Completion commands +@cindex Completion +@cindex Symbol Completion + Completion commands are used to complete a symbol or form based on what is already present at point. Classical completion assumes an exact prefix and gives choices only where branches may occur. Fuzzy @@ -683,89 +821,15 @@ @itemx C-c C-i @itemx C-M-i Complete the symbol at point. Note that three styles of completion are -available in @SLIME{}, and the default differs from normal Emacs +available in @SLIME{}; the default is similar to normal Emacs completion (@pxref{slime-complete-symbol-function}). -@kbditem{C-c C-s, slime-complete-form} -Looks up and inserts into the current buffer the argument list for the -function at point, if there is one. More generally, the command -completes an incomplete form with a template for the missing arguments. -There is special code for discovering extra keywords of generic -functions and for handling @code{make-instance} and -@code{defmethod}. Examples: - -@example -(subseq "abc" <C-c C-s> - --inserts--> start [end]) -(find 17 <C-c C-s> - --inserts--> sequence :from-end from-end :test test - :test-not test-not :start start :end end - :key key) -(find 17 '(17 18 19) :test #'= <C-c C-s> - --inserts--> :from-end from-end - :test-not test-not :start start :end end - :key key) -(defclass foo () ((bar :initarg :bar))) -(defmethod print-object <C-c C-s> - --inserts--> (object stream) - body...) -(defmethod initialize-instance :after ((object foo) &key blub)) -(make-instance 'foo <C-c C-s> - --inserts--> :bar bar :blub blub initargs...) -@end example - -@anchor{slime-fuzzy-complete-symbol} -@kbditem{C-c M-i, slime-fuzzy-complete-symbol} -Presents a list of likely completions to choose from for an -abbreviation at point. This is a third completion method and it is -very different from the more traditional completion to which -@command{slime-complete-symbol} defaults. It attempts to complete a -symbol all at once, instead of in pieces. For example, ``mvb'' will -find ``@code{multiple-value-bind}'' and ``norm-df'' will find -``@code{least-positive-normalized-double-float}''. This can also be -selected as the method of completion used for -@code{slime-complete-symbol}. - -@cmditem{slime-fuzzy-completions-mode} -@cmditem{slime-fuzzy-abort} @end table - -@c ----------------------- -@node Closure -@subsubsection Closure commands - -Closure commands are used to fill in missing parenthesis. - -@table @kbd -@kbditem{C-c C-q, slime-close-parens-at-point} -Closes parentheses at point to complete the top-level-form by inserting ')' -characters at until @code{beginning-of-defun} and @code{end-of-defun} -execute without errors, or @code{slime-close-parens-limit} is exceeded. - -@kbditem{C-], slime-close-all-sexp} -Balance parentheses of open s-expressions at point. -Insert enough right-parentheses to balance unmatched left-parentheses. -Delete extra left-parentheses. Reformat trailing parentheses -Lisp-stylishly. - -If @code{REGION} is true, operate on the region. Otherwise operate on -the top-level sexp before point. -@end table - - -@c ----------------------- @node Indentation @subsubsection Indentation commands @table @kbd -@kbditem{C-c M-q, slime-reindent-defun} -Re-indents the current defun, or refills the current paragraph. -If point is inside a comment block, the text around point will be -treated as a paragraph and will be filled with @code{fill-paragraph}. -Otherwise, it will be treated as Lisp code, and the current defun -will be reindented. If the current defun has unbalanced parens, -an attempt will be made to fix it before reindenting. @kbditem{C-M-q, indent-sexp} Indents the list immediately following point to match the level at point. @@ -774,7 +838,6 @@ be treated as a paragraph. This is useful for filling docstrings." @end table - @c ----------------------- @node Documentation @subsubsection Documentation commands @@ -828,6 +891,9 @@ @node Cross-reference @subsubsection Cross-reference commands +@cindex xref +@cindex Cross-referencing + @SLIME{}'s cross-reference commands are based on the support provided by the Lisp system, which varies widely between Lisps. For systems with no built-in @acronym{XREF} support @SLIME{} queries a portable @@ -884,6 +950,9 @@ @node Finding definitions @subsubsection Finding definitions (``Meta-Point'' commands). +@cindex Meta-dot +@cindex TAGS + The familiar @kbd{M-.} command is provided. For generic functions this command finds all methods, and with some systems it does other fancy things (like tracing structure accessors to their @code{DEFSTRUCT} @@ -919,6 +988,8 @@ @node Macro-expansion @subsubsection Macro-expansion commands +@cindex Macros + @table @kbd @kbditem{C-c C-m, slime-macroexpand-1} Macroexpand the expression at point once. If invoked with a prefix @@ -962,6 +1033,8 @@ @node Compilation @subsection Compilation commands +@cindex Compilation + @SLIME{} has fancy commands for compiling functions, files, and packages. The fancy part is that notes and warnings offered by the Lisp compiler are intercepted and annotated directly onto the @@ -969,9 +1042,9 @@ see what this means.) @table @kbd +@cindex Compiling Functions @kbditem{C-c C-c, slime-compile-defun} Compile the top-level form at point. -@cindex compiling functions @kbditem{C-c C-y, slime-call-defun} Insert a call to the function defined around point into the REPL. @@ -1012,50 +1085,56 @@ @node Evaluation @subsection Evaluation commands -These commands each evaluate a Lisp expression in a different way. By -default they show their results in a message, but a prefix argument -causes the results to be printed in the @REPL{} instead. +These commands each evaluate a Common Lisp expression in a different +way. Usually they mimic commands for evaluating Emacs Lisp code. By +default they show their results in the echo area, but a prefix +argument causes the results to be inserted in the current buffer. @table @kbd +@kbditem{C-x C-e, slime-eval-last-expression} + +Evaluate the expression before point and show the result in the echo +area. + @kbditem{C-M-x, slime-eval-defun} -Evaluate the current toplevel form. -Use @code{slime-re-evaluate-defvar} if the from starts with @code{(defvar}. +Evaluate the current toplevel form and show the result in the echo +area. `C-M-x' treats `defvar' expressions specially. Normally, +evaluating a `defvar' expression does nothing if the variable it +defines already has a value. But `C-M-x' unconditionally resets the +variable to the initial value specified in the `defvar' expression. +This special feature is convenient for debugging Lisp programs. -@kbditem{C-x C-e, slime-eval-last-expression} -Evaluate the expression before point. @end table -If @kbd{C-M-x} or @kbd{C-x C-e} is given a numeric argument, it inserts the -value into the current buffer at point, rather than displaying it in the -echo area. +If @kbd{C-M-x} or @kbd{C-x C-e} is given a numeric argument, it +inserts the value into the current buffer, rather than displaying it +in the echo area. @table @kbd -@kbditem{C-c C-p, slime-pprint-eval-last-expression} -Evaluate the expression before point and pretty-print the result. +@kbditem{C-c :, slime-interactive-eval} +Evaluate an expression read from the minibuffer. @kbditem{C-c C-r, slime-eval-region} Evaluate the region. -@kbditem{C-x M-e, slime-eval-last-expression-display-output} -Display output buffer and evaluate the expression preceding point. +@kbditem{C-c C-p, slime-pprint-eval-last-expression} +Evaluate the expression before point and pretty-print the result in a +fresh buffer. -@kbditem{C-c :, slime-interactive-eval} -Evaluate an expression read from the minibuffer. - -@anchor{slime-scratch} -@cmditem{slime-scratch} -Create a @file{*slime-scratch*} buffer. In this -buffer you can enter Lisp expressions and evaluate them with -@kbd{C-j}, like in Emacs's @file{*scratch*} buffer. - @kbditem{C-c E, slime-edit-value} Edit the value of a setf-able form in a new buffer @file{*Edit <form>*}. The value is inserted into a temporary buffer for editing and then set -in Lisp when committed with @code{slime-edit-value-commit}. +in Lisp when committed with @kbd{C-c C-c}. +@kbditem{C-x M-e, slime-eval-last-expression-display-output} +Display the output buffer and evaluate the expression preceding point. +This is useful if the expression writes something to the output stream. + @kbditem{C-c C-u, slime-undefine-function} -Unbind symbol for function at point. +Undefine the function, with @code{fmakunbound}, for the symbol at +point. + @end table @@ -1080,14 +1159,10 @@ @node Inspector @subsection Inspector commands -The @SLIME{} inspector is a very fancy Emacs-based alternative to the +The @SLIME{} inspector is a Emacs-based alternative to the standard @code{INSPECT} function. The inspector presents objects in Emacs buffers using a combination of plain text, hyperlinks to related -objects, and ``actions'' that can be selected to invoke Lisp code on -the inspected object. For example, to present a generic function the -inspector shows the documentation in plain text and presents each -method with both a hyperlink to inspect the method object and a -``remove method'' action that you can invoke interactively. +objects. The inspector can easily be specialized for the objects in your own programs. For details see the the @code{inspect-for-emacs} generic @@ -1120,8 +1195,9 @@ @kbditem{q, slime-inspector-quit} Dismiss the inspector buffer. -@kbditem{M-RET, slime-inspector-copy-down} -Evaluate the value under point via the REPL (to set `*'). +@kbditem{M-RET, slime-inspector-copy-down} +Store the value under point in the variable `*'. This can +then be used to access the object in the REPL. @end table @@ -1129,6 +1205,10 @@ @node Profiling @subsection Profiling commands +The profiling commands are based on CMUCL's profiler. These are +simple wrappers around functions which usually print something to the +output buffer. + @table @kbd @cmditem{slime-toggle-profile-fdefinition} Toggle profiling of a function. @@ -1205,18 +1285,20 @@ @node Reader conditionals @section Reader conditional fontification -@SLIME{} automatically evaluates reader-conditional expressions in -source buffers and ``grays out'' code that will be skipped for the -current Lisp connection. +@SLIME{} automatically evaluates reader-conditional expressions, like +@code{#+linux}, in source buffers and ``grays out'' code that will be +skipped for the current Lisp connection. @c ----------------------- @node REPL @chapter REPL: the ``top level'' +@cindex Listener + @SLIME{} uses a custom Read-Eval-Print Loop (@REPL{}, also known as a -``top level''). The @REPL{} user-interface is written in Emacs Lisp, -which gives more Emacs-integration than the traditional +``top level'', or listener). The @REPL{} user-interface is written in +Emacs Lisp, which gives more Emacs-integration than the traditional @code{comint}-based Lisp interaction: @itemize @bullet @@ -1255,35 +1337,51 @@ @kbditem{C-j, slime-repl-newline-and-indent} Open and indent a new line. +@kbditem{C-a, slime-repl-bol} +Go to the beginning of the line, but stop at the @REPL{} prompt. + @c @anchor{slime-interrupt} @kbditem{C-c C-c, slime-interrupt} Interrupt the Lisp process with @code{SIGINT}. -@kbditem{C-c M-g, slime-quit} -Quit slime. +@c @kbditem{C-c M-g, slime-quit} +@c Quit slime. +@kbditem{C-c C-t, slime-repl-clear-buffer} +Clear the entire buffer, leaving only a prompt. + @kbditem{C-c C-o, slime-repl-clear-output} Remove the output and result of the previous expression from the buffer. -@kbditem{C-c C-t, slime-repl-clear-buffer} -Clear the entire buffer, leaving only a prompt. - @end table @c ----------------------- @node Input Navigation @section Input navigation +@cindex Input History + +The input navigation (a.k.a. history) commands are modelled after +@code{coming}-mode. Be careful if you are used to Bash-like +keybindings: @kbd{M-p} and @kbd{M-n} use the current input as search +pattern and only work Bash-like if the current line is +empty. @kbd{C-<up>} and @kbd{C-<up>} work like the up and down keys in +Bash. + @table @kbd -@kbditem{C-a, slime-repl-bol} -Go to the beginning of the line, but stop at the @REPL{} prompt. +@kbditempair{C-<up>, C-<down>, + slime-repl-forward-input, slime-repl-backward-input} +Go to the next/previous history item. @kbditempair{M-n, M-p, slime-repl-next-input, slime-repl-previous-input} -Go to next/previous in command history. +Search the next/previous item in the command history using the current +input as search pattern. If @kbd{M-n}/@kbd{M-n} is typed two times in +a row, the second invocation uses the same search pattern (even if the +current input has changed). -@kbditempair{M-s, M-r, +@kbditempair{M-s, M-r, slime-repl-next-matching-input, slime-repl-previous-matching-input} Search forward/reverse through command history with regex @@ -1292,22 +1390,24 @@ @c @code{comint}-style input history commands. @kbditempair{C-c C-n, C-c C-p, -slime-repl-next-prompt, slime-repl-previous-prompt} +slime-repl-next-prompt, slime-repl-previous-prompt} Move between the current and previous prompts in the @REPL{} buffer. +Pressing RET on a line with old input copies that line to the newest +prompt. +@end table -@kbditempair{C-M-a, C-M-e, -slime-repl-beginning-of-defun, slime-repl-end-of-defun} -These commands are like @code{beginning-of-defun} and -@code{end-of-defun}, but when used inside the @REPL{} input area they -instead go directly to the beginning or the end, respectively. +@vindex slime-repl-wrap-history +The variable @code{slime-repl-wrap-history} controls wrap around +behaviour, i.e. whether cycling should restart at the beginning of the +history if the end is reached. -@end table - @c ----------------------- @comment node-name, next, previous, up @node Shortcuts @section Shortcuts +@cindex Shortcuts + ``Shortcuts'' are a special set of @REPL{} commands that are invoked by name. To invoke a shortcut you first press @kbd{,} (comma) at the @REPL{} prompt and then enter the shortcut's name when prompted. @@ -1327,24 +1427,15 @@ @item compile-and-load (aka cl) Compile (if neccessary) and load a lisp file. -@item compile-system -Compile (but not load) an ASDF system. @item defparameter (aka !) Define a new global, special, variable. -@item force-compile-system -Recompile (but not load) an ASDF system. - -@item force-load-system -Recompile and load an ASDF system. - @item help (aka ?) Display the help. -@item load-system -Compile (as needed) and load an ASDF system. + @item pop-directory (aka -d) Pop the current directory. @@ -1378,6 +1469,8 @@ @node Debugger @chapter SLDB: the SLIME debugger +@cindex Debugger + @SLIME{} has a custom Emacs-based debugger called @SLDB{}. Conditions signalled in the Lisp system invoke @SLDB{} in Emacs by way of the Lisp @code{*DEBUGGER-HOOK*}. @@ -1391,6 +1484,7 @@ * Examining frames:: * Restarts:: * Frame Navigation:: +* Stepping:: * Miscellaneous:: @end menu @@ -1461,7 +1555,29 @@ only. @end table -@c ----------------------- +@node Stepping +@section Stepping + +@cindex Stepping + +Stepping is not available in all implementations and works very +differently in those in which it is available. + +@table @kbd +@kbditem{s, sldb-step} +Step to the next expression in the frame. For CMUCL that means, set a +breakpoint at all those code locations in the current code block which +are reachable from the current code location. + +@kbditem{x, sldb-next} +[Step to the next form in the current function.] + +@kbditem{o, sldb-next} +[Stop single-stepping temporarily, but resume it once the current +function returns.] + +@end table + @node Miscellaneous @section Miscellaneous Commands @@ -1475,29 +1591,24 @@ Return from the frame with a value entered in the minibuffer. (This command is not available in all implementations.) -@kbditem{s, sldb-step} -Step to the next expression in the frame. (This command is not -available in all implementations.) @kbditem{B, sldb-break-with-default-debugger} Exit @SLDB{} and debug the condition using the Lisp system's default debugger. -@kbditem{C-c :, slime-interactive-eval} +@kbditem{:, slime-interactive-eval} Evaluate an expression entered in the minibuffer. @end table @c ----------------------- -@node Extras -@chapter Extras +@node Misc +@chapter Misc @menu * slime-selector:: -* slime-autodoc-mode:: * slime-macroexpansion-minor-mode:: * Multiple connections:: -* Typeout frames:: @end menu @c ----------------------- @@ -1538,24 +1649,6 @@ buffers for @code{slime-selector} to find. @c ----------------------- -@node slime-autodoc-mode -@section @code{slime-autodoc-mode} - -@table @kbd -@cmditem{slime-autodoc-mode} -Autodoc mode is an additional minor-mode for automatically showing -information about symbols near the point. For function names the -argument list is displayed, and for global variables, the value. -This is a clone of @code{eldoc-mode} for Emacs Lisp. -@end table - -The mode can be enabled by default in the @code{slime-setup} call of your -(a)code{~/.emacs}: -@example -(slime-setup '(slime-autodoc)) -@end example - -@c ----------------------- @node slime-macroexpansion-minor-mode @section slime-macroexpansion-minor-mode @@ -1648,33 +1741,7 @@ @end table -@c ----------------------- -@node Typeout frames -@section Typeout frames -A ``typeout frame'' is a special Emacs frame which is used instead of -the echo area (minibuffer) to display messages from @SLIME{} commands. -This is an optional feature. The advantage of a typeout frame over the -echo area is that it can hold more text, it can be scrolled, and its -contents don't disappear when you press a key. All potentially long -messages are sent to the typeout frame, such as argument lists, macro -expansions, and so on. - -@table @kbd -@cmditem{slime-ensure-typeout-frame} -Ensure that a typeout frame exists, creating one if necessary. -@end table - -If the typeout frame is closed then the echo area will be used again -as usual. - -To have a typeout frame created automatically at startup you can add -the @code{slime-connected-hook} to your @file{~/.emacs} file: - -@example -(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame) -@end example - @c ----------------------- @node Customization @chapter Customization @@ -1705,34 +1772,13 @@ @vindex slime-complete-symbol-function @item slime-complete-symbol-function The function to use for completion of Lisp symbols. Three completion -styles are available. The default @code{slime-complete-symbol*} -performs completion ``in parallel'' over the hyphen-delimited -sub-words of a symbol name. -@footnote{This style of completion is modelled on @file{completer.el} -by Chris McConnell. That package is bundled with @acronym{ILISP}.} -Formally this means that ``@code{a-b-c}'' can complete to any symbol -matching the regular expression ``(a)code{^a.*-b.*-c.*}'' (where ``dot'' -matches anything but a hyphen). Examples give a more intuitive -feeling: -@itemize @bullet -@item -@code{m-v-b} completes to @code{multiple-value-bind}. -@item -@code{w-open} is ambiguous: it completes to either -@code{with-open-file} or @code{with-open-stream}. The symbol is -expanded to the longest common completion (@code{with-open-}) and the -point is placed at the first point of ambiguity, which in this case is -the end. -@item -@code{w--stream} completes to @code{with-open-stream}. -@end itemize -An alternative is @code{slime-simple-complete-symbol}, which -completes in the usual Emacs way. Finally, there is -@code{slime-fuzzy-complete-symbol}, which is quite different from both -of the above and tries to find best matches to an abbreviated symbol. -It also has its own key binding, defaulting to @kbd{C-c M-i}. -@xref{slime-fuzzy-complete-symbol}, for more information. +styles are available: @code{slime-simple-complete-symbol}, +@code{slime-complete-symbol*} (@pxref{Compound Completion}), +and @code{slime-fuzzy-complete-symbol} (@pxref{Fuzzy Completion}). +The default is @code{slime-simple-complete-symbol}, which completes in +the usual Emacs way. + @vindex slime-filename-translations @item slime-filename-translations This variable controls filename translation between Emacs and the Lisp @@ -1741,7 +1787,13 @@ but have different layouts, as is the case with @acronym{SMB}-based file sharing. +@anchor{slime-net-coding-system} @vindex slime-net-coding-system +@cindex Unicode +@cindex UTF-8 +@cindex ASCII +@cindex LATIN-1 +@cindex Character Encoding @item slime-net-coding-system If you want to transmit Unicode characters between Emacs and the Lisp system, you should customize this variable. E.g., if you use SBCL, you @@ -1749,11 +1801,12 @@ @example (setq slime-net-coding-system 'utf-8-unix) @end example -To actually display Unicode characters you also need appropriate fonts, -otherwise the characters will be rendered as hollow boxes. If you are -using Allegro CL and GNU Emacs, you can also use @code{emacs-mule-unix} -as coding system. GNU Emacs has often nicer fonts for the latter -encoding. +To actually display Unicode characters you also need appropriate +fonts, otherwise the characters will be rendered as hollow boxes. If +you are using Allegro CL and GNU Emacs, you can also +use @code{emacs-mule-unix} as coding system. GNU Emacs has often +nicer fonts for the latter encoding. (Different encodings can be used +for different Lisps, see @ref{Multiple Lisps}.) @end table @@ -1774,6 +1827,7 @@ buffers. An example use is to enable @code{slime-autodoc-mode} (@pxref{slime-autodoc-mode}). +@anchor{slime-connected-hook} @vindex slime-connected-hook @item slime-connected-hook This hook is run when @SLIME{} establishes a connection to a Lisp @@ -2075,7 +2129,8 @@ @file{/opt/project/source.lisp} refers to the same file on both machines. Unfortunetly NFS is usually slow, often buggy, and not always feasable, fortunetely we have an ssh connection and Emacs' -@code{tramp-mode} can do the rest. +@code{tramp-mode} can do the rest. +(See @inforef{Top, TRAMP User Manual,tramp}.) What we do is teach Emacs how to take a filename on the remote machine and translate it into something that tramp can understand and access @@ -2130,7 +2185,440 @@ (save-excursion (slime))))) @end example +@node Contributed Packages +@chapter Contributed Packages +In version 3.0 we moved some functionility to separate packages. This +chapter tells you how to load contrib modules and describes what the +particular packages do. + +@menu +* Loading Contribs:: +* Compound Completion:: +* Fuzzy Completion:: +* slime-autodoc-mode:: +* ASDF:: +* Banner:: +* Editing Commands:: +* Fancy Inspector:: +* Presentations:: +* Typeout frames:: +* TRAMP:: +* Documentation Links:: +* Xref and Class Browser:: +* Highlight Edits:: +* inferior-slime-mode:: +* Scratch Buffer:: +* slime-fancy:: +@end menu + +@node Loading Contribs +@section Loading Contrib Packages + +@cindex Contribs +@cindex Contributions +@cindex Plugins + +Contrib packages aren't loaded by default. You have to modify your +setup a bit so that Emacs knows where to find them and which of them +to load, i.e. you should add the contrib directory to +Emacs' @code{load-path} and call @code{slime-setup} with the list of +package-names. For example, a setup to load the @code{slime-scratch} +and @code{slime-editing-commands} looks like: + +@example +(add-to-list 'load-path ".../slime") ; path for core +(add-to-list 'load-path ".../slime/contrib") ; path for contribs +(require 'slime-autoloads) +(slime-setup '(slime-scratch slime-editing-commands)) +@end example + +After starting SLIME, the commands of both packages should be +available. + +@node Compound Completion +@section Compund Completion + +@anchor{slime-complete-symbol*} +The package @code{slime-c-p-c} provides a different symbol completion +algorithm, which performs completion ``in parallel'' over the +hyphen-delimited sub-words of a symbol name. +@footnote{This style of completion is modelled on @file{completer.el} +by Chris McConnell. That package is bundled with @acronym{ILISP}.} +Formally this means that ``@code{a-b-c}'' can complete to any symbol +matching the regular expression ``(a)code{^a.*-b.*-c.*}'' (where ``dot'' +matches anything but a hyphen). Examples give a more intuitive +feeling: +@itemize @bullet +@item +@code{m-v-b} completes to @code{multiple-value-bind}. +@item +@code{w-open} is ambiguous: it completes to either +@code{with-open-file} or @code{with-open-stream}. The symbol is +expanded to the longest common completion (@code{with-open-}) and the +point is placed at the first point of ambiguity, which in this case is +the end. +@item +@code{w--stream} completes to @code{with-open-stream}. +@end itemize + +The variable @code{slime-c-p-c-unambiguous-prefix-p} specifies where +point should be placed after completion. E.g. the possible +completions for @code{f-o} are @code{finish-output} and +@code{force-output}. By the default point is moved after the +@code{f}, because that is the unambigous prefix. If +@code{slime-c-p-c-unambiguous-prefix-p} is nil, point moves to +the end of the inserted text, after the @code{o} in this case. + +@table @kbd +@kbditem{C-c C-s, slime-complete-form} +Looks up and inserts into the current buffer the argument list for the +function at point, if there is one. More generally, the command +completes an incomplete form with a template for the missing arguments. +There is special code for discovering extra keywords of generic +functions and for handling @code{make-instance} and +@code{defmethod}. Examples: + +@example +(subseq "abc" <C-c C-s> + --inserts--> start [end]) +(find 17 <C-c C-s> + --inserts--> sequence :from-end from-end :test test + :test-not test-not :start start :end end + :key key) +(find 17 '(17 18 19) :test #'= <C-c C-s> + --inserts--> :from-end from-end + :test-not test-not :start start :end end + :key key) +(defclass foo () ((bar :initarg :bar))) +(defmethod print-object <C-c C-s> + --inserts--> (object stream) + body...) +(defmethod initialize-instance :after ((object foo) &key blub)) +(make-instance 'foo <C-c C-s> + --inserts--> :bar bar :blub blub initargs...) +@end example +@end table + +@node Fuzzy Completion +@section Fuzzy Completion + +The package @code{slime-fuzzy} implements yet another symbol +completion heuristic. + +[Somebody please describe what the algorithm actually does] + +It attempts to complete a symbol all at once, instead of in pieces. +For example, ``mvb'' will find ``@code{multiple-value-bind}'' and +``norm-df'' will find +``@code{least-positive-normalized-double-float}''. + +The algorithm tries to expand every character in various ways and +rates the list of possible completions with the following heuristic. + +Letters are given scores based on their position in the string. +Letters at the beginning of a string or after a prefix letter at +the beginning of a string are scored highest. Letters after a +word separator such as #\- are scored next highest. Letters at +the end of a string or before a suffix letter at the end of a +string are scored medium, and letters anywhere else are scored +low. + +If a letter is directly after another matched letter, and its +intrinsic value in that position is less than a percentage of the +previous letter's value, it will use that percentage instead. + +Finally, a small scaling factor is applied to favor shorter +matches, all other things being equal. + +@table @kbd +@anchor{slime-fuzzy-complete-symbol} +@kbditem{C-c M-i, slime-fuzzy-complete-symbol} +Presents a list of likely completions to choose from for an +abbreviation at point. If you set the +variable @code{slime-complete-symbol-function} to this command, fuzzy +completion will also be used for @kbd{M-TAB}. +@end table + +@node slime-autodoc-mode +@section @code{slime-autodoc-mode} + +Autodoc mode is an additional minor-mode for automatically showing +information about symbols near the point. For function names the +argument list is displayed, and for global variables, the value. +This is a clone of @code{eldoc-mode} for Emacs Lisp. + +The mode can be enabled by default in the @code{slime-setup} call of your +(a)code{~/.emacs}: +@example +(slime-setup '(slime-autodoc)) +@end example + +@table @kbd +@cmditem{slime-arglist NAME} +Show the argument list of the function NAME. + +@cmditem{slime-autodoc-mode} +Toggles autodoc-mode on or off according to the argument, and +toggles the mode when invoked without argument. +@end table + +If the variable @code{slime-use-autodoc-mode} is set (default), Emacs +starts a timer, otherwise the information is only displayed after +pressing SPC. + +@node ASDF +@section ASDF + +@acronym{ASDF} is a popular ``system construction tool''. The package +@code{slime-asdf} provides some commands to load and compile such +systems from Emacs. @acronym{ASDF} itself is not included with +@SLIME{}; you have to load that yourself into your Lisp. In +particular, you must load @acronym{ASDF} before you connect, otherwise +you will get errors about missing symbols. + +@table @kbd +@cmditem{slime-load-system NAME} +Compile and load an ASDF system. The default system name is taken +from the first file matching *.asd in the current directory. +@end table + +The package also installs some new REPL shortcuts (@pxref{Shortcuts}): + +@table @kbd +@item load-system +Compile (as needed) and load an ASDF system. +@item compile-system +Compile (but not load) an ASDF system. +@item force-compile-system +Recompile (but not load) an ASDF system. +@item force-load-system +Recompile and load an ASDF system. +@end table + +@node Banner +@section Banner +The package @code{slime-banner} installs a window header line ( +@inforef{Header Lines, , elisp}.) in the REPL buffer. It also runs an +animation at startup. + +@vindex slime-startup-animation +@vindex slime-header-line-p +By setting the variable @code{slime-startup-animation} to nil you can +disable the animation respectivly with the +variable @code{slime-header-line-p} the header line. + +@node Editing Commands +@section Editing Commands + +The package @code{slime-editing-commands} provides some commands to +edit Lisp expressions. + +@table @kbd +@kbditem{C-c M-q, slime-reindent-defun} +Re-indents the current defun, or refills the current paragraph. +If point is inside a comment block, the text around point will be +treated as a paragraph and will be filled with @code{fill-paragraph}. +Otherwise, it will be treated as Lisp code, and the current defun +will be reindented. If the current defun has unbalanced parens, +an attempt will be made to fix it before reindenting. + +@cmditem{slime-close-all-parens-in-sexp} +Balance parentheses of open s-expressions at point. +Insert enough right parentheses to balance unmatched left parentheses. +Delete extra left parentheses. Reformat trailing parentheses +Lisp-stylishly. + +If REGION is true, operate on the region. Otherwise operate on +the top-level sexp before point. + +@cmditem{slime-insert-balanced-comments} +Insert a set of balanced comments around the s-expression containing +the point. If this command is invoked repeatedly (without any other +command occurring between invocations), the comment progressively +moves outward over enclosing expressions. If invoked with a positive +prefix argument, the s-expression arg expressions out is enclosed in a +set of balanced comments. + +@kbditem{M-C-a, slime-beginning-of-defun} +@kbditem{M-C-e, slime-end-of-defun} +@end table + +@node Fancy Inspector +@section Fancy Inspector + +@cindex Methods + +An alternative to default inspector is provided by the package +`slime-fancy-inspector'. This inspector knows a lot about CLOS +objects and methods. It provides many ``actions'' that can be +selected to invoke Lisp code on the inspected object. For example, to +present a generic function the inspector shows the documentation in +plain text and presents each method with both a hyperlink to inspect +the method object and a ``remove method'' action that you can invoke +interactively. The key-bindings are the same as for the basic +inspector (@pxref{Inspector}). + +@node Presentations +@section Presentations + +@cindex Presentations + +A ``presentation''@footnote{Presentations are a feature originating +from the Lisp machines. It was possible to define @code{present} +methods specialized to various devices, e.g. to draw an object to +bitmapped screen or to write some text to a character stream.} in +@SLIME{} is a region of text associated with a Lisp object. +Right-clicking on the text brings up a menu with operations for the +particular object. Some operations, like inspecting, are available +for all objects, but the object may also have specialized operations. +E.g. pathnames have a dired operation. + +The package @code{slime-presentations} installs presentations in the +REPL, i.e. the results of evaluation commands become presentations. + +For some implementations you can also install +@code{slime-presentation-streams} which enables presentations on the +Lisp @code{*standard-output*} stream. E.g. printing a list to such a +stream will create presentions in the Emacs buffer. + +@table @kbd +@cmditem{slime-copy-or-inspect-presentation-at-mouse} +@cmditem{slime-inspect-presentation-at-mouse} +@cmditem{slime-copy-presentation-at-mouse} +@cmditem{slime-copy-presentation-at-mouse-to-point} +@cmditem{slime-copy-presentation-at-mouse-to-kill-ring} +@cmditem{slime-describe-presentation-at-mouse} +@cmditem{slime-pretty-print-presentation-at-mouse} +@cmditem{slime-clear-presentations} +@end table + +@node Typeout frames +@section Typeout frames + +@cindex Typeout Frame + +A ``typeout frame'' is a special Emacs frame which is used instead of +the echo area (minibuffer) to display messages from @SLIME{} commands. +This is an optional feature. The advantage of a typeout frame over the +echo area is that it can hold more text, it can be scrolled, and its +contents don't disappear when you press a key. All potentially long +messages are sent to the typeout frame, such as argument lists, macro +expansions, and so on. + +@table @kbd +@cmditem{slime-ensure-typeout-frame} +Ensure that a typeout frame exists, creating one if necessary. +@end table + +If the typeout frame is closed then the echo area will be used again +as usual. + +To have a typeout frame created automatically at startup you should +load the @code{slime-typeout-frame} package. (@pxref{Loading Contribs}.) + +The variable @code{slime-typeout-frame-properties} specifies the +height and possibly other properties of the frame. Its value is +passed to @code{make-frame}. (@inforef{Creating Frames, ,elisp}.) + +@node TRAMP +@section TRAMP + +@cindex TRAMP + +The package @code{slime-tramp} provides some functions to set up +filename translations for TRAMP. (@pxref{Setting up pathname +translations}) + +@node Documentation Links +@section Documentation Links + +For certain error messages, SBCL includes references to the ANSI +Standard or the SBCL User Manual. The @code{slime-references} package +turns those references into clickable links. This makes finding the +referenced section of the HyperSpec much easier. + +@node Xref and Class Browser +@section Xref and Class Browser + +A rudimentary class browser is provied by +the @code{slime-xref-browser} package. + +@table @kbd +@cmditem{slime-browse-classes} +This command asks for a class name and displays inheritance tree of +for the class. + +@cmditem{slime-browse-xrefs} +This command prompts for a symbol and the kind of cross reference, +e.g. callers. The cross reference tree rooted at the symbol is then +then displayed. + +@end table + + +@node Highlight Edits +@section Highlight Edits + +@code{slime-highlight-edits} is a minor mode to highlight those +regions in a Lisp source file which are modified. This is useful to +quickly find those functions which need to be recompiled (whith +@kbd{C-c C-c}) + +@table @kbd +@cmditem{slime-highlight-edits-mode} +Turns @code{slime-highlight-edits-mode} on or off. +@end table + +@node inferior-slime-mode +@section @code{inferior-slime-mode} + +The @code{inferior-slime-mode} is a minor mode is intended to use with +a comint buffer. It provides some of the SLIME commands, like symbol +completion and documentation lookup. To install it, add something +like this to user @file{.emacs}: + +@example +(slime-setup '(inferior-slime-mode)) +(add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1))) +@end example + +@table @kbd +@cmditem{inferior-slime-mode} +Turns inferior-slime-mode on or off. +@end table + +@vindex inferior-slime-mode-map +The variable @code{inferior-slime-mode-map} contains the extra +keybindings. + +@node Scratch Buffer +@section Scratch Buffer + +@anchor{slime-scratch} +The @SLIME{} scratch buffer, in contrib package @code{slime-scratch}, +imitates Emacs' usual @code{*scratch*} buffer. It's just like any +other Lisp buffer, except for the command bound to @kbd{C-j}. + +@table @kbd + +@kbditem{C-j, slime-eval-print-last-expression} +Evaluate the expression sexp before point and insert print value into +the current buffer. + +@cmditem{slime-scratch} +Create a @file{*slime-scratch*} buffer. In this +buffer you can enter Lisp expressions and evaluate them with +@kbd{C-j}, like in Emacs's @file{*scratch*} buffer. + +@end table + +@node slime-fancy +@section Meta package: @code{slime-fancy} + +@code{slime-fancy} is a meta package which loads a combination of the +most popular packages. + @c ----------------------- @node Credits @chapter Credits @@ -2172,8 +2660,8 @@ This index is currently ingored, because texinfo's built-in indexing produces nicer results. -- Helmut Eller -@node Index to Functions -@appendix Index to Functions +@c@node Index to Functions +@c@appendix Index to Functions These functions are all available (when relevant). To find the keybinding (if there is one) refer to the function description. @@ -2456,16 +2944,20 @@ @end ignore -@node Key Index, Command Index, Credits, top +@node Key Index @unnumbered Key (Character) Index @printindex ky -@node Command Index, Variable Index, Key Index, top +@node Command Index @unnumbered Command and Function Index @printindex fn -@node Variable Index, , Command Index, top -@unnumbered Variable Index +@node Variable Index +@unnumbered Variable and Concept Index @printindex vr @bye +Local Variables: +paragraph-start: "@[a-zA-Z]+\${[^}]+}\$?[ \n]\\|[ ]*$" +paragraph-separate: "@[a-zA-Z]+\${[^}]+}\$?[ \n]\\|[ ]*$" +End: Modified: branches/trunk-reorg/thirdparty/slime/slime.el =================================================================== --- branches/trunk-reorg/thirdparty/slime/slime.el 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/slime.el 2007-12-02 18:46:42 UTC (rev 2295) @@ -488,13 +488,18 @@ (defun slime-pretty-package-name (name) "Return a pretty version of a package name NAME." - (let ((name (cond ((string-match "^:\$.*\$$" name) + (let ((name (cond ((string-match "^#?:\$.*\$$" name) (match-string 1 name)) ((string-match "^\"\$.*\$\"$" name) (match-string 1 name)) (t name)))) (format "%s" (read name)))) +(defun slime-pretty-current-package () + "Retrun a prettied version of `slime-current-package'." + (let ((p (slime-current-package))) + (and p (slime-pretty-package-name p)))) + (when slime-update-modeline-package (run-with-idle-timer 0.2 0.2 'slime-update-modeline-package)) @@ -1933,6 +1938,9 @@ "The symbol-names of Lisp's *FEATURES*. This is automatically synchronized from Lisp.") +(slime-def-connection-var slime-lisp-modules '() + "The strings of Lisp's *MODULES*.") + (slime-def-connection-var slime-lisp-package "COMMON-LISP-USER" "The current package name of the Superior lisp. @@ -2002,14 +2010,16 @@ "Initialize CONNECTION with INFO received from Lisp." (let ((slime-dispatching-connection connection)) (destructuring-bind (&key pid style lisp-implementation machine - features package version &allow-other-keys) info + features package version modules + &allow-other-keys) info (or (equal version slime-protocol-version) (yes-or-no-p "Protocol version mismatch. Continue anyway? ") (slime-net-close connection) (top-level)) (setf (slime-pid) pid (slime-communication-style) style - (slime-lisp-features) features) + (slime-lisp-features) features + (slime-lisp-modules) modules) (destructuring-bind (&key name prompt) package (setf (slime-lisp-package) name (slime-lisp-package-prompt-string) prompt)) @@ -2029,6 +2039,7 @@ (slime-generate-connection-name (symbol-name name))))) (slime-hide-inferior-lisp-buffer) (slime-init-output-buffer connection) + (slime-load-contribs) (run-hooks 'slime-connected-hook) (when-let (fun (plist-get args ':init-function)) (funcall fun))) @@ -2244,15 +2255,12 @@ ;; (in-package #+ansi-cl :cl #-ansi-cl 'lisp) (defun slime-search-buffer-package () (let ((case-fold-search t) - (regexp (concat "^(\$cl:\\|common-lisp:\$?in-package\\>[ \n\t\r']*" - "\$[^)]+\$[ \n\t]*)"))) + (regexp (concat "^(\$cl:\\|common-lisp:\$?in-package\\>[ \t']*" + "\$[^)]+\$[ \t]*)"))) (save-excursion (when (or (re-search-backward regexp nil t) (re-search-forward regexp nil t)) - (let ((string (match-string-no-properties 2))) - (cond ((string-match "^\"" string) (ignore-errors (read string))) - ((string-match "^#?:" string) (substring string (match-end 0))) - (t string))))))) + (match-string-no-properties 2))))) ;;; Synchronous requests are implemented in terms of asynchronous ;;; ones. We make an asynchronous request with a continuation function @@ -2840,6 +2848,7 @@ (slime-define-keys slime-repl-mode-map ("\C-m" 'slime-repl-return) + ([return] 'slime-repl-return) ("\C-j" 'slime-repl-newline-and-indent) ("\C-\M-m" 'slime-repl-closing-return) ([(control return)] 'slime-repl-closing-return) @@ -3302,8 +3311,8 @@ (defun slime-repl-set-package (package) "Set the package of the REPL buffer to PACKAGE." - (interactive (list (slime-read-package-name "Package: " - (slime-find-buffer-package)))) + (interactive (list (slime-read-package-name + "Package: " (slime-pretty-current-package)))) (with-current-buffer (slime-output-buffer) (let ((unfinished-input (slime-repl-current-input))) (destructuring-bind (name prompt-string) @@ -3565,6 +3574,7 @@ nil "[read]" '(("\C-m" . slime-repl-return) + ([return] . slime-repl-return) ("\C-c\C-b" . slime-repl-read-break) ("\C-c\C-c" . slime-repl-read-break))) @@ -4167,6 +4177,7 @@ (slime-define-keys slime-compiler-notes-mode-map ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details) + ([return] 'slime-compiler-notes-default-action-or-show-details) ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse) ("q" 'slime-temp-buffer-quit)) @@ -5985,6 +5996,7 @@ (slime-define-keys slime-xref-mode-map ((kbd "RET") 'slime-show-xref) + ([return] 'slime-show-xref) ("\C-m" 'slime-show-xref) (" " 'slime-goto-xref) ("q" 'slime-xref-quit) @@ -6374,7 +6386,7 @@ (defun slime-set-package (package) (interactive (list (slime-read-package-name "Package: " - (slime-find-buffer-package)))) + (slime-pretty-current-package)))) (message "*package*: %s" (slime-eval `(swank:set-package ,package)))) (defun slime-set-default-directory (directory) @@ -6516,6 +6528,7 @@ ("v" 'sldb-show-source) ((kbd "RET") 'sldb-default-action) ("\C-m" 'sldb-default-action) + ([return] 'sldb-default-action) ([mouse-2] 'sldb-default-action/mouse) ([follow-link] 'mouse-face) ("e" 'sldb-eval-in-frame) @@ -7339,6 +7352,7 @@ (slime-define-keys slime-connection-list-mode-map ((kbd "RET") 'slime-goto-connection) + ([return] 'slime-goto-connection) ("d" 'slime-connection-list-make-default) ("g" 'slime-update-connection-list) ((kbd "C-k") 'slime-quit-connection-at-point) @@ -7680,7 +7694,7 @@ (slime-define-keys slime-inspector-mode-map ([return] 'slime-inspector-operate-on-point) - ([(meta return)] 'slime-inspector-copy-down) + ((kbd "M-RET") 'slime-inspector-copy-down) ("\C-m" 'slime-inspector-operate-on-point) ([mouse-2] 'slime-inspector-operate-on-click) ("l" 'slime-inspector-pop) @@ -7901,6 +7915,27 @@ (run-hook-with-args 'slime-indentation-update-hooks symbol indent)))) +;;;; Contrib modules + +(defvar slime-required-modules '()) + +(defun slime-require (module) + (assert (keywordp module)) + (pushnew module slime-required-modules) + (when (slime-connected-p) + (slime-load-contribs))) + +(defun slime-load-contribs () + (let ((needed (remove-if (lambda (s) + (member (subseq (symbol-name s) 1) + (mapcar #'downcase (slime-lisp-modules)))) + slime-required-modules))) + (when needed + (slime-eval-async `(swank:swank-require ',needed) + (lambda (new-modules) + (setf (slime-lisp-modules) new-modules)))))) + + ;;;;; Pull-down menu (defvar slime-easy-menu @@ -9072,14 +9107,18 @@ (apply #'buffer-substring-no-properties (slime-region-for-defun-at-point))) +(defvar slime-region-for-defun-function nil) + (defun slime-region-for-defun-at-point () "Return the start and end position of the toplevel form at point." - (save-excursion - (save-match-data - (end-of-defun) - (let ((end (point))) - (beginning-of-sexp) - (list (point) end))))) + (or (and slime-region-for-defun-function + (funcall slime-region-for-defun-function)) + (save-excursion + (save-match-data + (end-of-defun) + (let ((end (point))) + (beginning-of-sexp) + (list (point) end)))))) (defun slime-beginning-of-symbol () "Move point to the beginning of the current symbol." Modified: branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -911,16 +911,17 @@ (vm::find-code-object function)) (not (eq closure function)))) - -(defun byte-function-location (fn) - "Return the location of the byte-compiled function FN." - (etypecase fn +(defun byte-function-location (fun) + "Return the location of the byte-compiled function FUN." + (etypecase fun ((or c::hairy-byte-function c::simple-byte-function) - (let* ((component (c::byte-function-component fn)) - (debug-info (kernel:%code-debug-info component))) - (debug-info-function-name-location debug-info))) + (let* ((di (kernel:%code-debug-info (c::byte-function-component fun)))) + (if di + (debug-info-function-name-location di) + `(:error + ,(format nil "Byte-function without debug-info: ~a" fun))))) (c::byte-closure - (byte-function-location (c::byte-closure-function fn))))) + (byte-function-location (c::byte-closure-function fun))))) ;;; Here we deal with structure accessors. Note that `dd' is a ;;; "defstruct descriptor" structure in CMUCL. A `dd' describes a Modified: branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -542,22 +542,10 @@ (defun unmangle-unfun (symbol) "Converts symbols like 'SETF::|\"CL-USER\" \"GET\"| to function names like \(SETF GET)." - (or (and (eq (symbol-package symbol) - (load-time-value (find-package :setf))) - (let ((slime-nregex::*regex-groupings* 0) - (slime-nregex::*regex-groups* (make-array 10)) - (symbol-name (symbol-name symbol))) - (and (funcall (load-time-value - (compile nil (slime-nregex:regex-compile "^\"(.+)\" \"(.+)\"$"))) - symbol-name) - (list 'setf - (intern (apply #'subseq symbol-name - (aref slime-nregex::*regex-groups* 2)) - (find-package - (apply #'subseq symbol-name - (aref slime-nregex::*regex-groups* 1)))))))) - symbol)) - + (cond ((sys::setf-symbol-p symbol) + (sys::setf-pair-from-underlying-name symbol)) + (t symbol))) + (defun signal-undefined-functions (htab &optional filename) (maphash (lambda (unfun dspecs) (dolist (dspec dspecs) Modified: branches/trunk-reorg/thirdparty/slime/swank-loader.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-loader.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/swank-loader.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -33,7 +33,7 @@ (defparameter *sysdep-files* (append - '("nregex") + '() #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl") #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl") #+sbcl '("swank-source-path-parser" "swank-source-file-cache" Modified: branches/trunk-reorg/thirdparty/slime/swank.lisp =================================================================== --- branches/trunk-reorg/thirdparty/slime/swank.lisp 2007-11-29 13:18:49 UTC (rev 2294) +++ branches/trunk-reorg/thirdparty/slime/swank.lisp 2007-12-02 18:46:42 UTC (rev 2295) @@ -17,6 +17,8 @@ (:export #:startup-multiprocessing #:start-server #:create-server + #:stop-server + #:restart-server #:ed-in-emacs #:inspect-in-emacs #:print-indentation-lossage @@ -103,9 +105,15 @@ (*print-array* . t) (*print-lines* . 10) (*print-escape* . t) - (*print-right-margin* . 70)) + (*print-right-margin* . 65)) "A set of printer variables used in the debugger.") +(defvar *backtrace-printer-bindings* + `((*print-pretty* . nil) + (*print-level* . 4) + (*print-length* . 6)) + "Pretter settings for printing backtraces.") + (defvar *default-worker-thread-bindings* '() "An alist to initialize dynamic variables in worker threads. The list has the form ((VAR . VALUE) ...). Each variable VAR will be @@ -577,19 +585,20 @@ (defvar *coding-system* "iso-latin-1-unix") +(defvar *listener-sockets* nil + "A property list of lists containing style, socket pairs used + by swank server listeners, keyed on socket port number. They + are used to close sockets on server shutdown or restart.") + (defun start-server (port-file &key (style *communication-style*) (dont-close *dont-close*) (coding-system *coding-system*)) "Start the server and write the listen port number to PORT-FILE. This is the entry point for Emacs." - (flet ((start-server-aux () - (setup-server 0 (lambda (port) - (announce-server-port port-file port)) - style dont-close - (find-external-format-or-lose coding-system)))) - (if (eq style :spawn) - (initialize-multiprocessing #'start-server-aux) - (start-server-aux)))) + (setup-server 0 (lambda (port) + (announce-server-port port-file port)) + style dont-close + (find-external-format-or-lose coding-system))) (defun create-server (&key (port default-server-port) (style *communication-style*) @@ -610,19 +619,61 @@ (defun setup-server (port announce-fn style dont-close external-format) (declare (type function announce-fn)) (let* ((socket (create-socket *loopback-interface* port)) - (port (local-port socket))) - (funcall announce-fn port) + (local-port (local-port socket))) + (funcall announce-fn local-port) (flet ((serve () (serve-connection socket style dont-close external-format))) (ecase style (:spawn - (spawn (lambda () (loop do (ignore-errors (serve)) while dont-close)) - :name "Swank")) + (initialize-multiprocessing + (lambda () + (spawn (lambda () + (loop do (ignore-errors (serve)) while dont-close)) + :name (concatenate 'string "Swank " + (princ-to-string port)))))) ((:fd-handler :sigio) (add-fd-handler socket (lambda () (serve)))) ((nil) (loop do (serve) while dont-close))) - port))) + (setf (getf *listener-sockets* port) (list style socket)) + local-port))) +(defun stop-server (port) + "Stop server running on PORT." + (let* ((socket-description (getf *listener-sockets* port)) + (style (first socket-description)) + (socket (second socket-description))) + (ecase style + (:spawn + (let ((thread-position + (position-if + (lambda (x) + (string-equal (first x) + (concatenate 'string "Swank " + (princ-to-string port)))) + (list-threads)))) + (when thread-position + (kill-nth-thread thread-position) + (close-socket socket) + (remf *listener-sockets* port)))) + ((:fd-handler :sigio) + (remove-fd-handlers socket) + (close-socket socket) + (remf *listener-sockets* port))))) + +(defun restart-server (&key (port default-server-port) + (style *communication-style*) + (dont-close *dont-close*) + (coding-system *coding-system*)) + "Stop the server listening on PORT, then start a new SWANK server +on PORT running in STYLE. If DONT-CLOSE is true then the listen socket +will accept multiple connections, otherwise it will be closed after the +first." + (stop-server port) + (sleep 5) + (create-server :port port :style style :dont-close dont-close + :coding-system coding-system)) + + (defun serve-connection (socket style dont-close external-format) (let ((closed-socket-p nil)) (unwind-protect @@ -1443,6 +1494,7 @@ :type ,(machine-type) :version ,(machine-version)) :features ,(features-for-emacs) + :modules ,*modules* :package (:name ,(package-name *package*) :prompt ,(package-string-for-prompt *package*)) :version ,*swank-wire-protocol-version*)) @@ -1629,20 +1681,10 @@ (defun parse-package (string) "Find the package named STRING. Return the package or nil." - (check-type string (or string null)) - (if (zerop (length string)) - nil - (multiple-value-bind (name pos interned?) - (let ((*package* *swank-io-package*)) - (ignore-errors (read-softly-from-string string))) - (unwind-protect - (and name - (or (symbolp name) - (stringp name)) - (= (length string) pos) - (find-package name)) - (when interned? - (unintern-in-home-package name)))))) + ;; STRING comes usually from a (in-package STRING) form. + (ignore-errors + (find-package (let ((*package* *swank-io-package*)) + (read-from-string string))))) (defun unparse-name (string) "Print the name STRING according to the current printer settings." @@ -2017,7 +2059,7 @@ (defun safe-condition-message (condition) "Safely print condition to a string, handling any errors during printing." - (let ((*print-pretty* t)) + (let ((*print-pretty* t) (*print-right-margin* 65)) (handler-case (format-sldb-condition condition) (error (cond) @@ -2053,8 +2095,9 @@ (loop for frame in (compute-backtrace start end) for i from start collect (list i (with-output-to-string (stream) - (handler-case - (print-frame frame stream) + (handler-case + (with-bindings *backtrace-printer-bindings* + (print-frame frame stream)) (t () (format stream "[error printing frame]"))))))) @@ -2138,11 +2181,12 @@ (defslimefun frame-locals-for-emacs (index) "Return a property list ((&key NAME ID VALUE) ...) describing the local variables in the frame INDEX." - (mapcar (lambda (frame-locals) - (destructuring-bind (&key name id value) frame-locals - (list :name (prin1-to-string name) :id id - :value (to-string value)))) - (frame-locals index))) + (with-bindings *backtrace-printer-bindings* + (mapcar (lambda (frame-locals) + (destructuring-bind (&key name id value) frame-locals + (list :name (prin1-to-string name) :id id + :value (to-string value)))) + (frame-locals index)))) (defslimefun frame-catch-tags-for-emacs (frame-index) (mapcar #'to-string (frame-catch-tags frame-index))) @@ -2280,10 +2324,12 @@ ;;;;; swank-require -(defslimefun swank-require (module &optional filename) +(defslimefun swank-require (modules &optional filename) "Load the module MODULE." - (require module (or filename (module-filename module))) - nil) + (dolist (module (if (listp modules) modules (list modules))) + (unless (member (string module) *modules* :test #'string=) + (require module (or filename (module-filename module))))) + *modules*) (defvar *find-module* 'find-module "Pluggable function to locate modules. @@ -2358,16 +2404,16 @@ ;;;; Simple completion -(defslimefun simple-completions (string buffer-package) +(defslimefun simple-completions (string package) "Return a list of completions for the string STRING." - (let ((strings (all-completions string buffer-package #'prefix-match-p))) + (let ((strings (all-completions string package #'prefix-match-p))) (list strings (longest-common-prefix strings)))) -(defun all-completions (string buffer-package test) +(defun all-completions (string package test) (multiple-value-bind (name pname intern) (tokenize-symbol string) (let* ((extern (and pname (not intern))) (pack (cond ((equal pname "") keyword-package) - ((not pname) (guess-buffer-package buffer-package)) + ((not pname) (guess-buffer-package package)) (t (guess-package pname)))) (test (lambda (sym) (funcall test name (unparse-symbol sym)))) (syms (and pack (matching-symbols pack extern test)))) @@ -2480,24 +2526,15 @@ (string< (symbol-name x) (symbol-name y)) (string< (package-name px) (package-name py))))))))) -(let ((regex-hash (make-hash-table :test #'equal))) - (defun compiled-regex (regex-string) - (or (gethash regex-string regex-hash) - (setf (gethash regex-string regex-hash) - (if (zerop (length regex-string)) - (lambda (s) (check-type s string) t) - (compile nil (slime-nregex:regex-compile regex-string))))))) - -(defun make-regexp-matcher (string case-sensitive) - (let* ((case-modifier (if case-sensitive #'string #'string-upcase)) - (regex (compiled-regex (funcall case-modifier string)))) +(defun make-apropos-matcher (pattern case-sensitive) + (let ((chr= (if case-sensitive #'char= #'char-equal))) (lambda (symbol) - (funcall regex (funcall case-modifier symbol))))) + (search pattern (string symbol) :test chr=)))) (defun apropos-symbols (string external-only case-sensitive package) (let ((packages (or package (remove (find-package :keyword) (list-all-packages)))) - (matcher (make-regexp-matcher string case-sensitive)) + (matcher (make-apropos-matcher string case-sensitive)) (result)) (with-package-iterator (next packages :external :internal) (loop (multiple-value-bind (morep symbol) (next) @@ -2875,15 +2912,13 @@ *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0) *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))) -;; FIXME: Unused? (defun valid-function-name-p (form) - (or (and (not (null form)) - (not (eq form t)) - (symbolp form)) + (or (symbolp form) (and (consp form) (second form) (not (third form)) - (eq (first form) 'setf)))) + (eq (first form) 'setf) + (symbolp (second form))))) (defslimefun init-inspector (string) (with-buffer-syntax ()

1 0

[bknr-cvs] r2294 - branches/trunk-reorg/thirdparty/emacs
by bknr＠bknr.net 29 Nov '07

29 Nov '07

Author: hhubner Date: 2007-11-29 08:18:49 -0500 (Thu, 29 Nov 2007) New Revision: 2294 Modified: branches/trunk-reorg/thirdparty/emacs/javascript.el Log: Updated version from http://joost.zeekat.nl/wp-content/javascript.el Modified: branches/trunk-reorg/thirdparty/emacs/javascript.el =================================================================== --- branches/trunk-reorg/thirdparty/emacs/javascript.el 2007-11-29 11:57:01 UTC (rev 2293) +++ branches/trunk-reorg/thirdparty/emacs/javascript.el 2007-11-29 13:18:49 UTC (rev 2294) @@ -1,5 +1,14 @@ ;;; javascript.el --- Major mode for editing JavaScript source text +;; This version contains a few font-lock fixes for quoted strings +;; and regular expressions by Joost Diepenmaat <joost(a)zeekat.nl> +;; Joost's version - 2007-11-29 + +;; Currently known issues: +;; +;; /* .. */ style comments inside quoted strings are shown as comments +;; instead of quoted strings. Fixing this may get complicated. + ;; Copyright (C) 2006 Karl Landström ;; Author: Karl Landström <kland(a)comhem.se> @@ -8,9 +17,6 @@ ;; Date: 2006-12-26 ;; Keywords: languages, oop -;; This version contains a few font-lock fixes for quoted strings -;; and regular expressions by Joost Diepenmaat <joost(a)zeekat.nl> - ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) @@ -117,6 +123,14 @@ (modify-syntax-entry ?' "." table) (modify-syntax-entry ?\" "." table) + ;; partially disable comment detection. Our manual string detection + ;; won't work if there are automatically detected comments inside the + ;; string. + ;; + ;; note that we keep auto-detection of /* .. */ style comments since + ;; they are multi-line and can't easily be detected otherwise. + (modify-syntax-entry ?/ ". 14" table) + ;; The syntax class of underscore should really be `symbol' ("_") ;; but that makes matching of tokens much more complex as e.g. ;; "\\<xyz\\>" matches part of e.g. "_xyz" and "xyz_abc". Defines @@ -297,8 +311,10 @@ ;; detect "autoquoted" object properties... clases with "switch { ... default: }" ;; may not be worth the trouble - (list "\$^[ \t]*\\|[,{][ \t]*\$\$\\w+\$:" 2 font-lock-string-face)) + (list "\$^[ \t]*\\|[,{][ \t]*\$\$\\w+\$:" 2 font-lock-string-face) + ;; find single-line comments + (list "\$//.*\$" 1 font-lock-comment-face)) "Level one font lock.") (defconst js-font-lock-keywords-2

1 0

[bknr-cvs] r2293 - branches/trunk-reorg/projects/scrabble/website
by bknr＠bknr.net 29 Nov '07

29 Nov '07

Author: hhubner Date: 2007-11-29 06:57:01 -0500 (Thu, 29 Nov 2007) New Revision: 2293 Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: nischt is mit foo Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-29 08:48:29 UTC (rev 2292) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-29 11:57:01 UTC (rev 2293) @@ -292,8 +292,6 @@ } function letterKeyPressed(e) { - alert('foo'); - if (e.which == 0 || e.altKey || e.ctrlKey || e.shiftKey) { // not a letter key return;

1 0

[bknr-cvs] r2292 - in branches/trunk-reorg/projects/scrabble: src website
by bknr＠bknr.net 29 Nov '07

29 Nov '07

Author: hhubner Date: 2007-11-29 03:48:29 -0500 (Thu, 29 Nov 2007) New Revision: 2292 Modified: branches/trunk-reorg/projects/scrabble/src/make-letters.lisp branches/trunk-reorg/projects/scrabble/src/web.lisp branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: Keyboard event handling fixes, still not perfect. Modified: branches/trunk-reorg/projects/scrabble/src/make-letters.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/make-letters.lisp 2007-11-27 11:01:50 UTC (rev 2291) +++ branches/trunk-reorg/projects/scrabble/src/make-letters.lisp 2007-11-29 08:48:29 UTC (rev 2292) @@ -65,8 +65,9 @@ (set-rgb-fill 0 0 0)) (set-font bold-font 27) (draw-centered-string 13 7 char-string) - (set-font regular-font 11) - (draw-centered-string 26 3 (princ-to-string score))) + (unless blank-used + (set-font regular-font 11) + (draw-centered-string 26 3 (princ-to-string score)))) (save-png pathname) pathname))) Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-11-27 11:01:50 UTC (rev 2291) +++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-11-29 08:48:29 UTC (rev 2292) @@ -39,7 +39,8 @@ (encode-json-plist (list :remaining-tiles (remaining-tile-count tile-bag)) stream)) (defmethod encode-json ((tile tile) stream) - (encode-json-plist (list :letter (letter-name-of tile) + (encode-json-plist (list :letter (letter-of tile) + :letter-name (letter-name-of tile) :value (value-of tile)) stream)) Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-27 11:01:50 UTC (rev 2291) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-29 08:48:29 UTC (rev 2292) @@ -35,51 +35,51 @@ function checkMoveLegality(placedTiles) { - // Given the board and list of placed tiles, either throw an error or - // return if the move is legal. + // Given the board and list of placed tiles, either throw an error or + // return if the move is legal. - var positions = map(function (placement) { return [ placement[0], placement[1] ] }, placedTiles) - .sort(function (a, b) { return (a[0] - b[0]) || (a[1] - b[1])}); + var positions = map(function (placement) { return [ placement[0], placement[1] ] }, placedTiles) + .sort(function (a, b) { return (a[0] - b[0]) || (a[1] - b[1])}); - if (filter(partial(operator.ne, positions[0][0]), map(function (position) { return position[0] }, positions)).length - && filter(partial(operator.ne, positions[0][1]), map(function (position) { return position[1] }, positions)).length) { - throw "not-in-a-row"; - } + if (filter(partial(operator.ne, positions[0][0]), map(function (position) { return position[0] }, positions)).length + && filter(partial(operator.ne, positions[0][1]), map(function (position) { return position[1] }, positions)).length) { + throw "not-in-a-row"; + } - var startOfPlacement = positions[0]; - var endOfPlacement = positions[positions.length - 1]; + var startOfPlacement = positions[0]; + var endOfPlacement = positions[positions.length - 1]; - for (var x = startOfPlacement[0]; x <= endOfPlacement[0]; x++) { - for (var y = startOfPlacement[1]; y <= endOfPlacement[1]; y++) { - if (!letterAt(x, y) && (findValue(positions, [ x, y ]) == -1)) { - throw "placement-with-holes"; - } - } + for (var x = startOfPlacement[0]; x <= endOfPlacement[0]; x++) { + for (var y = startOfPlacement[1]; y <= endOfPlacement[1]; y++) { + if (!letterAt(x, y) && (findValue(positions, [ x, y ]) == -1)) { + throw "placement-with-holes"; + } } + } - if (findValue(positions, [ 7, 7 ]) == -1) { - var found = false; - for (var x = startOfPlacement[0]; !found && (x <= endOfPlacement[0]); x++) { - for (var y = startOfPlacement[1]; !found && (y <= endOfPlacement[1]); y++) { - if (((x > 0) && letterAt(x - 1, y)) - || ((x < 14) && letterAt(x + 1, y)) - || ((y > 0) && letterAt(x, y - 1)) - || ((y < 14) && letterAt(x, y + 1))) { - found = true; - } - } - } - if (!found) { - throw "not-touching-other-tile"; - } + if (findValue(positions, [ 7, 7 ]) == -1) { + var found = false; + for (var x = startOfPlacement[0]; !found && (x <= endOfPlacement[0]); x++) { + for (var y = startOfPlacement[1]; !found && (y <= endOfPlacement[1]); y++) { + if (((x > 0) && letterAt(x - 1, y)) + || ((x < 14) && letterAt(x + 1, y)) + || ((y > 0) && letterAt(x, y - 1)) + || ((y < 14) && letterAt(x, y + 1))) { + found = true; + } + } } + if (!found) { + throw "not-touching-other-tile"; + } + } } // function getFieldScore(x, y) { - return boardScoring[x][y] || 'standard'; + return boardScoring[x][y] || 'standard'; } var theirTrays; @@ -91,235 +91,246 @@ var border = 10; function makeBoard() { - var container = $('playfield'); - board = []; - for (x = 0; x < 15; x++) { - board[x] = []; - for (y = 0; y < 15; y++) { - var element = DIV(); - element.style.position = 'absolute'; - element.style.width = '40px'; - element.style.height = '40px'; - var imageName = (x == 7 && y == 7) ? "start-field" : getFieldScore(x, y); - element.style.backgroundImage = 'url(images/' + imageName + '.png)'; - element.x = x; - element.y = y; - setElementPosition(element, { x: border + x * 44, y: border + y * 44 }); - YAHOO.util.Event.on(element, 'click', emptyTileClicked) - board[x][y] = element; - } - appendChildNodes(container, board[x]); + var container = $('playfield'); + board = []; + for (x = 0; x < 15; x++) { + board[x] = []; + for (y = 0; y < 15; y++) { + var element = DIV(); + element.style.position = 'absolute'; + element.style.width = '40px'; + element.style.height = '40px'; + var imageName = (x == 7 && y == 7) ? "start-field" : getFieldScore(x, y); + element.style.backgroundImage = 'url(images/' + imageName + '.png)'; + element.x = x; + element.y = y; + setElementPosition(element, { x: border + x * 44, y: border + y * 44 }); + YAHOO.util.Event.on(element, 'click', emptyTileClicked) + board[x][y] = element; } + appendChildNodes(container, board[x]); + } - var shuffleButton = DIV(null, "shuffle"); - shuffleButton.style.color = 'white'; - shuffleButton.style.position = 'absolute'; - shuffleButton.onclick = shuffleMyTray; - setElementPosition(shuffleButton, { x: border + 480, y: border + 665 }); - appendChildNodes(container, shuffleButton); + var shuffleButton = DIV(null, "shuffle"); + shuffleButton.style.color = 'white'; + shuffleButton.style.position = 'absolute'; + shuffleButton.onclick = shuffleMyTray; + setElementPosition(shuffleButton, { x: border + 480, y: border + 665 }); + appendChildNodes(container, shuffleButton); - var gameLog = DIV({ id: 'gameLog' }, ""); - gameLog.style.position = 'absolute'; - gameLog.style.width = '280px'; - gameLog.style.height = '250px'; - gameLog.style.textAlign = 'left'; - gameLog.style.overflowY = 'scroll'; - setElementPosition(gameLog, { x: border + 680, y: border + 400 }); - appendChildNodes($('playfield'), gameLog); + var gameLog = DIV({ id: 'gameLog' }, ""); + gameLog.style.position = 'absolute'; + gameLog.style.width = '280px'; + gameLog.style.height = '250px'; + gameLog.style.textAlign = 'left'; + gameLog.style.overflowY = 'scroll'; + setElementPosition(gameLog, { x: border + 680, y: border + 400 }); + appendChildNodes($('playfield'), gameLog); + + var nextTurn = DIV({ id: 'nextTurn' }, ""); + nextTurn.style.position = 'absolute'; + nextTurn.style.width = '280px'; + nextTurn.style.textAlign = 'left'; + setElementPosition(nextTurn, { x: border + 680, y: border + 665 }); + appendChildNodes($('playfield'), nextTurn); } function setLetter(x, y, letter, isBlank) { - var image = IMG({ src: 'images/' + letter + (isBlank ? "-blank" : "") + '.png'}); - image.style.position = 'absolute'; - image.style.top = '3px'; - image.style.left = '3px'; - setElementPosition(image, { x: border + x * 44 + 3, y: border + y * 44 + 3 }); - appendChildNodes($('playfield'), image); - board[x][y].letterNode = image; - board[x][y].letter = letter; + var image = IMG({ src: 'images/' + letter + (isBlank ? "-blank" : "") + '.png'}); + image.style.position = 'absolute'; + image.style.top = '3px'; + image.style.left = '3px'; + setElementPosition(image, { x: border + x * 44 + 3, y: border + y * 44 + 3 }); + appendChildNodes($('playfield'), image); + board[x][y].letterNode = image; + board[x][y].letter = letter; } function placeLetter(x, y, tile) { - var mask = IMG({ src: 'images/mask.png'}); - mask.style.position = 'absolute'; - mask.style.top = '3px'; - mask.style.left = '3px'; - mask.style.zIndex = '20'; - appendChildNodes(board[x][y], mask); - board[x][y].letterNode = tile; - board[x][y].letter = tile.letter; - board[x][y].justPlaced = true; - tile.anim = new YAHOO.util.Motion(tile, { points: { to: [ border + x * 44 + 3, - border + y * 44 + 3 ]}}, - 0.15, - YAHOO.util.Easing.easeBoth); - tile.anim.animate(); + var mask = IMG({ src: 'images/mask.png'}); + mask.style.position = 'absolute'; + mask.style.top = '3px'; + mask.style.left = '3px'; + mask.style.zIndex = '20'; + appendChildNodes(board[x][y], mask); + board[x][y].letterNode = tile; + board[x][y].letter = tile.letter; + board[x][y].justPlaced = true; + tile.anim = new YAHOO.util.Motion(tile, { points: { to: [ border + x * 44 + 3, + border + y * 44 + 3 ]}}, + 0.15, + YAHOO.util.Easing.easeBoth); + tile.anim.animate(); } function letterAt(x, y) { - return board[x][y].letter && !board[x][y].justPlaced; + return board[x][y].letter && !board[x][y].justPlaced; } function Cursor() { - var image = new IMG({ src: 'images/cursor.png' }); - image.style.position = 'absolute'; - image.style.top = '-3px'; - image.style.left = '-3px'; + var image = new IMG({ src: 'images/cursor.png' }); + image.style.position = 'absolute'; + image.style.top = '-3px'; + image.style.left = '-3px'; - this.image = image; - this.x = -1; - this.y = -1; - this.direction = 0; + this.image = image; + this.x = -1; + this.y = -1; + this.direction = 0; - this.set = function(x, y) { - this.x = x; - this.y = y; - appendChildNodes(board[x][y], this.image); - board[x][y].cursor = this.image; - }; + this.set = function(x, y) { + this.x = x; + this.y = y; + appendChildNodes(board[x][y], this.image); + board[x][y].cursor = this.image; + }; - this.clear = function() { - if (this.x != -1) { - removeElement(board[this.x][this.y].cursor); - board[this.x][this.y].cursor = undefined; - this.x = this.y = -1; - this.direction = 0; - } - }; + this.clear = function() { + if (this.x != -1) { + removeElement(board[this.x][this.y].cursor); + board[this.x][this.y].cursor = undefined; + this.x = this.y = -1; + this.direction = 0; + } + }; - this.advance = function(isHoriz) { - var horizontal = 1; - var vertical = 2; - var direction = this.direction; - if (direction == 0) { - // Direction not determined - if (isHoriz != undefined) { - direction = isHoriz ? horizontal : vertical; - } else if (((this.y < 14) && letterAt(this.x, this.y + 1)) - || ((this.y > 1) - && letterAt(this.x, this.y - 1) - && !letterAt(this.x, this.y - 2)) - || ((this.x > 1) - && letterAt(this.x - 1, this.y) - && letterAt(this.x - 2, this.y))) { - direction = vertical; - } else { - direction = horizontal; - } - } - var x = this.x; - var y = this.y; - this.clear(); - this.direction = direction; - if (this.direction == horizontal) { - x++; - } else { - y++; - } - if ((x != 15) && (y != 15)) { - this.set(x, y); - } - }; + this.advance = function(isHoriz) { + var horizontal = 1; + var vertical = 2; + var direction = this.direction; + if (direction == 0) { + // Direction not determined + if (isHoriz != undefined) { + direction = isHoriz ? horizontal : vertical; + } else if (((this.y < 14) && letterAt(this.x, this.y + 1)) + || ((this.y > 1) + && letterAt(this.x, this.y - 1) + && !letterAt(this.x, this.y - 2)) + || ((this.x > 1) + && letterAt(this.x - 1, this.y) + && letterAt(this.x - 2, this.y))) { + direction = vertical; + } else { + direction = horizontal; + } + } + var x = this.x; + var y = this.y; + this.clear(); + this.direction = direction; + if (this.direction == horizontal) { + x++; + } else { + y++; + } + if ((x != 15) && (y != 15)) { + this.set(x, y); + } + }; } var cursor = new Cursor; function emptyTileClicked() { - cursor.clear(); - cursor.set(this.x, this.y); + cursor.clear(); + cursor.set(this.x, this.y); } var move = []; function makeMove(x, y, letter, isBlank) { - move[move.length] = [x, y, letter, isBlank]; - try { - checkMoveLegality(move); - $('move').onclick = submitMove; - $('move').innerHTML = move.toString(); - } - catch (e) { - $('move').onclick = undefined; - $('move').innerHTML = e.toString(); - } + move[move.length] = [x, y, letter, isBlank]; + try { + checkMoveLegality(move); + $('move').onclick = submitMove; + $('move').innerHTML = move.toString(); + } + catch (e) { + $('move').onclick = undefined; + $('move').innerHTML = e.toString(); + } } function clearMove() { - move = []; - $('move').onclick = null; - $('move').innerHTML = '[no move]'; + move = []; + $('move').onclick = null; + $('move').innerHTML = '[no move]'; } function submitMove() { - var queryString = MochiKit.Base.queryString({ move: move.toString(), game: gameID }); - var res = MochiKit.Async.doXHR("/place-tiles", - { method: 'POST', - sendContent: queryString, - headers: { "Content-Type": "application/x-www-form-urlencoded" } }); - res.addCallbacks(moveSuccess, moveFailure); + var queryString = MochiKit.Base.queryString({ move: move.toString(), game: gameID }); + var res = MochiKit.Async.doXHR("/place-tiles", + { method: 'POST', + sendContent: queryString, + headers: { "Content-Type": "application/x-www-form-urlencoded" } }); + res.addCallbacks(moveSuccess, moveFailure); } function moveSuccess(result) { - var response; - try { - response = eval('(' + result.responseText + ')'); - } - catch (e) { - alert("invalid JSON reply: " + result.responseText); - return; - } - if (response.error) { - alert(response.error); - } else { - clearMove(); - makeMyTray(map(function (entry) { return entry.letter }, response.tray)) - } + var response; + try { + response = eval('(' + result.responseText + ')'); + } + catch (e) { + alert("invalid JSON reply: " + result.responseText); + return; + } + if (response.error) { + alert(response.error); + } else { + clearMove(); + makeMyTray(response.tray); + } } function moveFailure(e) { - alert('failed: ' + e); + alert('failed: ' + e); } -var specialKeyCodes = { 59: 'LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS', - 192: 'LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS', - 222: 'LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS' }; +function letterKeyPressed(e) { + alert('foo'); -function letterKeyPressed(type, args, obj) { - var letter = specialKeyCodes[args[0]] || String.fromCharCode(args[0]); - var x = cursor.x; - var y = cursor.y; - var tilePosition = -1; + if (e.which == 0 || e.altKey || e.ctrlKey || e.shiftKey) { + // not a letter key + return; + } + + var letter = String.fromCharCode(e.which).toUpperCase(); + + var x = cursor.x; + var y = cursor.y; + var tilePosition = -1; + for (var i = 0; (tilePosition == -1) && (i < tray.length); i++) { + if (tray[i].letter == letter) { + tilePosition = i; + } + } + if (tilePosition == -1) { for (var i = 0; (tilePosition == -1) && (i < tray.length); i++) { - if (tray[i].letter == letter) { - tilePosition = i; - } + if (tray[i].letter == undefined) { + tilePosition = i; + } } - if (tilePosition == -1) { - for (var i = 0; (tilePosition == -1) && (i < tray.length); i++) { - if (tray[i].letter == undefined) { - tilePosition = i; - } - } + } + if (tilePosition == -1) { + alert("You don't have letter + '" + letter + "'!"); + } else { + var isHoriz; + if (move.length > 0) { + isHoriz = (move[0][0] != x); } - if (tilePosition == -1) { - alert("You don't have that letter!"); - } else { - var isHoriz; - if (move.length > 0) { - isHoriz = (move[0][0] != x); - } - cursor.advance(isHoriz); - if (!letterAt(x, y)) { - var tile = tray[tilePosition]; - tray.splice(tilePosition, 1); - placeLetter(x, y, tile); - makeMove(x, y, letter, tile.letter == undefined); - } + cursor.advance(isHoriz); + if (!letterAt(x, y)) { + var tile = tray[tilePosition]; + tray.splice(tilePosition, 1); + placeLetter(x, y, tile); + makeMove(x, y, tile.letterName, tile.letterName == undefined); } + } } var leftKey = 37; @@ -329,180 +340,176 @@ var backspaceKey = 8; function functionKeyPressed(type, args, obj) { - var x = cursor.x; - var y = cursor.y; + var x = cursor.x; + var y = cursor.y; - switch (args[0]) { - case rightKey: - while (x < 14) - if (!letterAt(++x, y)) - break; - break; - case leftKey: - while (x > 0) - if (!letterAt(--x, y)) - break; - break; - case upKey: - while (y > 0) - if (!letterAt(x, --y)) - break; - break; - case downKey: - while (y < 14) - if (!letterAt(x, ++y)) - break; - break; - } - if ((x >= 0) && (x <= 14) && (y >= 0) && (y <= 14)) { - cursor.clear(); - cursor.set(x, y); - } - YAHOO.util.Event.preventDefault(args[1]); + switch (args[0]) { + case rightKey: + while (x < 14) + if (!letterAt(++x, y)) + break; + break; + case leftKey: + while (x > 0) + if (!letterAt(--x, y)) + break; + break; + case upKey: + while (y > 0) + if (!letterAt(x, --y)) + break; + break; + case downKey: + while (y < 14) + if (!letterAt(x, ++y)) + break; + break; + } + if ((x >= 0) && (x <= 14) && (y >= 0) && (y <= 14)) { + cursor.clear(); + cursor.set(x, y); + } + YAHOO.util.Event.preventDefault(args[1]); } function clearBoard() { - for (x = 0; x < 15; x++) { - for (y = 0; y < 15; y++) { - var letterNode = board[x][y].letterNode; - if (letterNode) { - letterNode.anim = new YAHOO.util.Motion(letterNode, { points: { to: [ border + 7 * 44 + 3, - border + 7 * 44 + 3 ]}}, - 0.15); - letterNode.anim.onComplete.subscribe(function () { removeElement(this); }); - letterNode.anim.animate(); - } - } + for (x = 0; x < 15; x++) { + for (y = 0; y < 15; y++) { + var letterNode = board[x][y].letterNode; + if (letterNode) { + letterNode.anim = new YAHOO.util.Motion(letterNode, { points: { to: [ border + 7 * 44 + 3, + border + 7 * 44 + 3 ]}}, + 0.15); + letterNode.anim.onComplete.subscribe(function () { removeElement(this); }); + letterNode.anim.animate(); + } } + } } function trayClick(letter) { - this.clicked = !this.clicked; - this.anim = new YAHOO.util.Motion(this, { points: { by: [ 0, (this.clicked ? 15 : -15 ) ]}}, 0.15); - this.anim.animate(); + this.clicked = !this.clicked; + this.anim = new YAHOO.util.Motion(this, { points: { by: [ 0, (this.clicked ? 15 : -15 ) ]}}, 0.15); + this.anim.animate(); } function makeMyTray(letters) { - map(removeElement, tray); - tray = []; - for (var i = 0; i < letters.length; i++) { - var element = IMG({src: 'images/' + letters[i] + '.png'}); - element.letter = letters[i]; - element.style.position = 'absolute'; - element.style.width = '34px'; - element.style.height = '34px'; - element.style.zIndex = '10'; - element.onclick = trayClick; - setElementPosition(element, { x: border + 194 + i * 40, y: border + 665 }); - tray[i] = element; - } - appendChildNodes($('playfield'), tray); + map(removeElement, tray); + tray = []; + for (var i = 0; i < letters.length; i++) { + var element = IMG({src: 'images/' + letters[i].letterName + '.png'}); + element.letter = letters[i].letter; + element.letterName = letters[i].letterName; + element.style.position = 'absolute'; + element.style.width = '34px'; + element.style.height = '34px'; + element.style.zIndex = '10'; + element.onclick = trayClick; + setElementPosition(element, { x: border + 194 + i * 40, y: border + 665 }); + tray[i] = element; + } + appendChildNodes($('playfield'), tray); } function shuffleMyTray() { - var count = tray.length; - var newTray = []; - for (var i = 0; i < count; i++) { - do { - index = Math.floor(Math.random() * count); - } while (newTray[index]); - newTray[index] = tray[i]; - newTray[index].anim = new YAHOO.util.Motion(tray[i], { points: { to: [ border + 194 + i * 40, - border + 665 ] }}, - 0.5); - newTray[index].anim.animate(); - newTray[index].clicked = false; - } - tray = newTray; + var count = tray.length; + var newTray = []; + for (var i = 0; i < count; i++) { + do { + index = Math.floor(Math.random() * count); + } while (newTray[index]); + newTray[index] = tray[i]; + newTray[index].anim = new YAHOO.util.Motion(tray[i], { points: { to: [ border + 194 + i * 40, + border + 665 ] }}, + 0.5); + newTray[index].anim.animate(); + newTray[index].clicked = false; + } + tray = newTray; } var otherPlayerIndex = 0; function makeTheirTray (name, tileCount) { - var tray = []; - for (var i = 0; i < tileCount; i++) { - var element = IMG({src: 'images/null.png'}); - element.style.position = 'absolute'; - element.style.width = '34px'; - element.style.height = '34px'; - element.style.zIndex = '10'; - setElementPosition(element, { x: border + 680 + i * 40, y: border + 80 * otherPlayerIndex }); - tray[i] = element; - } - appendChildNodes($('playfield'), tray); + var tray = []; + for (var i = 0; i < tileCount; i++) { + var element = IMG({src: 'images/null.png'}); + element.style.position = 'absolute'; + element.style.width = '34px'; + element.style.height = '34px'; + element.style.zIndex = '10'; + setElementPosition(element, { x: border + 680 + i * 40, y: border + 80 * otherPlayerIndex }); + tray[i] = element; + } + appendChildNodes($('playfield'), tray); - var nameTag = DIV(null, name); - nameTag.style.position = 'absolute'; - nameTag.style.width = '200px'; - nameTag.style.textAlign = 'left'; - setElementPosition(nameTag, { x: border + 680, y: border + 80 * otherPlayerIndex + 50 }); - appendChildNodes($('playfield'), nameTag); - otherPlayerIndex++; + var nameTag = DIV(null, name); + nameTag.style.position = 'absolute'; + nameTag.style.width = '200px'; + nameTag.style.textAlign = 'left'; + setElementPosition(nameTag, { x: border + 680, y: border + 80 * otherPlayerIndex + 50 }); + appendChildNodes($('playfield'), nameTag); + otherPlayerIndex++; } function renderMoveAsText(move) { - var retval = move.participantLogin; - if (move.type == 'move') { - retval += " score: " + move.score; - for (var i = 0; i < move.words.length; i++) { - retval += " " + move.words[i][0] + "(" + move.words[i][1] + ")"; - } - } else { - retval += move.type; + var retval = move.participantLogin; + if (move.type == 'move') { + retval += " score: " + move.score; + for (var i = 0; i < move.words.length; i++) { + retval += " " + move.words[i][0] + "(" + move.words[i][1] + ")"; } + } else { + retval += move.type; + } - return retval; + return retval; } function drawGameState (gameState) { - for (var i = 0; i < gameState.board.length; i++) { - var x = gameState.board[i][0]; - var y = gameState.board[i][1]; - var char = gameState.board[i][2]; - setLetter(x, y, char, gameState.board[i].length > 3); + for (var i = 0; i < gameState.board.length; i++) { + var x = gameState.board[i][0]; + var y = gameState.board[i][1]; + var char = gameState.board[i][2]; + setLetter(x, y, char, gameState.board[i].length > 3); + } + var firstParticipant = gameState.participants[0]; + replaceChildNodes($('nextTurn'), + "It is " + + ((typeof firstParticipant.remainingTiles == 'number') ? (firstParticipant.name + "s") : "your") + + " turn"); + for (var i = 0; i < gameState.participants.length; i++) { + var participant = gameState.participants[i]; + if (typeof participant.remainingTiles == 'number') { + makeTheirTray(participant.name, participant.remainingTiles); + } else { + makeMyTray(participant.remainingTiles); } - for (var i = 0; i < gameState.participants.length; i++) { - var participant = gameState.participants[i]; - if (typeof participant.remainingTiles == 'number') { - makeTheirTray(participant.name, participant.remainingTiles); - } else { - makeMyTray(map(function (entry) { return entry.letter }, participant.remainingTiles)); - } - } - for (var i = 0; i < gameState.moves.length; i++) { - appendChildNodes($('gameLog'), DIV(null, renderMoveAsText(gameState.moves[i]))); - } + } + for (var i = 0; i < gameState.moves.length; i++) { + appendChildNodes($('gameLog'), DIV(null, renderMoveAsText(gameState.moves[i]))); + } } var legalLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".split(""); function init() { - makeBoard(); + makeBoard(); - var letterKeyCodes = []; - for (var i = 0; i < legalLetters.length; i++) { - letterKeyCodes[i] = legalLetters[i].charCodeAt(0); - } - // add mozilla key codes - letterKeyCodes.push(59); // u" - letterKeyCodes.push(192); // o" - letterKeyCodes.push(222); // a" - var letterKeyListener = new YAHOO.util.KeyListener(document, - { keys: letterKeyCodes }, - { fn: letterKeyPressed, scope: this, correctScope: true }); - letterKeyListener.enable(); + // does not work for ie (document.body needed)? + YAHOO.util.Event.on(window, 'keypress', letterKeyPressed); - var functionKeyListener = new YAHOO.util.KeyListener(document, - { keys: [ leftKey, upKey, rightKey, downKey, backspaceKey ] }, - { fn: functionKeyPressed, scope: this, correctScope: true }); - functionKeyListener.enable(); + var functionKeyListener = new YAHOO.util.KeyListener(document, + { keys: [ leftKey, upKey, rightKey, downKey, backspaceKey ] }, + { fn: functionKeyPressed, scope: this, correctScope: true }); + functionKeyListener.enable(); - var moveDisplay = DIV({ id: 'move' }, "[no move yet]"); - moveDisplay.style.color = 'white'; - moveDisplay.style.position = 'absolute'; - setElementPosition(moveDisplay, { x: border + 550, y: border + 665 }); - appendChildNodes(document.body, moveDisplay); - var d = loadJSONDoc("/game/" + gameID); - d.addCallbacks(drawGameState, function (error) { alert("Request error: " + error.message); }); + var moveDisplay = DIV({ id: 'move' }, "[no move yet]"); + moveDisplay.style.color = 'white'; + moveDisplay.style.position = 'absolute'; + setElementPosition(moveDisplay, { x: border + 550, y: border + 665 }); + appendChildNodes(document.body, moveDisplay); + var d = loadJSONDoc("/game/" + gameID); + d.addCallbacks(drawGameState, function (error) { alert("Request error: " + error.message); }); }

1 0

[bknr-cvs] r2291 - branches/trunk-reorg/thirdparty/emacs
by bknr＠bknr.net 27 Nov '07

27 Nov '07

Author: hhubner Date: 2007-11-27 06:01:50 -0500 (Tue, 27 Nov 2007) New Revision: 2291 Added: branches/trunk-reorg/thirdparty/emacs/javascript.el branches/trunk-reorg/thirdparty/emacs/js-mode.el branches/trunk-reorg/thirdparty/emacs/shellserver.xpi Log: Add Javascript development aids. Added: branches/trunk-reorg/thirdparty/emacs/javascript.el =================================================================== --- branches/trunk-reorg/thirdparty/emacs/javascript.el 2007-11-26 12:43:25 UTC (rev 2290) +++ branches/trunk-reorg/thirdparty/emacs/javascript.el 2007-11-27 11:01:50 UTC (rev 2291) @@ -0,0 +1,736 @@ +;;; javascript.el --- Major mode for editing JavaScript source text + +;; Copyright (C) 2006 Karl Landström + +;; Author: Karl Landström <kland(a)comhem.se> +;; Maintainer: Karl Landström <kland(a)comhem.se> +;; Version: 2.0 Beta 8 +;; Date: 2006-12-26 +;; Keywords: languages, oop + +;; This version contains a few font-lock fixes for quoted strings +;; and regular expressions by Joost Diepenmaat <joost(a)zeekat.nl> + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; The main features of this JavaScript mode are syntactic +;; highlighting (enabled with `font-lock-mode' or +;; `global-font-lock-mode'), automatic indentation and filling of +;; comments. +;; +;; This package has (only) been tested with GNU Emacs 21.4 (the latest +;; stable release). +;; +;; Installation: +;; +;; Put this file in a directory where Emacs can find it (`C-h v +;; load-path' for more info). Then add the following lines to your +;; Emacs initialization file: +;; +;; (add-to-list 'auto-mode-alist '("\\.js\\'" . javascript-mode)) +;; (autoload 'javascript-mode "javascript" nil t) +;; +;; General Remarks: +;; +;; This mode assumes that block comments are not nested inside block +;; comments and that strings do not contain line breaks. +;; +;; Exported names start with "javascript-" whereas private names start +;; with "js-". +;; +;; Changes: +;; +;; See javascript.el.changelog. + +;;; Code: + +(require 'cc-mode) +(require 'font-lock) +(require 'newcomment) + +(defgroup javascript nil + "Customization variables for `javascript-mode'." + :tag "JavaScript" + :group 'languages) + +(defcustom javascript-indent-level 4 + "Number of spaces for each indentation step." + :type 'integer + :group 'javascript) + +(defcustom javascript-auto-indent-flag t + "Automatic indentation with punctuation characters. If non-nil, the +current line is indented when certain punctuations are inserted." + :type 'boolean + :group 'javascript) + + +;; --- Keymap --- + +(defvar javascript-mode-map nil + "Keymap used in JavaScript mode.") + +(unless javascript-mode-map + (setq javascript-mode-map (make-sparse-keymap))) + +(when javascript-auto-indent-flag + (mapc (lambda (key) + (define-key javascript-mode-map key 'javascript-insert-and-indent)) + '("{" "}" "(" ")" ":" ";" ","))) + +(defun javascript-insert-and-indent (key) + "Run command bound to key and indent current line. Runs the command +bound to KEY in the global keymap and indents the current line." + (interactive (list (this-command-keys))) + (call-interactively (lookup-key (current-global-map) key)) + (indent-according-to-mode)) + + +;; --- Syntax Table And Parsing --- + +(defvar javascript-mode-syntax-table + (let ((table (make-syntax-table))) + (c-populate-syntax-table table) + + ;; switch off build-in quoted string detection + ;; since that just makes it really hard to detect + ;; regular expressions and comments + ;; + ;; this also has the benefit that multiline strings + ;; are now not recognized as strings (since javascript does + ;; not allow them) + (modify-syntax-entry ?' "." table) + (modify-syntax-entry ?\" "." table) + + ;; The syntax class of underscore should really be `symbol' ("_") + ;; but that makes matching of tokens much more complex as e.g. + ;; "\\<xyz\\>" matches part of e.g. "_xyz" and "xyz_abc". Defines + ;; it as word constituent for now. + (modify-syntax-entry ?_ "w" table) + + table) + "Syntax table used in JavaScript mode.") + + +(defun js-re-search-forward-inner (regexp &optional bound count) + "Auxiliary function for `js-re-search-forward'." + (let ((parse) + (saved-point (point-min))) + (while (> count 0) + (re-search-forward regexp bound) + (setq parse (parse-partial-sexp saved-point (point))) + (cond ((nth 3 parse) + (re-search-forward + (concat "\$[^\\]\\|^\$" (string (nth 3 parse))) + (save-excursion (end-of-line) (point)) t)) + ((nth 7 parse) + (forward-line)) + ((or (nth 4 parse) + (and (eq (char-before) ?\/) (eq (char-after) ?\*))) + (re-search-forward "\\*/")) + (t + (setq count (1- count)))) + (setq saved-point (point)))) + (point)) + + +(defun js-re-search-forward (regexp &optional bound noerror count) + "Search forward but ignore strings and comments. Invokes +`re-search-forward' but treats the buffer as if strings and +comments have been removed." + (let ((saved-point (point)) + (search-expr + (cond ((null count) + '(js-re-search-forward-inner regexp bound 1)) + ((< count 0) + '(js-re-search-backward-inner regexp bound (- count))) + ((> count 0) + '(js-re-search-forward-inner regexp bound count))))) + (condition-case err + (eval search-expr) + (search-failed + (goto-char saved-point) + (unless noerror + (error (error-message-string err))))))) + + +(defun js-re-search-backward-inner (regexp &optional bound count) + "Auxiliary function for `js-re-search-backward'." + (let ((parse) + (saved-point (point-min))) + (while (> count 0) + (re-search-backward regexp bound) + (when (and (> (point) (point-min)) + (save-excursion (backward-char) (looking-at "/[/*]"))) + (forward-char)) + (setq parse (parse-partial-sexp saved-point (point))) + (cond ((nth 3 parse) + (re-search-backward + (concat "\$[^\\]\\|^\$" (string (nth 3 parse))) + (save-excursion (beginning-of-line) (point)) t)) + ((nth 7 parse) + (goto-char (nth 8 parse))) + ((or (nth 4 parse) + (and (eq (char-before) ?/) (eq (char-after) ?*))) + (re-search-backward "/\\*")) + (t + (setq count (1- count)))))) + (point)) + + +(defun js-re-search-backward (regexp &optional bound noerror count) + "Search backward but ignore strings and comments. Invokes +`re-search-backward' but treats the buffer as if strings and +comments have been removed." + (let ((saved-point (point)) + (search-expr + (cond ((null count) + '(js-re-search-backward-inner regexp bound 1)) + ((< count 0) + '(js-re-search-forward-inner regexp bound (- count))) + ((> count 0) + '(js-re-search-backward-inner regexp bound count))))) + (condition-case err + (eval search-expr) + (search-failed + (goto-char saved-point) + (unless noerror + (error (error-message-string err))))))) + + +(defun js-continued-var-decl-list-p () + "Return non-nil if point is inside a continued variable declaration +list." + (interactive) + (let ((start (save-excursion (js-re-search-backward "\\<var\\>" nil t)))) + (and start + (save-excursion (re-search-backward "\n" start t)) + (not (save-excursion + (js-re-search-backward + ";\\|[^, \t][ \t]*\$/[/*]\\|$\$" start t)))))) + + +;; --- Font Lock --- + +(defun js-inside-param-list-p () + "Return non-nil if point is inside a function parameter list." + (condition-case err + (save-excursion + (up-list -1) + (and (looking-at "(") + (progn (backward-word 1) + (or (looking-at "function") + (progn (backward-word 1) (looking-at "function")))))) + (error nil))) + + +(defconst js-function-heading-1-re + "^[ \t]*function[ \t]+\$\\w+\$" + "Regular expression matching the start of a function header.") + +(defconst js-function-heading-2-re + "^[ \t]*\$\\w+\$[ \t]*:[ \t]*function\\>" + "Regular expression matching the start of a function entry in + an associative array.") + +(defconst js-keyword-re + (regexp-opt '("abstract" "break" "case" "catch" "class" "const" + "continue" "debugger" "default" "delete" "do" "else" + "enum" "export" "extends" "final" "finally" "for" + "function" "goto" "if" "implements" "import" "in" + "instanceof" "interface" "native" "new" "package" + "private" "protected" "public" "return" "static" + "super" "switch" "synchronized" "this" "throw" + "throws" "transient" "try" "typeof" "var" "void" + "volatile" "while" "with") 'words) + "Regular expression matching any JavaScript keyword.") + +(defconst js-basic-type-re + (regexp-opt '("boolean" "byte" "char" "double" "float" "int" "long" + "short" "void") 'words) + "Regular expression matching any predefined type in JavaScript.") + +(defconst js-constant-re + (regexp-opt '("false" "null" "true") 'words) + "Regular expression matching any future reserved words in JavaScript.") + + +(defconst js-quoted-string-re "\$\".*?[^\\]\"\\|'.*?[^\\]'\$") +(defconst js-quoted-string-or-regex-re "\$/.*?[^\\]/\\w*\\|\".*?[^\\]\"\\|'.*?[^\\]'\$") + + +(defconst js-font-lock-keywords-1 + (list + "\\<import\\>" + (list js-function-heading-1-re 1 font-lock-function-name-face) + (list js-function-heading-2-re 1 font-lock-function-name-face) + + ;; detect literal strings following a + operator + (list (concat "+[ \t]*" js-quoted-string-re) 1 font-lock-string-face) + + ;; detect literal strings used in "literal object" keys + (list (concat "[,{][ \t]*" js-quoted-string-re "[ \t]*:" ) 1 font-lock-string-face) + + ;; detects strings and regexes when assigned, passed, returned + ;; used as an object key string (i.e. bla["some string"]), when used + ;; as a literal object value (i.e. key: "string"), used as an array + ;; element, or when they appear as the first expression on a line + ;; and a few other hairy cases + (list (concat "[=(:,;[][ \t]*" js-quoted-string-or-regex-re) 1 font-lock-string-face) + (list (concat "^[ \t]*" js-quoted-string-or-regex-re) 1 font-lock-string-face) + (list (concat "return[ \t]*" js-quoted-string-or-regex-re) 1 font-lock-string-face) + + ;; detect "autoquoted" object properties... clases with "switch { ... default: }" + ;; may not be worth the trouble + (list "\$^[ \t]*\\|[,{][ \t]*\$\$\\w+\$:" 2 font-lock-string-face)) + + "Level one font lock.") + +(defconst js-font-lock-keywords-2 + (append js-font-lock-keywords-1 + (list (list js-keyword-re 1 font-lock-keyword-face) + (cons js-basic-type-re font-lock-type-face) + (cons js-constant-re font-lock-constant-face))) + "Level two font lock.") + + +;; Limitations with variable declarations: There seems to be no +;; sensible way to highlight variables occuring after an initialized +;; variable in a variable list. For instance, in +;; +;; var x, y = f(a, b), z +;; +;; z will not be highlighted. + +(defconst js-font-lock-keywords-3 + (append + js-font-lock-keywords-2 + (list + + ;; variable declarations + (list + (concat "\\<\$const\\|var\$\\>\\|" js-basic-type-re) + (list "\$\\w+\$[ \t]*\$[=;].*\\|,\\|/[/*]\\|$\$" + nil + nil + '(1 font-lock-variable-name-face))) + + ;; continued variable declaration list + (list + (concat "^[ \t]*\\w+[ \t]*\$[,;=]\\|/[/*]\\|$\$") + (list "\$\\w+\$[ \t]*\$[=;].*\\|,\\|/[/*]\\|$\$" + '(if (save-excursion (backward-char) (js-continued-var-decl-list-p)) + (backward-word 1) + (end-of-line)) + '(end-of-line) + '(1 font-lock-variable-name-face))) + + ;; formal parameters + (list + (concat "\\<function\\>\$[ \t]+\\w+\$?[ \t]*([ \t]*\\w") + (list "\$\\w+\$\$[ \t]*).*\$?" + '(backward-char) + '(end-of-line) + '(1 font-lock-variable-name-face))) + + ;; continued formal parameter list + (list + (concat "^[ \t]*\\w+[ \t]*[,)]") + (list "\\w+" + '(if (save-excursion (backward-char) (js-inside-param-list-p)) + (backward-word 1) + (end-of-line)) + '(end-of-line) + '(0 font-lock-variable-name-face))))) + "Level three font lock.") + +(defconst js-font-lock-keywords + '(js-font-lock-keywords-3 js-font-lock-keywords-1 js-font-lock-keywords-2 + js-font-lock-keywords-3) + "See `font-lock-keywords'.") + + +;; --- Indentation --- + +(defconst js-possibly-braceless-keyword-re + (regexp-opt + '("catch" "do" "else" "finally" "for" "if" "try" "while" "with") + 'words) + "Regular expression matching keywords that are optionally + followed by an opening brace.") + +(defconst js-indent-operator-re + (concat "[-+*/%<>=&^|?:]\$[^-+*/]\\|$\$\\|" + (regexp-opt '("in" "instanceof") 'words)) + "Regular expression matching operators that affect indentation + of continued expressions.") + + +(defun js-looking-at-operator-p () + "Return non-nil if text after point is an operator (that is not +a comma)." + (save-match-data + (and (looking-at js-indent-operator-re) + (or (not (looking-at ":")) + (save-excursion + (and (js-re-search-backward "[?:{]\\|\\<case\\>" nil t) + (looking-at "?"))))))) + + +(defun js-continued-expression-p () + "Returns non-nil if the current line continues an expression." + (save-excursion + (back-to-indentation) + (or (js-looking-at-operator-p) + (and (js-re-search-backward "\n" nil t) + (progn + (skip-chars-backward " \t") + (backward-char) + (and (> (point) (point-min)) + (save-excursion (backward-char) (not (looking-at "[/*]/"))) + (js-looking-at-operator-p) + (and (progn (backward-char) + (not (looking-at "++\\|--\\|/[/*]")))))))))) + + +(defun js-end-of-do-while-loop-p () + "Returns non-nil if word after point is `while' of a do-while +statement, else returns nil. A braceless do-while statement +spanning several lines requires that the start of the loop is +indented to the same column as the current line." + (interactive) + (save-excursion + (save-match-data + (when (looking-at "\\s-*\\<while\\>") + (if (save-excursion + (skip-chars-backward "[ \t\n]*}") + (looking-at "[ \t\n]*}")) + (save-excursion + (backward-list) (backward-word 1) (looking-at "\\<do\\>")) + (js-re-search-backward "\\<do\\>" (point-at-bol) t) + (or (looking-at "\\<do\\>") + (let ((saved-indent (current-indentation))) + (while (and (js-re-search-backward "^[ \t]*\\<" nil t) + (/= (current-indentation) saved-indent))) + (and (looking-at "[ \t]*\\<do\\>") + (not (js-re-search-forward + "\\<while\\>" (point-at-eol) t)) + (= (current-indentation) saved-indent))))))))) + + +(defun js-ctrl-statement-indentation () + "Returns the proper indentation of the current line if it +starts the body of a control statement without braces, else +returns nil." + (save-excursion + (back-to-indentation) + (when (save-excursion + (and (not (looking-at "[{]")) + (progn + (js-re-search-backward "[[:graph:]]" nil t) + (forward-char) + (when (= (char-before) ?\)) (backward-list)) + (skip-syntax-backward " ") + (skip-syntax-backward "w") + (looking-at js-possibly-braceless-keyword-re)) + (not (js-end-of-do-while-loop-p)))) + (save-excursion + (goto-char (match-beginning 0)) + (+ (current-indentation) javascript-indent-level))))) + + +(defun js-proper-indentation (parse-status) + "Return the proper indentation for the current line." + (save-excursion + (back-to-indentation) + (let ((ctrl-stmt-indent (js-ctrl-statement-indentation)) + (same-indent-p (looking-at "[]})]\\|\\<case\\>\\|\\<default\\>")) + (continued-expr-p (js-continued-expression-p))) + (cond (ctrl-stmt-indent) + ((js-continued-var-decl-list-p) + (js-re-search-backward "\\<var\\>" nil t) + (+ (current-indentation) javascript-indent-level)) + ((nth 1 parse-status) + (goto-char (nth 1 parse-status)) + (if (looking-at "[({[][ \t]*\$/[/*]\\|$\$") + (progn + (skip-syntax-backward " ") + (when (= (char-before) ?\)) (backward-list)) + (back-to-indentation) + (cond (same-indent-p + (current-column)) + (continued-expr-p + (+ (current-column) (* 2 javascript-indent-level))) + (t + (+ (current-column) javascript-indent-level)))) + (unless same-indent-p + (forward-char) + (skip-chars-forward " \t")) + (current-column))) + (continued-expr-p javascript-indent-level) + (t 0))))) + + +(defun javascript-indent-line () + "Indent the current line as JavaScript source text." + (interactive) + (let ((parse-status + (save-excursion (parse-partial-sexp (point-min) (point-at-bol)))) + (offset (- (current-column) (current-indentation)))) + (when (not (nth 8 parse-status)) + (indent-line-to (js-proper-indentation parse-status)) + (when (> offset 0) (forward-char offset))))) + + +;; --- Filling --- + +;; FIXME: It should be possible to use the more sofisticated function +;; `c-fill-paragraph' in `cc-cmds.el' instead. However, just setting +;; `fill-paragraph-function' to `c-fill-paragraph' does not work; +;; inside `c-fill-paragraph', `fill-paragraph-function' evaluates to +;; nil!? + +(defun js-backward-paragraph () + "Move backward to start of paragraph. Postcondition: Point is at +beginning of buffer or the previous line contains only whitespace." + (forward-line -1) + (while (not (or (bobp) (looking-at "^[ \t]*$"))) + (forward-line -1)) + (when (not (bobp)) (forward-line 1))) + + +(defun js-forward-paragraph () + "Move forward to end of paragraph. Postcondition: Point is at +end of buffer or the next line contains only whitespace." + (forward-line 1) + (while (not (or (eobp) (looking-at "^[ \t]*$"))) + (forward-line 1)) + (when (not (eobp)) (backward-char 1))) + + +(defun js-fill-block-comment-paragraph (parse-status justify) + "Fill current paragraph as a block comment. PARSE-STATUS is the +result of `parse-partial-regexp' from beginning of buffer to +point. JUSTIFY has the same meaning as in `fill-paragraph'." + (let ((offset (save-excursion + (goto-char (nth 8 parse-status)) (current-indentation)))) + (save-excursion + (save-restriction + (narrow-to-region (save-excursion + (goto-char (nth 8 parse-status)) (point-at-bol)) + (save-excursion + (goto-char (nth 8 parse-status)) + (re-search-forward "*/"))) + (narrow-to-region (save-excursion + (js-backward-paragraph) + (when (looking-at "^[ \t]*$") (forward-line 1)) + (point)) + (save-excursion + (js-forward-paragraph) + (when (looking-at "^[ \t]*$") (backward-char)) + (point))) + (goto-char (point-min)) + (while (not (eobp)) + (delete-horizontal-space) + (forward-line 1)) + (let ((fill-column (- fill-column offset)) + (fill-paragraph-function nil)) + (fill-paragraph justify)) + + ;; In Emacs 21.4 as opposed to CVS Emacs 22, + ;; `fill-paragraph' seems toadd a newline at the end of the + ;; paragraph. Remove it! + (goto-char (point-max)) + (when (looking-at "^$") (backward-delete-char 1)) + + (goto-char (point-min)) + (while (not (eobp)) + (indent-to offset) + (forward-line 1)))))) + + +(defun js-sline-comment-par-start () + "Return point at the beginning of the line where the current +single-line comment paragraph starts." + (save-excursion + (beginning-of-line) + (while (and (not (bobp)) + (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) + (forward-line -1)) + (unless (bobp) (forward-line 1)) + (point))) + + +(defun js-sline-comment-par-end () + "Return point at end of current single-line comment paragraph." + (save-excursion + (beginning-of-line) + (while (and (not (eobp)) + (looking-at "^[ \t]*//[ \t]*[[:graph:]]")) + (forward-line 1)) + (unless (bobp) (backward-char)) + (point))) + + +(defun js-sline-comment-offset (line) + "Return the column at the start of the current single-line +comment paragraph." + (save-excursion + (goto-line line) + (re-search-forward "//" (point-at-eol)) + (goto-char (match-beginning 0)) + (current-column))) + + +(defun js-sline-comment-text-offset (line) + "Return the column at the start of the text of the current +single-line comment paragraph." + (save-excursion + (goto-line line) + (re-search-forward "//[ \t]*" (point-at-eol)) + (current-column))) + + +(defun js-at-empty-sline-comment-p () + "Return non-nil if inside an empty single-line comment." + (and (save-excursion + (beginning-of-line) + (not (looking-at "^.*//.*[[:graph:]]"))) + (save-excursion + (re-search-backward "//" (point-at-bol) t)))) + + +(defun js-fill-sline-comments (parse-status justify) + "Fill current paragraph as a sequence of single-line comments. +PARSE-STATUS is the result of `parse-partial-regexp' from +beginning of buffer to point. JUSTIFY has the same meaning as in +`fill-paragraph'." + (when (not (js-at-empty-sline-comment-p)) + (let* ((start (js-sline-comment-par-start)) + (start-line (1+ (count-lines (point-min) start))) + (end (js-sline-comment-par-end)) + (offset (js-sline-comment-offset start-line)) + (text-offset (js-sline-comment-text-offset start-line))) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*//[ \t]*" nil t) + (replace-match "") + (forward-line 1)) + (let ((fill-paragraph-function nil) + (fill-column (- fill-column text-offset))) + (fill-paragraph justify)) + + ;; In Emacs 21.4 as opposed to CVS Emacs 22, + ;; `fill-paragraph' seems toadd a newline at the end of the + ;; paragraph. Remove it! + (goto-char (point-max)) + (when (looking-at "^$") (backward-delete-char 1)) + + (goto-char (point-min)) + (while (not (eobp)) + (indent-to offset) + (insert "//") + (indent-to text-offset) + (forward-line 1))))))) + + +(defun js-trailing-comment-p (parse-status) + "Return non-nil if inside a trailing comment. PARSE-STATUS is +the result of `parse-partial-regexp' from beginning of buffer to +point." + (save-excursion + (when (nth 4 parse-status) + (goto-char (nth 8 parse-status)) + (skip-chars-backward " \t") + (not (bolp))))) + + +(defun js-block-comment-p (parse-status) + "Return non-nil if inside a block comment. PARSE-STATUS is the +result of `parse-partial-regexp' from beginning of buffer to +point." + (save-excursion + (save-match-data + (when (nth 4 parse-status) + (goto-char (nth 8 parse-status)) + (looking-at "/\\*"))))) + + +(defun javascript-fill-paragraph (&optional justify) + "If inside a comment, fill the current comment paragraph. +Trailing comments are ignored." + (interactive) + (let ((parse-status (parse-partial-sexp (point-min) (point)))) + (when (and (nth 4 parse-status) + (not (js-trailing-comment-p parse-status))) + (if (js-block-comment-p parse-status) + (js-fill-block-comment-paragraph parse-status justify) + (js-fill-sline-comments parse-status justify)))) + t) + + +;; --- Imenu --- + +(defconst js-imenu-generic-expression + (list + (list + nil + "function\\s-+\$\\w+\$\\s-*(" + 1)) + "Regular expression matching top level procedures. Used by imenu.") + + +;; --- Main Function --- + +;;;###autoload +(defun javascript-mode () + "Major mode for editing JavaScript source text. + +Key bindings: + +\\{javascript-mode-map}" + (interactive) + (kill-all-local-variables) + + (use-local-map javascript-mode-map) + (set-syntax-table javascript-mode-syntax-table) + (set (make-local-variable 'indent-line-function) 'javascript-indent-line) + (set (make-local-variable 'font-lock-defaults) (list js-font-lock-keywords)) + + (set (make-local-variable 'parse-sexp-ignore-comments) t) + + ;; Comments + (setq comment-start "// ") + (setq comment-end "") + (set (make-local-variable 'fill-paragraph-function) + 'javascript-fill-paragraph) + + ;; Imenu + (setq imenu-case-fold-search nil) + (set (make-local-variable 'imenu-generic-expression) + js-imenu-generic-expression) + + (setq major-mode 'javascript-mode) + (setq mode-name "JavaScript") + (run-hooks 'javascript-mode-hook)) + + +(provide 'javascript-mode) +;;; javascript.el ends here Added: branches/trunk-reorg/thirdparty/emacs/js-mode.el =================================================================== --- branches/trunk-reorg/thirdparty/emacs/js-mode.el 2007-11-26 12:43:25 UTC (rev 2290) +++ branches/trunk-reorg/thirdparty/emacs/js-mode.el 2007-11-27 11:01:50 UTC (rev 2291) @@ -0,0 +1,759 @@ +;;; js-mode.el --- minor mode for interacting with Mozilla +;; +;; Copyright (C) 2004 Helmut Eller +;; +;; You can redistribute this file under the terms of the GNU General +;; Public License. +;; + +;;; Commentary: +;; +;; This file implements some commands for interacting with Mozilla +;; from Emacs. Emacs uses a TCP connection to communicate with +;; Mozilla. The available commands are: +;; +;; C-c : Sends a piece of Javascript code to Mozilla for evaluation +;; and prints the result. +;; +;; C-M-x Evaluates the current function defintion in Mozilla. +;; C-c C-e Evaluates the current line. +;; C-c C-r Evaluates the current region +;; +;; C-c C-l Loads a javascript file. +;; +;; M-. Finds the source location of function definitions. +;; M-, Returns to the origin of the last M-. command. +;; +;; C-c C-d Can be used to inspect the Javascript objects. +;; +;; This file also implements a simple debugger. The debugger is +;; invoked when an error occurs. The debugger can show the backtrace, +;; the values of local variables in frames and the source location +;; corresponding to frames. It is also possible to invoke the +;; debugger exlicitly by inserting the "debugger" keyword in javacript +;; code. Furthermore, the debugger can be invoked on throw +;; statements. Use C-c C-b t to enable debugging on throw. +;; +;; Installation: +;; +;; - First you have to load the server in Mozilla. You can add the +;; file emacsslave.js to your rc file or make the neccessary +;; modifications to conkeror itself. The server can be started with +;; M-x start-server in Conkeror. +;; +;; - Put this file into your Emacs load path add something like this +;; to your .emacs: +;; +;; (add-hook 'javascript-mode-hook 'js-mode) +;; (autoload 'js-mode "js-mode" nil t) +;; +;; - Then open a javascript file and make sure js-mode is enabled. To +;; connect to Mozilla type M-x js-connect. +;; +;; - Then you can try the commands from above. +;; +;;; +;; +;; The code should work in Emacs 20.7 and Emacs 21. XEmacs +;; compatibility is a bit problematic at the moment. + +;;; Code: + +(eval-and-compile + (require 'cl) + (unless (fboundp 'define-minor-mode) + (require 'easy-mmode) + (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))) + +(require 'pp) +(require 'cc-mode) + +(defvar js-mode-map (make-sparse-keymap)) + +(define-minor-mode js-mode + "Minor mode for interacting with Mozilla. + +Use \\[js-connect] to establish a connection with Mozilla. +Some other commands are: +\\{js-mode-map}" + nil nil ()) + +(add-to-list 'minor-mode-alist + '(js-mode (js-mozilla-connection " [js]" " js"))) + +(define-key js-mode-map (kbd "M-C-x") 'js-eval-defun) +(define-key js-mode-map (kbd "C-c :") 'js-interactive-eval) +(define-key js-mode-map (kbd "C-c C-e") 'js-eval-current-line) +(define-key js-mode-map (kbd "C-c C-r") 'js-eval-region) +(define-key js-mode-map (kbd "C-c C-l") 'js-load-file) +(define-key js-mode-map (kbd "M-.") 'js-find-definitions) +(define-key js-mode-map (kbd "M-,") 'js-pop-find-definition-stack) +(define-key js-mode-map (kbd "C-c C-d") 'js-inspect) +(define-key js-mode-map (kbd "C-c C-b t") 'js-toggle-break-on-throw) +(define-key js-mode-map (kbd "C-c C-b C-t") 'js-toggle-break-on-throw) + + +;;; Generally useful stuff + +(defun js-symbol-at-point () + "Return the symbol at point as string, or nil." + (save-restriction + (save-excursion + (let ((string (thing-at-point 'symbol))) + (and string (not (equal string "")) + (substring-no-properties string)))))) + +(defun js-read-symbol (prompt &optional query) + "Either read a symbol name or choose the one at point. +The user is prompted if a prefix argument is in effect, if there is no +symbol at point, or if QUERY is non-nil." + (cond ((or current-prefix-arg query (not (js-symbol-at-point))) + (read-from-minibuffer prompt (js-symbol-at-point))) + (t (js-symbol-at-point)))) + +(make-variable-buffer-local + (defvar js-old-window-config nil + "The window configuration before when before temp-buffer was displayed. +Buffer local in temp-buffers.")) + + + +;;; Networking + +(defvar js-mozilla-connection nil) + +(defun js-connect (port) + "Connect to Mozilla on PORT." + (interactive (list (read-from-minibuffer "Port: " "4007" nil t))) + (let ((socket (js-net-connect port))) + (setq js-mozilla-connection socket) + (js-eval `(mozilla_info) (lambda (info) + (message "Connected to: %s" (car info)))))) + +(defun js-disconnect () + "Close the connection to Mozilla." + (interactive) + (delete-process js-mozilla-connection) + (setq js-mozilla-connection nil)) + +(defun js-connection () + (when (not js-mozilla-connection) + (error "Not connected")) + js-mozilla-connection) + +(defun js-make-net-buffer (name) + "Make a buffer suitable for a network process." + (let ((buffer (generate-new-buffer name))) + (with-current-buffer buffer + (when (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + (buffer-disable-undo)) + buffer)) + +(defun js-net-connect (port) + (let* ((socket (open-network-stream "Mozilla" nil "localhost" port)) + (buffer (js-make-net-buffer "*mozilla*"))) + (set-process-buffer socket buffer) + (set-process-filter socket 'js-net-filter) + (set-process-sentinel socket 'js-net-sentinel) + (when (fboundp 'set-process-coding-system) + (set-process-coding-system socket 'no-conversion 'no-conversion)) + socket)) + +(defun js-net-send (string connection) + (let ((string (concat (js-net-encode-length (length string)) string))) + (process-send-string connection (string-make-unibyte string)))) + +(defun js-net-encode-length (n) + (format "%06x" n)) + +(defun js-net-filter (process string) + "Accept output from the socket and input all complete messages." + (with-current-buffer (process-buffer process) + (save-excursion + (goto-char (point-max)) + (insert string)) + (goto-char (point-min)) + (js-process-available-input))) + +(defun js-process-available-input () + "Process all complete messages that have arrived from Mozilla." + (unwind-protect + (when (js-connection) + (with-current-buffer (process-buffer (js-connection)) + (while (js-net-have-input-p) + (let ((event (condition-case error (js-net-read) + (error (js-net-panic error))))) + (save-current-buffer + (js-dispatch-event event)))))) + (when (js-connection) + (with-current-buffer (process-buffer (js-connection)) + (when (js-net-have-input-p) + (run-at-time 0 nil 'js-process-available-input)))))) + +(defun js-net-panic (error) + (message "net-read error: %S" error) + (let ((string (buffer-string))) + (ignore-errors + (js-disconnect) + (kill-buffer (current-buffer))) + (ding) + (sleep-for 2) + (with-current-buffer (generate-new-buffer "*saved-connecton-buffer*") + (insert string) + (error "PANIC!" error)))) + +(defun js-net-have-input-p () + "Return true if a complete message is available." + (and (>= (buffer-size) 6) + (>= (- (buffer-size) 6) (js-net-read-length)))) + +(defun js-net-read-length () + (string-to-number (buffer-substring (point) (+ (point) 6)) 16)) + +(defun js-net-read () + (let* ((length (js-net-read-length)) + (start (+ 6 (point))) + (end (+ start length))) + (let ((string (buffer-substring start end))) + (prog1 (read string) + (delete-region (point-min) end))))) + +(defun js-net-sentinel (process message) + (message "Mozilla connection closed unexpectedly: %s" message) + (when (eq process js-mozilla-connection) + (setq js-mozilla-connection nil)) + (kill-buffer (process-buffer process))) + +(defun js-send (term) + (js-log-event (list 'send term)) + (js-net-send (js-term-to-string term) (js-connection))) + +(defun js-term-to-string (term) + (etypecase term + (symbol (concat "'" (symbol-name term) "'")) + (string (with-temp-buffer + (let ((print-escape-nonascii t) + (print-escape-newlines t)) + (prin1 term (current-buffer)) + (buffer-string)))) + (number (number-to-string term)) + (cons (concat "[" (mapconcat 'js-term-to-string term ", ") "]")))) + +;;; Event logging + +(defvar js-log-events t + "*Log protocol events to the *js-events* buffer.") + +(defvar js-log-buffer-name "*js-events*" + "The name of the js event buffer.") + +(defun js-log-event (event) + "Record the fact that EVENT occurred." + (when js-log-events + (with-current-buffer (js-events-buffer) + ;; trim? + (when (> (buffer-size) 100000) + (goto-char (/ (buffer-size) 2)) + (re-search-forward "^(" nil t) + (delete-region (point-min) (point))) + (goto-char (point-max)) + (save-excursion + (js-pprint-event event (current-buffer))) + (goto-char (point-max))))) + +(defun js-pprint-event (event buffer) + "Pretty print EVENT in BUFFER with limited depth and width." + (let ((print-length 20) + (print-level 6) + (pp-escape-newlines t)) + (pp event buffer))) + +(defun js-events-buffer () + (get-buffer-create js-log-buffer-name)) + +;;; RPCing + +(defvar js-continuations () + "An alist of (ID . FUNCTION) functions waiting for results.") + +(defvar js-continuation-counter 0 + "Counter to generate serial number for continuations.") + +(defun js-dispatch-event (event) + (js-log-event event) + (apply (car event) (cdr event))) + +(defun js-eval (term cont) + "Evaluate term in Mozilla and call the function CONT with the result." + (let ((id (incf js-continuation-counter)) + (cont (lexical-let ((cont cont) (buffer (current-buffer))) + (lambda (status value) + (with-current-buffer (js-buffer-for-eval buffer) + (ecase status + (ok (funcall cont value)) + (error (message "Evaluation aborted: %s" value)))))))) + (push (cons id cont) js-continuations) + (js-send `(eval_for_emacs ,term ,id)))) + +(defun js-buffer-for-eval (saved-buffer) + (let ((alive (buffer-name saved-buffer))) + (cond (alive saved-buffer) + (t (generate-new-buffer (format "*killed %s*" saved-buffer)))))) + +(defun js-return (id status value) + (let ((rec (assq id js-continuations))) + (cond (rec (setq js-continuations (delete rec js-continuations)) + (funcall (cdr rec) status value)) + (t + (error "Unexpected reply: %S %S" id value))))) + +(defvar js-wait-tags ()) + +(defun js-eval-wait (term) + "Evaluate TERM in Mozilla and wait until the result is available." + (let* ((id (incf js-continuation-counter)) + (tag (gensym)) + (unwind (lexical-let ((tag tag)) + (lambda (status value) + (unless (memq tag js-wait-tags) + (error "Wait-tag not active: %S." tag)) + (throw tag (list status value)))))) + (push (cons id unwind) js-continuations) + (js-send `(eval_for_emacs ,term ,id)) + (destructuring-bind (status value) (js-wait tag) + (ecase status + (ok value) + (error (error "Syncronous evaluation aborted: %s" value)))))) + +(defun js-wait (wait-tag) + (let ((js-wait-tags (cons wait-tag js-wait-tags)) + (debug-on-quit t) + (inhibit-quit nil)) + (catch wait-tag + (while t (accept-process-output nil 0 10000))))) + +(defun js-show-result (result) + (message "%S" result)) + +;;; Evaluation Commands + +(defun js-beginning-of-defun () + "Move to the beginning of the current function. +Point is placed before foo in the folling example: + +foo = function (bar) +{ + ... +}" + (interactive) + (c-beginning-of-defun 1) + (beginning-of-line) + (when (looking-at "[ \t]*{") + (forward-line -1))) + +(defconst js-identifier + "[a-zA-Z_\\$][a-zA-Z0-9_\\$]*" + "Expression for matching Javascript identifiers.") + +(defun js-hack-defun (string) + "If STRING looks like function <name> { convert it to <name> = function {" + (cond ((string-match (concat "^function\\s +\$" js-identifier "\$\\s *(") + string) + (format "%s = function %s" (match-string 1 string) + (substring string (position ?\( string)))) + (t string))) + +(defun js-eval-defun () + "Evaluate the current function." + (interactive) + (save-excursion + (c-end-of-defun) + (let ((end (point))) + (js-beginning-of-defun) + (let ((string (buffer-substring-no-properties (point) end))) + (js-eval `(interactive_eval ,(js-hack-defun string)) + (lambda (result) (message "%s" result))))))) + +(defun js-interactive-eval (string &optional insertp) + (interactive "Mjavascript eval: \nP") + (cond (insertp + (beginning-of-line 2) + (js-eval `(interactive_eval ,string) #'insert)) + (t + (js-eval `(interactive_eval ,string) + (lambda (result) (message "%s" result)))))) + +(defun js-eval-region (start end &optional insertp) + "Eval region in Mozilla. +Insert the result in the current buffer when called with a prefix argument." + (interactive "r\nP") + (js-interactive-eval (buffer-substring-no-properties start end) insertp)) + +(defun js-eval-current-line (&optional insertp) + "Eval the current line. See `js-eval-region'." + (interactive "P") + (js-eval-region (line-beginning-position) (line-end-position) insertp)) + +(defun js-load-file (filename) + "Load the javascript file FILENAME in Mozilla." + (interactive (list (read-file-name "Load file: " nil nil + nil (file-name-nondirectory + (buffer-file-name))))) + (let ((url (concat "file:" (expand-file-name filename)))) + (js-eval `(load_file_for_emacs ,url) + (lambda (message) + (message "Loaded: %s" message))))) + + +;;;; Find definitions + +(defvar js-find-definition-history-ring (make-ring 20) + "History ring recording the definition-finding \"stack\".") + +(defun js-push-definition-stack () + "Add MARKER to the edit-definition history stack. +If MARKER is nil, use the point." + (ring-insert-at-beginning js-find-definition-history-ring (point-marker))) + +(defun js-pop-find-definition-stack () + "Pop the edit-definition stack and goto the location." + (interactive) + (unless (ring-empty-p js-find-definition-history-ring) + (let* ((marker (ring-remove js-find-definition-history-ring)) + (buffer (marker-buffer marker))) + (if (buffer-live-p buffer) + (progn (switch-to-buffer buffer) + (goto-char (marker-position marker))) + ;; If this buffer was deleted, recurse to try the next one + (js-pop-find-definition-stack))))) + +(defun js-find-definitions (name) + "Lookup the definition of the symbol at point." + (interactive (list (js-read-symbol "Name: "))) + (js-eval `(find_definitions ,name) + (lexical-let ((name name)) + (lambda (defs) (js-show-definitions name defs))))) + +(defun js-show-definitions (name defs) + (unless (not defs) + (js-push-definition-stack)) + (cond ((null defs) (message "No definitions for: %s" name) (ding)) + ((null (cdr defs)) (js-goto-definition (car defs))) + (t (js-display-multiple-definitions defs)))) + +(defun js-goto-definition (definition &optional other-window) + (destructuring-bind (filename line) definition + (let ((buffer (js-find-source-buffer filename))) + (cond (other-window (switch-to-buffer-other-window buffer)) + (t (switch-to-buffer buffer))) + (goto-line line)))) + +(defun js-find-source-buffer (filename) + (cond ((string-match "^file:" filename) + (find-file-noselect (substring filename (length "file:")))) + ((string-match "^\$http\\|chrome\$:" filename) + (or (get-buffer filename) + (with-current-buffer (get-buffer-create filename) + (insert (js-eval-wait `(load_source ,filename))) + (not-modified) + (setq buffer-read-only t) + (setq buffer-file-name filename) + (normal-mode) + (js-mode 1) + (current-buffer)))) + (t (error "cannot resolve url: %s" filename)))) + +(defun js-display-multiple-definitions (defs) + "Display a buffer to browse the list of definitions DEFS." + (with-current-buffer (get-buffer-create "*definitions*") + (setq buffer-read-only nil) + (erase-buffer) + (setq js-old-window-config (current-window-configuration)) + (let ((keymap (make-sparse-keymap))) + (define-key keymap (kbd "RET") 'js-show-definition-other-window) + (define-key keymap (kbd "SPC") 'js-pop-to-definition) + (define-key keymap [?q] 'js-quit) + (use-local-map keymap) + (dolist (def defs) + (destructuring-bind (file line) def + (let ((start (point))) + (insert (format "%s:%d\n" file line)) + (add-text-properties start (1- (point)) `(definition ,def))))) + (goto-char (point-min)) + (setq buffer-read-only t) + (let ((w (select-window (display-buffer (current-buffer))))) + (shrink-window-if-larger-than-buffer w))))) + +(defun js-quit () + "Kill the current buffer and restore the old window configuration." + (interactive) + (let ((buffer (current-buffer))) + (set-window-configuration js-old-window-config) + (kill-buffer buffer))) + +(defun js-property-at-point (prop) + (or (get-text-property (point) prop) + (error "No %s at point" prop))) + +(defun js-pop-to-definition (definition) + "Jump to the definition at point and close the current window." + (interactive (list (js-property-at-point 'definition))) + (delete-window) + (js-goto-definition definition)) + +(defun js-show-definition-other-window (definition) + "Display the defintion at point in window." + (interactive (list (js-property-at-point 'definition))) + (save-selected-window + (js-goto-definition definition t) + (let ((overlay (make-overlay (line-beginning-position) + (line-end-position)))) + (overlay-put overlay 'face 'secondary-selection) + (run-with-timer 0.3 nil 'delete-overlay overlay)))) + +;;; Debugger + +(defvar js-debugger-level 0) + +(define-derived-mode js-debugger-mode fundamental-mode "jsdbg" + "Mode to inspect backtraces. +See also `js-toggle-break-on-throw'. + +\\{js-debugger-mode-map}" + (erase-buffer) + (set (make-local-variable 'truncate-lines) t) + (set-syntax-table c++-mode-syntax-table)) + +(let ((m js-debugger-mode-map)) + (define-key m "v" 'js-debugger-show-source) + (define-key m "q" 'js-debugger-quit) + (define-key m "t" 'js-debugger-toggle-locals) + (define-key m "i" 'js-debugger-inspect-variable)) + +(defun js-debugger-buffer () + (get-buffer-create "*js-debugger*")) + +(defun js-debugger-activate (level) + (with-current-buffer (js-debugger-buffer) + (unless (equal js-debugger-level level) + (with-lexical-bindings (level) + (js-eval `(debugger_info_for_emacs 0 1) + (lambda (info) + (apply #'js-debugger-setup level info))))))) + +(defun js-debugger-setup (level message backtrace) + (with-current-buffer (js-debugger-buffer) + (unless (equal js-debugger-level level) + (setq buffer-read-only nil) + (js-debugger-mode) + (js-mode 1) + (unless js-old-window-config + (setq js-old-window-config (current-window-configuration))) + (setq mode-name (format "js-debugger[%d]" js-debugger-level)) + (insert message "\n") + (insert "\nBacktrace: \n") + (save-excursion (js-insert-backtrace backtrace)) + (setq buffer-read-only t) + (pop-to-buffer (current-buffer)) + (when (and js-wait-tags + (y-or-n-p "Enter recursive edit? ")) + (message "Entering recursive edit..") + (recursive-edit))))) + +(defun js-insert-backtrace (backtrace) + (mapc #'js-insert-frame backtrace)) + +(defun js-insert-frame (frame) + (destructuring-bind (number text) frame + (let ((start (point-marker))) + (set-marker-insertion-type start nil) + (insert text) + (let ((end (point-marker))) + (insert "\n") + (set-marker-insertion-type end t) + (add-text-properties start end + (list 'frame number + 'text text + 'start start 'end end)))))) + +(defun js-debugger-show-source (frame) + "Show the source buffer for the frame at point." + (interactive (list (js-property-at-point 'frame))) + (js-eval `(frame_source_location ,frame) + (lambda (location) + (destructuring-bind (file baseline line) location + (js-show-definition-other-window (list file line)))))) + +(defun js-debugger-quit () + "Exit from the debugger and continue execution." + (interactive) + (js-eval `(debugger_quit) + (lambda (x) + (message "%S" x) + (let ((buffer (current-buffer))) + (set-window-configuration js-old-window-config) + (kill-buffer buffer))))) + +(defun js-debugger-toggle-locals (frame) + "Show the local variables for the current frame." + (interactive (list (js-property-at-point 'frame))) + (let ((inhibit-read-only t)) + (destructuring-bind (text start end detailsp) + (loop for p in '(text start end detailsp) + collect (get-text-property (point) p)) + (cond ((not detailsp) + (let ((locals (js-eval-wait `(frame_locals ,frame)))) + (goto-char end) + (let ((new-start (point))) + (insert-and-inherit text "\n") + (loop for l in locals for i from 0 + do (js-insert-line-with-props (concat " " l ) + `(local-var ,i))) + (delete-region start new-start) + (put-text-property start end 'detailsp t)))) + (t + (goto-char end) + (let ((new-start (point))) + (insert-and-inherit text) + (delete-region start new-start) + (put-text-property start end 'detailsp nil)))) + (goto-char start)))) + +(defun js-insert-line-with-props (text props) + (let ((start (point))) + (insert-and-inherit text) + (let ((end (point))) + (insert-and-inherit "\n") + (add-text-properties start end props)))) + +(defun js-debugger-inspect-variable (frame var) + "Inspect the variable at point." + (interactive (list (js-property-at-point 'frame) + (js-property-at-point 'local-var))) + (js-eval `(inspect_local_variable ,frame ,var) + 'js-open-inspector)) + +(defun js-toggle-break-on-throw () + "Enable or disable debugging on throws." + (interactive) + (js-eval `(toggle_break_on_throw) (lambda (m) (message "%s" m)))) + + +;;; Inspector + +(defvar js-inspect-hist ()) + +(defun js-inspect (string) + "Evalute STRING and inspect the result." + (interactive (list (read-from-minibuffer "Inspect value (evaluated): " + nil nil nil 'js-inspect-hist))) + (js-eval `(init_inspector ,string) 'js-open-inspector)) + +(define-derived-mode js-inspector-mode fundamental-mode "Javascript-Inspector" + "Mode to inspect Javascript objects. + +\\{js-debugger-mode-map}" + (set-syntax-table java-mode-syntax-table) + (set (make-local-variable 'truncate-lines) t) + (setq buffer-read-only t)) + +(let ((m js-inspector-mode-map)) + (define-key m (kbd "RET") 'js-inspect-part) + (define-key m "l" 'js-inspector-last) + (define-key m "n" 'js-inspector-next) + (define-key m "a" 'js-inspector-apply-part) + (define-key m "q" 'js-quit-inspector)) + +(defun js-inspector-buffer () + (or (get-buffer "*Javascript Inspector*") + (with-current-buffer (get-buffer-create "*Javascript Inspector*") + (setq js-inspector-mark-stack '()) + (js-inspector-mode) + (js-mode 1) + (setq js-old-window-config (current-window-configuration)) + (current-buffer)))) + +(defun js-open-inspector (parts &optional point) + (with-current-buffer (js-inspector-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (destructuring-bind (printed type lines) parts + (insert printed "\n") + (insert " [type: " type "]\n\n") + (save-excursion + (loop for (label text) in lines for i from 0 + do (js-insert-line-with-props (concat label ": " text) + `(part ,i)))) + (pop-to-buffer (current-buffer)) + (when point + (goto-char (min (point-max) point))))))) + +(defun js-inspect-part (id) + "Inspect the slot at point." + (interactive (list (js-property-at-point 'part))) + (js-eval `(inspect_nth_part ,id) 'js-open-inspector) + (push (point) js-inspector-mark-stack)) + +(defun js-inspector-next () + "Inspect the next object in the history." + (interactive) + (js-eval `(inspector_next) + (lambda (parts) + (cond ((eq parts 'false) + (message "No next object") + (ding)) + (t + (push (point) js-inspector-mark-stack) + (js-open-inspector parts)))))) + +(defun js-inspector-last () + "Inspect the previous object." + (interactive) + (js-eval `(inspector_pop) + (lambda (result) + (cond ((eq result 'false) + (message "No previous object") + (ding)) + (t + (let ((point (pop js-inspector-mark-stack))) + (js-open-inspector result point))))))) + +(defun js-inspector-apply-part (number &optional args) + "Call the function at the current slot and inspect the result. +Call this command with a prefix argument to supply arguments." + (interactive (list (js-property-at-point 'part) + (if current-prefix-arg + (read-from-minibuffer "Argument vector: " "[]")))) + (let ((args (or args "[]"))) + (js-eval `(inspector_apply_part ,number ,args) 'js-open-inspector) + (push (point) js-inspector-mark-stack))) + +(defun js-quit-inspector () + "Close the inspector." + (interactive) + (js-eval `(quit_inspector) + (lambda (x) + (set-window-configuration js-old-window-config) + (kill-buffer (current-buffer))))) + +;;; Portability kludges + +(unless (fboundp 'substring-no-properties) + (defun substring-no-properties (string &optional start end) + (let* ((start (or start 0)) + (end (or end (length string))) + (string (substring string start end))) + (set-text-properties start end nil string) + string))) + +(unless (fboundp 'string-make-unibyte) + (defalias 'string-make-unibyte #'identity)) + +;;; + +(run-hooks 'js-load-hook) + +(provide 'js-mode) + +;;; js-mode.el ends here Property changes on: branches/trunk-reorg/thirdparty/emacs/js-mode.el ___________________________________________________________________ Name: svn:executable + * Added: branches/trunk-reorg/thirdparty/emacs/shellserver.xpi =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/thirdparty/emacs/shellserver.xpi ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

1 0

[bknr-cvs] r2290 - branches/trunk-reorg/projects/scrabble/website
by bknr＠bknr.net 26 Nov '07

26 Nov '07

Author: hhubner Date: 2007-11-26 07:43:25 -0500 (Mon, 26 Nov 2007) New Revision: 2290 Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.html Log: alpha test tweak Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.html =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-11-26 12:42:03 UTC (rev 2289) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.html 2007-11-26 12:43:25 UTC (rev 2290) @@ -12,7 +12,7 @@ <body onload="init()"> <div id="playfield"> </div> - <div style="position: absolute; right: 20px; top: 20px;"><a style="color: white;" href="/login?login=user1">user1</a></div> - <div style="position: absolute; right: 20px; top: 40px;"><a style="color: white;" href="/login?login=user2">user2</a></div> + <div style="position: absolute; right: 20px; top: 20px;"><a style="color: white;" href="/login?login=hans">hans</a></div> + <div style="position: absolute; right: 20px; top: 40px;"><a style="color: white;" href="/login?login=marna">marna</a></div> </body> -</html> \ No newline at end of file +</html>

1 0

[bknr-cvs] r2289 - branches/trunk-reorg/bknr/datastore/src/data
by bknr＠bknr.net 26 Nov '07

26 Nov '07

Author: hhubner Date: 2007-11-26 07:42:03 -0500 (Mon, 26 Nov 2007) New Revision: 2289 Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp Log: enhance error message Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/object.lisp 2007-11-26 11:54:55 UTC (rev 2288) +++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp 2007-11-26 12:42:03 UTC (rev 2289) @@ -81,8 +81,8 @@ (defmethod (setf slot-value-using-class) :before (newval (class persistent-class) object slotd) (when (and (persistent-slot-p slotd) (not (in-transaction-p))) - (error "Attempt to set persistent slot outside of a transaction : (~A ~A)" - (slot-definition-name slotd) (type-of object)))) + (error "Attempt to set persistent slot ~A of ~A outside of a transaction" + (slot-definition-name slotd) object))) (defmethod (setf slot-value-using-class) :after (newval (class persistent-class) object slotd) (when (in-anonymous-transaction-p)

1 0

[bknr-cvs] r2288 - in branches/trunk-reorg/projects/scrabble: src website
by bknr＠bknr.net 26 Nov '07

26 Nov '07

Author: hhubner Date: 2007-11-26 06:54:55 -0500 (Mon, 26 Nov 2007) New Revision: 2288 Modified: branches/trunk-reorg/projects/scrabble/src/rules.lisp branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp branches/trunk-reorg/projects/scrabble/src/web.lisp branches/trunk-reorg/projects/scrabble/website/scrabble.js Log: Prepare for first pre-alpha user test Modified: branches/trunk-reorg/projects/scrabble/src/rules.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/rules.lisp 2007-11-26 11:24:22 UTC (rev 2287) +++ branches/trunk-reorg/projects/scrabble/src/rules.lisp 2007-11-26 11:54:55 UTC (rev 2288) @@ -63,8 +63,8 @@ (defmethod print-object ((board board) stream) (print-unreadable-object (board stream :type t :identity t) (terpri stream) - (dotimes (x 15) - (dotimes (y 15) + (dotimes (y 15) + (dotimes (x 15) (format stream "~C " (aif (at-xy board x y) (used-for it) #\.))) (terpri stream)))) Modified: branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-11-26 11:24:22 UTC (rev 2287) +++ branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-11-26 11:54:55 UTC (rev 2288) @@ -8,8 +8,8 @@ :subsystems (list (make-instance 'store-object-subsystem))) (unless (class-instances 'user) (format t "creating test users and game~%") - (let ((user1 (make-user "user1" :class 'player :full-name "User Eins")) - (user2 (make-user "user2" :class 'player :full-name "User Zwei"))) + (let ((user1 (make-user "hans" :class 'player :full-name "Hans")) + (user2 (make-user "marna" :class 'player :full-name "Marna"))) (make-game :de (list user1 user2))))) (defparameter *website-directory* Modified: branches/trunk-reorg/projects/scrabble/src/web.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-11-26 11:24:22 UTC (rev 2287) +++ branches/trunk-reorg/projects/scrabble/src/web.lisp 2007-11-26 11:54:55 UTC (rev 2288) @@ -56,8 +56,7 @@ :score (score-of move) :placed-tiles (placed-tiles-of move) :words (mapcar (lambda (word-cons) - (list :word (car word-cons) - :score (cdr word-cons))) + (list (car word-cons) (cdr word-cons))) (words-formed-of move))) stream)) Modified: branches/trunk-reorg/projects/scrabble/website/scrabble.js =================================================================== --- branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-26 11:24:22 UTC (rev 2287) +++ branches/trunk-reorg/projects/scrabble/website/scrabble.js 2007-11-26 11:54:55 UTC (rev 2288) @@ -118,12 +118,14 @@ setElementPosition(shuffleButton, { x: border + 480, y: border + 665 }); appendChildNodes(container, shuffleButton); -// var clearButton = DIV(null, "clear"); -// clearButton.style.color = 'white'; -// clearButton.style.position = 'absolute'; -// clearButton.onclick = clearBoard; -// setElementPosition(clearButton, { x: border + 480, y: border + 680 }); -// appendChildNodes(container, clearButton); + var gameLog = DIV({ id: 'gameLog' }, ""); + gameLog.style.position = 'absolute'; + gameLog.style.width = '280px'; + gameLog.style.height = '250px'; + gameLog.style.textAlign = 'left'; + gameLog.style.overflowY = 'scroll'; + setElementPosition(gameLog, { x: border + 680, y: border + 400 }); + appendChildNodes($('playfield'), gameLog); } function setLetter(x, y, letter, isBlank) { @@ -438,6 +440,21 @@ otherPlayerIndex++; } +function renderMoveAsText(move) +{ + var retval = move.participantLogin; + if (move.type == 'move') { + retval += " score: " + move.score; + for (var i = 0; i < move.words.length; i++) { + retval += " " + move.words[i][0] + "(" + move.words[i][1] + ")"; + } + } else { + retval += move.type; + } + + return retval; +} + function drawGameState (gameState) { for (var i = 0; i < gameState.board.length; i++) { var x = gameState.board[i][0]; @@ -453,6 +470,9 @@ makeMyTray(map(function (entry) { return entry.letter }, participant.remainingTiles)); } } + for (var i = 0; i < gameState.moves.length; i++) { + appendChildNodes($('gameLog'), DIV(null, renderMoveAsText(gameState.moves[i]))); + } } var legalLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".split("");

1 0