Annotation of rpl/modules/motif/XmSetIcon.rplc, revision 1.1
1.1 ! bertrand 1: #include "src/rplexternals.h"
! 2: #include "motif.h"
! 3:
! 4: declareExternalFunction(XmSetIcon)
! 5: declareObject(filename);
! 6: declareObject(widget);
! 7:
! 8: Pixmap icon;
! 9:
! 10: string name;
! 11:
! 12: HEADER
! 13: declareHelpString("Set application icon\n"
! 14: " 2: widget shell\n"
! 15: " 1: filename\n");
! 16: numberOfArguments(2);
! 17: FUNCTION
! 18: if (initializationDone eq true) then
! 19: pullFromStack(filename, string);
! 20: returnOnError(freeObject(filename));
! 21:
! 22: pullFromStack(widget, external);
! 23: returnOnError(freeObject(filename); freeObject(widget));
! 24:
! 25: ifIsExternal(widget, WIDGET) then
! 26: orElse
! 27: executionError("Type mismath error");
! 28: returnOnError(freeObject(filename); freeObject(widget));
! 29: endIf
! 30:
! 31: getString(filename, name);
! 32:
! 33: select(XpmReadFileToPixmap(
! 34: XtDisplay(target(objectContainer(Widget, widget))),
! 35: XtWindow(target(objectContainer(Widget, widget))),
! 36: name, &icon, NULL, NULL))
! 37: exclusiveCase(XpmOpenFailed)
! 38: executionError("XpmOpenFailed");
! 39: endExclusiveCase
! 40:
! 41: exclusiveCase(XpmFileInvalid)
! 42: executionError("XpmOpenFailed");
! 43: endExclusiveCase
! 44:
! 45: exclusiveCase(XpmNoMemory)
! 46: systemError("XpmNoMemory");
! 47: endExclusiveCase
! 48: endSelect
! 49:
! 50: returnOnError(freeObject(filename); freeObject(widget));
! 51:
! 52: XtVaSetValues(target(objectContainer(Widget, widget)),
! 53: XmNiconPixmap, icon,
! 54: NULL);
! 55:
! 56: /* Icon is not copied, thus we haven't to free pixmap.
! 57: XFreePixmap(XtDisplay(target(objectContainer(Widget, widget))),
! 58: icon);
! 59: */
! 60:
! 61: freeObject(widget);
! 62: freeObject(filename);
! 63: orElse
! 64: executionError("Application not initialized");
! 65: returnOnError();
! 66: endIf
! 67: END
! 68: endExternalFunction
! 69:
! 70: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>