[BACK]Return to XmSetIcon.rplc CVS log [TXT] [DIR] Up to [local] / rpl / modules / motif
File:  [local] / rpl / modules / motif / XmSetIcon.rplc
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Wed Aug 23 12:21:59 2017 UTC (6 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, rpl-4_1_33, rpl-4_1_32, rpl-4_1_31, rpl-4_1_30, rpl-4_1_29, rpl-4_1_28, HEAD
Ajout de XmSetIcon.

    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>