Tk-Components

Check-in [e1359d0b72]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Re-add Windows file
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:e1359d0b72f255fc298e58e4e625e934327e4a04
User & Date: kevin 2015-09-13 16:24:45
Context
2015-09-13
17:16
Delete cruft check-in: 97ae90174d user: kevin tags: trunk
16:24
Re-add Windows file check-in: e1359d0b72 user: kevin tags: trunk
12:08
Fix Windows naming conflicts check-in: 697de03bc7 user: kevin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added customfont/win/customfont_win.c.

















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
/*
 * customfont.c --
 * Loads custom font file. 
 * Copyright (c) 2013 Kevin Walzer/WordTech Communications LLC.
 * Windows code based on example by Pat Thoyts:
 *  http://code.activestate.com/lists/tcl-core/8158/
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include <tcl.h>
#include <tk.h>
#include <windows.h>


/*Tcl function to add the font.*/
int AddFontIcon(ClientData cd, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) {

  if(objc != 2) {
    Tcl_WrongNumArgs(ip, 1, objv, "fontfile");
    return TCL_ERROR;
  }
  
  Tcl_DString ds;
  Tcl_Encoding unicode;
  int len, r = TCL_OK;
	
  const char *path = Tcl_GetString(objv[1]);
  len = strlen(path);
	  
  Tcl_DStringInit(&ds);
  unicode = Tcl_GetEncoding(ip, "unicode");
  Tcl_UtfToExternalDString(unicode, path, len, &ds);
  if (AddFontResourceExW(Tcl_DStringValue(&ds), FR_PRIVATE, NULL)
      == 0) {
    r = TCL_ERROR;
  }
  Tcl_DStringFree(&ds);
  Tcl_FreeEncoding(unicode);
  return r;
}



/*Initalize the package in the tcl interpreter, create Tcl commands. */
int DLLEXPORT Customfont_Init (Tcl_Interp *interp) {

 
  if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
    return TCL_ERROR;  
  }
  if (Tk_InitStubs(interp, "8.5", 0) == NULL) {
    return TCL_ERROR;
  }


  Tcl_CreateObjCommand(interp, "::customfont::addcustomfont", AddFontIcon,(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);


  if (Tcl_PkgProvide(interp, "customfont", "1.1") != TCL_OK) {
    return TCL_ERROR;
  }
      
  return TCL_OK;
	
}

int Customfont_SafeInit(Tcl_Interp *interp) {
  return Customfont_Init(interp);
}